Пример #1
0
/* Force a lazy pair.
   NB: When an error occurs during forcing, we release the lock of the
   pair, so that the pair can be forced again.  However, the generator
   has already caused some side-effect before the error, so the next
   forcing may not yield a correct next value.  Another plausible option
   is to mark the pair 'unforcible' permanently, by lp->owner == (AO_t)2,
   and let subsequent attempt of forcing the pair fail.
 */
ScmObj Scm_ForceLazyPair(volatile ScmLazyPair *lp)
{
    static const struct timespec req = {0, 1000000};
    struct timespec rem;
    ScmVM *vm = Scm_VM();

    do {
        if (AO_compare_and_swap_full(&lp->owner, 0, SCM_WORD(vm))) {
            /* Here we own the lazy pair. */
            ScmObj item = lp->item;
            /* Calling generator might change VM state, so we protect
               incomplete stack frame if there's any. */
            int extra_frame_pushed = Scm__VMProtectStack(vm);
            SCM_UNWIND_PROTECT {
                ScmObj val = Scm_ApplyRec0(lp->generator);
                ScmObj newgen = (vm->numVals == 1)? lp->generator : vm->vals[0];
                vm->numVals = 1; /* make sure the extra val won't leak out */

                if (SCM_EOFP(val)) {
                    lp->item = SCM_NIL;
                    lp->generator = SCM_NIL;
                } else {
                    ScmObj newlp = Scm_MakeLazyPair(val, newgen);
                    lp->item = newlp;
                    lp->generator = SCM_NIL;
                }
                AO_nop_full();
                SCM_SET_CAR(lp, item);
                /* We don't need barrier here. */
                lp->owner = (AO_t)1;
            } SCM_WHEN_ERROR {
                lp->owner = (AO_t)0; /*NB: See above about error handling*/
                SCM_NEXT_HANDLER;
            } SCM_END_PROTECT;
            if (extra_frame_pushed) {
                Scm__VMUnprotectStack(vm);
            }
            return SCM_OBJ(lp); /* lp is now an (extended) pair */
        }
        /* Check if we're already working on forcing this pair.  Unlike
           force/delay, We don't allow recursive forcing of lazy pair.
           Since generators are supposed to be called every time to yield
           a new value, so it is ambiguous what value should be returned
           if a generator calls itself recursively. */
        if (lp->owner == SCM_WORD(vm)) {
            /* NB: lp->owner will be reset by the original caller of
               the generator. */
            Scm_Error("Attempt to recursively force a lazy pair.");
        }
        /* Somebody's already working on forcing.  Let's wait for it
           to finish, or to abort. */
        while (SCM_HTAG(lp) == 7 && lp->owner != 0) {
            nanosleep(&req, &rem);
        }
    } while (lp->owner == 0); /* we retry if the previous owner abandoned. */
Пример #2
0
/*------------------------------------------------------------
 * Bport fill
 */
static int bport_fill(ScmPort *p, int cnt)
{
    bport *data = (bport*)p->src.buf.data;
    SCM_ASSERT(data != NULL);
    if (SCM_FALSEP(data->fill_proc)) {
        return 0;               /* indicates EOF */
    }
    ScmObj vec = Scm_MakeU8VectorFromArrayShared(
        cnt, (unsigned char*)p->src.buf.buffer);
    ScmObj r = Scm_ApplyRec(data->fill_proc, SCM_LIST1(vec));
    if (SCM_INTP(r)) return SCM_INT_VALUE(r);
    else if (SCM_EOFP(r)) return 0;
    else return -1;
}
Пример #3
0
/*------------------------------------------------------------
 * Bport flush
 */
static int bport_flush(ScmPort *p, int cnt, int forcep)
{
    bport *data = (bport*)p->src.buf.data;
    ScmObj vec, r;
    SCM_ASSERT(data != NULL);
    if (SCM_FALSEP(data->flush_proc)) {
        return cnt;             /* blackhole */
    }
    vec = Scm_MakeU8VectorFromArrayShared(cnt,
                                          (unsigned char*)p->src.buf.buffer);
    r = Scm_ApplyRec(data->flush_proc, SCM_LIST2(vec, SCM_MAKE_BOOL(forcep)));
    if (SCM_INTP(r)) return SCM_INT_VALUE(r);
    else if (SCM_EOFP(r)) return 0;
    else return -1;
}