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@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