[gambit-list] question about implementation of force

[Dimitris Vyzovitis]

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

[Marc Feeley]

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

Post by Dimitris Vyzovitis
Marc,
(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

[Dimitris Vyzovitis]

thank you! that explains it.

-- vyzo

Post by Marc Feeley
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.
#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


(##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

Post by Dimitris Vyzovitis
Marc,
(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;

Post by Dimitris Vyzovitis
that's where I marked with XXX.
Shouldn't the code return result in this case?
What am I missing here?
-- vyzo

[Marc Feeley]

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

Marc

Post by Dimitris Vyzovitis
thank you! that explains it.
-- vyzo
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.
#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
…
(##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

Post by Dimitris Vyzovitis
Marc,
(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