[gambit-list] question about implementation of force

Marc Feeley feeley at iro.umontreal.ca
Sun Mar 25 08:25:06 EDT 2018


Just “fixed” the code in lib/_std.scm for backends that don’t inline ##force.

Marc



> On Mar 25, 2018, at 8:18 AM, Dimitris Vyzovitis <vyzo at hackzen.org> wrote:
> 
> thank you! that explains it.
> 
> -- vyzo
> 
> On Sun, Mar 25, 2018 at 3:05 PM, Marc Feeley <feeley at iro.umontreal.ca> wrote:
> The body of ##force in lib/_std.scm is actually dead code (because ##force is an inlined primitive), and as you have noticed the body contains a bug.
> 
> The actual implementation of ##force is in include/gambit.h.in :
> 
> #define ___FORCE1(n,src) \
> if (___TYP((___temp=(src)))==___tSUBTYPED&&___SUBTYPE(___temp)==___FIX(___sPROMISE)){___ps->temp1=___LBL(n);___ps->temp2=___temp;___JUMPEXTPRM(___NOTHING,___GSTATE->handler_force);
> #define ___FORCE2 ___temp=___ps->temp2;}
> #define ___FORCE3 ___temp
> 
> and lib/_kernel.scm :
> 
>>   (##c-code #<<end-of-code
> 
>    /*
>     * ___LBL(10)
>     *
>     * This is the force handler.  It is invoked when a promise is forced.
>     */
> 
>    ___SCMOBJ ra;
>    ___SCMOBJ promise;
>    ___SCMOBJ result;
> 
>    ra = ___ps->temp1;
>    promise = ___ps->temp2;
>    result = ___FIELD(promise,___PROMISE_RESULT);
> 
>    if (promise != result)
>      {
>        /* promise is determined, return cached result */
> 
>        ___COVER_FORCE_HANDLER_DETERMINED;
> 
>        ___ps->temp2 = result;
>        ___JUMPEXTPRM(___NOTHING,ra)
>      }
>    else
>      {
>        /* promise is not determined */
> 
>        /* setup internal return continuation frame */
> 
>        int fs;
> 
>        ___RETI_GET_CFS(ra,fs)
> 
>        ___ADJFP(___ROUND_TO_MULT(fs,___FRAME_ALIGN)-fs)
> 
>        ___PUSH_REGS /* push all GVM registers (live or not) */
>        ___PUSH(ra)  /* push return address */
> 
>        ___ADJFP(-___RETI_RA)
> 
>        ___SET_R0(___GSTATE->internal_return)
> 
>        /* tail call to ##force-undetermined */
> 
>        ___PUSH_ARGS2(promise,___FIELD(promise,___PROMISE_THUNK))
> 
>        ___COVER_FORCE_HANDLER_NOT_DETERMINED;
> 
>        ___JUMPPRM(___SET_NARGS(2),
>                   ___PRMCELL(___G__23__23_force_2d_undetermined.prm))
>      }
> 
> end-of-code
>> 
> ;;; Implementation of promises.
> 
> (define-prim (##make-promise thunk))
> (define-prim (##promise-thunk promise))
> (define-prim (##promise-thunk-set! promise thunk))
> (define-prim (##promise-result promise))
> (define-prim (##promise-result-set! promise result))
> 
> (define-prim (##force-undetermined promise thunk)
>   (let ((result (##force (thunk))))
>     (##c-code #<<end-of-code
> 
>      if (___PROMISERESULT(___ARG1) == ___ARG1)
>        {
>          ___PROMISERESULTSET(___ARG1,___ARG2)
>          ___PROMISETHUNKSET(___ARG1,___FAL)
>        }
>      ___RESULT = ___PROMISERESULT(___ARG1);
> 
> end-of-code
> 
>      promise
>      result)))
> 
> ))
> 
> 
> Marc
> 
> 
> 
> > On Mar 25, 2018, at 3:45 AM, Dimitris Vyzovitis <vyzo at hackzen.org> wrote:
> >
> > Marc,
> >
> > in _std.scm you have the following code implementing force:
> >
> > (define-prim (##force obj)
> >   (if (##promise? obj)
> >       (let ((result (##promise-result obj)))
> >         (if (##eq? result obj)
> >             (let* ((r ((##promise-thunk obj)))
> >                    (result2 (##promise-result obj)))
> >               (if (##eq? result2 obj)
> >                   (begin
> >                     (##promise-result-set! obj r)
> >                     (##promise-thunk-set! obj #f)
> >                     r)
> >                   result2))))
> >             ;; XXX -- value is unspecified when (not (##eq? result obj))
> >       obj))
> >
> > I find it very strange that the first if eq test of the result to the promise is lacking the else part;
> > that's where I marked with XXX.
> > Shouldn't the code return result in this case?
> > What am I missing here?
> >
> > -- vyzo
> 
> 




More information about the Gambit-list mailing list