R-alpha: Oops! -- a lisp pointer in R ... :

Ross Ihaka (ihaka@stat.auckland.ac.nz)
Thu, 4 Apr 1996 14:23:41 +1200


Date: Thu, 4 Apr 1996 14:23:41 +1200
From: Ross Ihaka <ihaka@stat.auckland.ac.nz>
Message-Id: <199604040223.OAA15774@stat.auckland.ac.nz>
To: R-testers@stat.math.ethz.ch
Subject: R-alpha: Oops! -- a lisp pointer in R ... :
In-Reply-To: <9604030730.AA17182@>
 <9604030730.AA17182@>

Ack!  The bug from hell which would not die.  I don't know how many
times I thought I had finally killed this one!  A fix is attached below.

[ Technical nonsense probably only of interest to me follows ]

We try very hard to make it appear that R is call-by-value, while
implementing things as call-by-reference.  The main thing to avoid in
doing this is ending up with two names for the same object, because
then you see the kind of thing Martin has observed.

Our particular trick is note whether we obtained a value through a
symbol table reference.  If this is the case we cannot just assign
the value, we must duplicate it first -- otherwise we'd end up with
two names for the same object.  What's gone wrong here is that I've
neglected to mark the value of things like
	
	x <- 10

as being named, so it is not duplicated befor assignment.

Another trick we use is when we do mutations of the form

	x[i] <- 10

If x is a local variable (not a function parameter) we can freely
mutate x (no other local names can refer to it).  If x is a function
parameter we must be more careful, because its value may be named
higher up the calling chain.  In this case we duplicate and then mark
the value as locally named, additional mutations do not then need to
duplicate.  This second trick gives us a huge performance boost over S
in contexts like

	for(i in 1:100) x[i] <- sin(i)

I believe (but can't be sure) that S duplicates x on every assignment
in this loop.  If x is even moderately large this creates huge amounts
of garbage which isn't collected until function exit time.

[ End of technical nonsense ... ]

The fix for the Martin's problem is to change the function do_set in
eval.c as follows: (look for the *** commment)

{
        SEXP s; 

        switch (PRIMVAL(op)) {  
        case 0: /* Global assignment := */      
                if (length(args) != 2)  
                        WrongArgCount(":=");
                if (isString(CAR(args)))
                        CAR(args) = install(CHAR(STRING(CAR(args))[0]));
                if (isSymbol(CAR(args))) {      
                        s = eval(CADR(args), rho);      
                        if (NAMED(s))   
                                s = duplicate(s);
                        PROTECT(s);     
                        R_Visible = 0;  
                        gsetVar(CAR(args), s, rho);     
                        UNPROTECT(1);   
                        NAMED(s) = 1;   
                        return s;
                }
                else
                        error("attempt to assign to non-symbol\n");     
                /*NOTREACHED*/  
        case 1: /* Assignment <- */     
                if (length(args) != 2)  
                        WrongArgCount("<-");    
                if (isString(CAR(args)))
                        CAR(args) = install(CHAR(STRING(CAR(args))[0]));
                if (isSymbol(CAR(args))) {
                        s = eval(CADR(args), rho);
                        if (NAMED(s))
                                s = duplicate(s);
                        PROTECT(s);
                        R_Visible = 0;
                        defineVar(CAR(args), s, rho);
                        UNPROTECT(1);
                        NAMED(s) = 1;   /*** FIX HERE ***/
                        return (s);
                }
                else if (isLanguage(CAR(args))) {
                        R_Visible = 0;
                        return applydefine(call, op, args, rho);
                }
                else
                        error("attempt to assign to non-symbol\n");
                /*NOTREACHED*/
{
        SEXP s; 

        switch (PRIMVAL(op)) {  
        case 0: /* Global assignment := */      
                if (length(args) != 2)  
                        WrongArgCount(":=");
                if (isString(CAR(args)))
                        CAR(args) = install(CHAR(STRING(CAR(args))[0]));
                if (isSymbol(CAR(args))) {      
                        s = eval(CADR(args), rho);      
                        if (NAMED(s))   
                                s = duplicate(s);
                        PROTECT(s);     
                        R_Visible = 0;  
                        gsetVar(CAR(args), s, rho);     
                        UNPROTECT(1);   
                        NAMED(s) = 1;   
                        return s;
                }
                else
                        error("attempt to assign to non-symbol\n");     
                /*NOTREACHED*/  
        case 1: /* Assignment <- */     
                if (length(args) != 2)  
                        WrongArgCount("<-");    
                if (isString(CAR(args)))
                        CAR(args) = install(CHAR(STRING(CAR(args))[0]));
                if (isSymbol(CAR(args))) {
                        s = eval(CADR(args), rho);
                        if (NAMED(s))
                                s = duplicate(s);
                        PROTECT(s);
                        R_Visible = 0;
                        defineVar(CAR(args), s, rho);
                        UNPROTECT(1);
                        NAMED(s) = 1;
                        return (s);
                }
                else if (isLanguage(CAR(args))) {
                        R_Visible = 0;
                        return applydefine(call, op, args, rho);
                }
                else
                        error("attempt to assign to non-symbol\n");
                /*NOTREACHED*/

Ross
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-testers mailing list -- To (un)subscribe, send
subscribe	or	unsubscribe
(in the "body", not the subject !)  To: r-testers-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-