Logo Search packages:      
Sourcecode: zinc-compiler version File versions  Download package

eval.c

#line 14 "eval.nw"
#include "config.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "debug.h"
#include "run.h"
#include "heap.h"
#include "stack.h"
#include "trail.h"
#include "threads.h"
#include "spaces.h"
#include "trace.h"
#include "eval.h"
#include "cam.h"

#line 39 "eval.nw"
FUNCTION(no_eval)
{
    EXPORT_LABEL(no_eval)
 ENTRY_LABEL(no_eval)

    fprintf(stderr, "Internal error: this object should not be evaluated\n");
    exit(9);
}

#line 58 "eval.nw"
FUNCTION(eval_whnf)
{
    Node *self;

    EXPORT_LABEL(eval_whnf)
 ENTRY_LABEL(eval_whnf)
    self = *sp++;
    RETURN(self);
}

#line 80 "eval.nw"
FUNCTION(eval_indir)
{
    Node *node;

    EXPORT_LABEL(eval_indir)
 ENTRY_LABEL(eval_indir)

    node = sp[0];
    ASSERT(is_boxed(node) && is_indir_node(node));

    /* dereference the indirection */
    do
    {
        node = node->n.node;
    }
    while ( is_boxed(node) && node->info->tag == INDIR_TAG );

    /* enter the node */
    if ( is_unboxed(node) )
    {
      sp += 1;
        RETURN(node);
    }
    sp[0] = node;
    GOTO(node->info->eval);
}

#line 119 "eval.nw"
FUNCTION(eval_closure)
{
    Node     *clos;
    FunctionInfo *fInfo;

    EXPORT_LABEL(eval_closure)
 ENTRY_LABEL(eval_closure)

    clos = sp[0];
    ASSERT(is_boxed(clos) && is_closure_node(clos));

    fInfo = clos->cl.info;
    ASSERT(closure_argc(clos) == fInfo->arity);

    /* copy the arguments onto the stack */
    if ( fInfo->arity > 1 )
      CHECK_STACK(fInfo->arity - 1);
    sp -= fInfo->arity - 1;
    memcpy(sp, clos->cl.args, fInfo->arity * word_size);

    /* jump to the function's entry point */
    GOTO(fInfo->entry);
}

#line 158 "eval.nw"
DECLARE_LABEL(resume);

FUNCTION(eval_suspend)
{
    unsigned int argc;
    Node     *susp, *fn;
    FunctionInfo *fInfo;
    Label    entry;

    EXPORT_LABEL(eval_suspend)
 ENTRY_LABEL(eval_suspend)

    susp = sp[0];
    ASSERT(is_boxed(susp) && is_suspend_node(susp));

    /* suspend the search if the node is not local */
    if ( !is_local_space(susp->s.spc) )
      GOTO(suspend_thread(resume, susp));

    /* lock the suspension */
    fn = susp->s.fn;
    SAVE(susp, q.wq);
    susp->info = &queueMe_info;
    susp->q.wq = (ThreadQueue)0;

    /* create an update frame and push arguments onto the stack */
    if ( is_boxed(fn) && is_closure_node(fn) )
    {
      fInfo = fn->cl.info;
      argc  = fInfo->arity;
      entry = fInfo->entry;
      ASSERT(argc == closure_argc(fn));
      CHECK_STACK(argc + 1);
      sp    -= argc + 1;
      sp[argc] = (Node *)update;
      memcpy(sp, fn->cl.args, argc * word_size);
    }
    else
    {
      CHECK_STACK(2);
      sp   -= 2;
      sp[0] = fn;
      sp[1] = (Node *)update;
      entry = fn->info->eval;
    }

    /* enter the callee */
    GOTO(entry);
}

#line 219 "eval.nw"
FUNCTION(eval_queueMe)
{
    EXPORT_LABEL(eval_queueMe)
 ENTRY_LABEL(eval_queueMe)

    GOTO(suspend_thread(resume, sp[0]));
}

#line 240 "eval.nw"
FUNCTION(update)
{
    Node       *result, *susp;
    Label       ret_ip;
    ThreadQueue wq;

    EXPORT_LABEL(update)
 ENTRY_LABEL(update)

    result = sp[0];
    susp   = sp[1];
    ret_ip = (Label)sp[2];
    sp        += 2;
    ASSERT(is_boxed(susp) && is_queueMe_node(susp) &&
         is_local_space(susp->q.spc));

    /* update the suspended application */
    TRACE(("%I %N = %N\n", susp, result));
    wq = susp->q.wq;
    SAVE(susp, q.wq);
    susp->info     = &suspend_indir_info;
    susp->n.node = result;
    sp[0]    = result;

    /* wake all threads on the wait-queue of the application */
    if ( wq != (ThreadQueue)0 )
      wake_threads(wq);

    /* return to the caller */
    GOTO(ret_ip);
}

#line 281 "eval.nw"
static
FUNCTION(resume)
{
    Node  *result;
    Label ret_ip;

 ENTRY_LABEL(resume)

    /* dereference the indirection */
    result = sp[0];
    ret_ip = (Label)sp[1];
    while ( is_boxed(result) && result->info->tag == INDIR_TAG )
      result = result->n.node;
    *++sp = result;

    /* return to the caller */
    GOTO(ret_ip);
}

#line 321 "eval.nw"
FunctionInfo ___64__info = FUNINFO("@", ___64_, 2);

DECLARE_LABEL(___64__1);

FUNCTION(___64_)
{
    EXPORT_LABEL(___64_)
 ENTRY_LABEL(___64_)
    TRACE(("%I enter @%V\n", 2, sp));
    GOTO(___64__1);
}

static
FUNCTION(___64__1)
{
    unsigned int argc;
    Node     *clos;
    FunctionInfo *fInfo;

 ENTRY_LABEL(___64__1)
    /* evaluate the function argument to head normal form */
    EVAL_RIGID(___64__1);
    clos = sp[0];
    ASSERT(is_boxed(clos) && is_papp_node(clos));

    /* check the number of missing arguments */
    fInfo = clos->cl.info;
    argc  = closure_argc(clos);
    ASSERT(fInfo->arity > argc);
    if ( argc + 1 == fInfo->arity )
    {
      ASSERT(fInfo[1].node_info.tag == CLOSURE_TAG);

      /* push the arguments onto the stack */
      CHECK_STACK(argc - 1);
      sp -= argc - 1;
      memcpy(sp, clos->cl.args, argc * word_size);

      /* perform a tail call to the closure */
      GOTO(fInfo->entry);
    }

    /* allocate a new closure for the application */
    CHECK_HEAP(closure_node_size(argc + 1));

    /* create a new closure from the old closure and the argument */
    clos = (Node *)hp;
    memcpy(clos, sp[0], closure_node_size(argc) * word_size);
    clos->cl.info++;
    clos->cl.args[argc] = sp[1];
    hp += closure_node_size(argc + 1);

    /* return to the caller */
    sp += 2;
    RETURN(clos);
}

#line 386 "eval.nw"
DEFINE_FUN(___58_, 2,
         PAPPINFO(":", 0, ___58_, 2)
         PAPPINFO(":", 1, ___58_, 2)
         FUNINFO(":",       ___58_, 2));

FUNCTION(___58_)
{
    Node *cons;

    EXPORT_LABEL(___58_)
 ENTRY_LABEL(___58_)

    TRACE(("%I enter :%V\n", 2, sp));

    CHECK_HEAP(cons_node_size);
    cons        = (Node *)hp;
    cons->c.info    = &cons_info;
    cons->c.args[0] = sp[0];
    cons->c.args[1] = sp[1];
    hp               += cons_node_size;

    sp += 2;
    RETURN(cons);
}

#line 417 "eval.nw"
DECLARE_ENTRYPOINT(__seq);

FUNCTION(__seq)
{
    Node *node;

    EXPORT_LABEL(__seq)
 ENTRY_LABEL(__seq)
    EVAL_RIGID_POLY(__seq);
    node = sp[1];
    if ( is_boxed(node) )
    {
      sp += 1;
      GOTO(node->info->eval);
    }
    sp += 2;
    RETURN(node);
}

#line 441 "eval.nw"
DECLARE_ENTRYPOINT(__failed);

FUNCTION(__failed)
{
    EXPORT_LABEL(__failed)
 ENTRY_LABEL(__failed)
    FAIL();
}

Generated by  Doxygen 1.6.0   Back to index