Ejemplo n.º 1
0
/*
 * Must be called on the worker that created the bag, no check yet!
 */
static int
p_dbag_dissolve(value vdbag, type tdbag, value vl, type tl)
{
    aport_id_t bag_aport_id;
    dbag_descr_t *dbag_descr;
    amsg_t this_msg;
    amsg_ref_t *this_msg_data_hdr;
    pword list;
    register pword *car, *cdr;

    Check_Integer(tdbag);
    bag_aport_id = (aport_id_t) vdbag.nint;
    Check_Output_List(tl);
    if (aport_get_option(bag_aport_id, APORT_DATA_PTR,
				(aport_optval_t *) &dbag_descr) != AMSG_OK)
    {
	Bip_Error(MPS_ERROR);
    }

    this_msg = dbag_descr->first.msg;
    this_msg_data_hdr = dbag_descr->first.msg_data_hdr;
    hp_free_size((generic_ptr) dbag_descr, sizeof(dbag_descr_t));
    cdr = &list;
    while (this_msg_data_hdr != &dbag_descr->first)
    {
	pword *pw1;
	amsg_t old_msg;

        car = TG;
        Push_List_Frame();
        Make_List(cdr, car);
	cdr = car + 1;

	pw1 = dbformat_to_term((char*)(this_msg_data_hdr+1), D_UNKNOWN, tdict);
	if (!pw1)
	{
	    value va;
	    va.did = d_.abort;
	    Bip_Throw(va, tdict);
	}
	car->val.ptr = pw1->val.ptr;
	car->tag.kernel = pw1->tag.kernel;

	old_msg = this_msg;
	this_msg = this_msg_data_hdr->msg;
	this_msg_data_hdr = this_msg_data_hdr->msg_data_hdr;
	(void) amsg_free(old_msg);
    }
    Make_Nil(cdr);
    if (aport_deallocate(bag_aport_id) != AMSG_OK)
    {
	Bip_Error(MPS_ERROR);
    }
    Return_Unify_Pw(vl, tl, list.val, list.tag);
}
Ejemplo n.º 2
0
static int
p_get_par_goal(value v, type t)
{
    pword *pw1;

    if (!par_goal_msg_) { Fail_; }

    pw1 = dbformat_to_term((char*) amsg_data(par_goal_msg_), D_UNKNOWN, tdict);
    if (!pw1)
    {
	value va;
	va.did = d_.abort;
	Bip_Throw(va, tdict);
    }
    Return_Unify_Pw(v, t, pw1->val, pw1->tag);
}
Ejemplo n.º 3
0
int
ec_load_eco_from_stream(stream_id nst, int options, pword *module)
{
    int res;
    pword *clause, *query, *pw;
    pword query_pw, kernel_pw;
    pword top_module = *module;
    int encoded = 0;

    /* we are expecting an eco-encoded file, but we allow text as well */
    res = _read_eco_header(nst);
    encoded = (res == PSUCCEED);
    StreamMode(nst) |= SNOMACROEXP; /* to avoid problems in text-eco files */
    kernel_pw.val.did = d_.kernel_sepia;
    kernel_pw.tag.kernel = ModuleTag(d_.kernel_sepia);

    for(;;)
    {
	int recreate_module = 0;
	pword exports_pw, language_pw;
	pword *new_module = 0;

	if (encoded)			/* encoded dbformat */
	{
	    int n;
	    word nread;

	    char *s = ec_getstring(nst, 4, &nread);
	    if (!(s))
		return nread;	/* error code */
	    if (nread < 4)
		return (nread == 0) ? PSUCCEED : UNEXPECTED_EOF;

	    n = (unsigned char) *s++ << 24;
	    n |= (unsigned char) *s++ << 16;
	    n |= (unsigned char) *s++ << 8;
	    n |= (unsigned char) *s;
	    s = ec_getstring(nst, n, &nread);
	    if (!(s))
		return nread;	/* error code */
	    if (nread < n)
		return UNEXPECTED_EOF;

	    clause = dbformat_to_term(s, module->val.did, module->tag);
	    if (!clause)
		return NOT_DUMP_FILE;
	}
	else				/* text format, call the parser */
	{
	    res = ec_read_term(nst,
    		(GlobalFlags & VARIABLE_NAMES ? VARNAMES_PLEASE : 0),
		&query_pw, 0, 0, module->val, module->tag);
	    if (res != PSUCCEED)
	    	return (res == PEOF) ? PSUCCEED : NOT_DUMP_FILE;

	    clause = &query_pw;
	}

	Dereference_(clause);
	if (!IsStructure(clause->tag) || !Query(clause->val.ptr->val.did))
	    return NOT_DUMP_FILE;

	pw = query = clause->val.ptr + 1;
	Dereference_(pw);
	if (IsStructure(pw->tag))	/* look for special directives */
	{
	    if (pw->val.ptr->val.did == d_.module1)
	    {
		recreate_module = 1;
		new_module = &pw->val.ptr[1];
		Make_Nil(&exports_pw);
		Make_Atom(&language_pw, d_eclipse_language_);
	    }
	    if (pw->val.ptr->val.did == d_module_interface)
	    {
		recreate_module = 1;
		new_module = &pw->val.ptr[1];
		Make_Nil(&exports_pw);
		Make_Atom(&language_pw, d_eclipse_language_);
	    }
	    else if (pw->val.ptr->val.did == d_module2)
	    {
		recreate_module = 1;
		new_module = &pw->val.ptr[1];
		exports_pw = pw->val.ptr[2];
		Make_Atom(&language_pw, d_eclipse_language_);
	    }
	    else if (pw->val.ptr->val.did == d_module3)
	    {
		recreate_module = 1;
		new_module = &pw->val.ptr[1];
		exports_pw = pw->val.ptr[2];
		language_pw = pw->val.ptr[3];
	    }
	    else if (pw->val.ptr->val.did == d_begin_module)
	    {
		new_module = &pw->val.ptr[1];
		query = &query_pw;	/* don't execute anything */
		Make_Atom(query, d_.true0);
	    }
	    else if (pw->val.ptr->val.did == d_.pragma)
	    {
		query = &query_pw;	/* ignore pragmas, replace with true */
		Make_Atom(query, d_.true0);
	    }
	}
	else if (pw->val.did == d_.system || pw->val.did == d_.system_debug)
	{
	    query = &query_pw;	/* ignore pragmas, replace with true */
	    Make_Atom(query, d_.true0);
	}

	if (recreate_module)		/* build translated module query */
	{
	    pword *pgoal, *pcont;
	    query = &query_pw;
	    Make_Struct(query, TG);
	    /* If module changes, raise CODE_UNIT_LOADED event first */
	    if (module->val.did != top_module.val.did)
	    {
		pcont = TG;
		Push_Struct_Frame(d_.comma);
		Make_Struct(&pcont[1], TG);
		pgoal = TG;
		Push_Struct_Frame(d_.syserror);
		Make_Integer(&pgoal[1], CODE_UNIT_LOADED);
		Make_Atom(&pgoal[2], d_.eof);
		pgoal[3] = *module;
		pgoal[4] = *module;
		Make_Struct(&pcont[2], TG);
	    }
	    pcont = TG;
	    Push_Struct_Frame(d_.comma);
	    Make_Struct(&pcont[1], TG);
	    pgoal = TG;
	    Push_Struct_Frame(d_erase_module_);
	    pgoal[1] = *new_module;
	    Make_Struct(&pcont[2], TG);
	    pgoal = TG;
	    Push_Struct_Frame(d_create_module3_);
	    pgoal[1] = *new_module;
	    pgoal[2] = exports_pw;
	    pgoal[3] = language_pw;

	    res = query_emulc(query->val, query->tag, kernel_pw.val, kernel_pw.tag);
	}
	else
	{
	    /* execute the query/directive */
	    res = query_emulc(query->val, query->tag, module->val, module->tag);
	}

	if (res != PSUCCEED)
	{
	    pw = TG;
	    Push_Struct_Frame(d_.syserror);
	    Make_Integer(&pw[1], QUERY_FAILED);
	    pw[2] = *query;
	    pw[3] = *module;
	    pw[4] = *module;
	    query = &query_pw;
	    Make_Struct(query, pw);
	    (void) query_emulc(query->val, query->tag, kernel_pw.val, kernel_pw.tag);
	}

	if (new_module)			/* change to new context module */
	{
	    Dereference_(new_module);
	    *module = *new_module;
	}
    }
    return PSUCCEED;
}