Пример #1
0
static int
_report_error(int err,
	dident arg1,		/* any arity */
	dident module,		/* arity 0 */
	type mod_tag)
{
    int res;
    pword *old_tg = TG;
    pword *tg = TG;
    pword mod, goal;

    Make_Struct(&goal, TG);

    Push_Struct_Frame(d_.syserror); ++tg;
    Make_Integer(tg, -err); ++tg;
    Make_Struct(tg, TG); ++tg;
    tg->val.did = module;
    tg++->tag.all = mod_tag.all;
    tg->val.did = module;
    tg++->tag.all = mod_tag.all;

    Push_Struct_Frame(d_.quotient); ++tg;
    Make_Atom(tg, add_dict(arg1,0)); ++tg;
    Make_Integer(tg, DidArity(arg1));

    mod.val.did = d_.kernel_sepia;
    mod.tag.kernel = ModuleTag(d_.kernel_sepia);
    res = query_emulc(goal.val, goal.tag, mod.val, mod.tag);
    TG = old_tg;
    return res;
}
Пример #2
0
static pword
_heap_arr_get(t_ext_ptr h, int i)	/* assumed to return dereferenced result */
{
    pword result;
    pword *pheap;
    int arity;

    pheap = ((t_heap_array*)h)->array;
    arity = DidArity(pheap[0].val.did);
    a_mutex_lock(&SharedDataLock);
    if (i > 0  &&  i <= arity)
    {
	get_heapterm(&pheap[i], &result);
    }
    else				/* get the whole array-term */
    {
	Make_Struct(&result,TG);
	Push_Struct_Frame(pheap[0].val.did);
	for (i=1; i<=arity; ++i)
	{
	    get_heapterm(&pheap[i], &result.val.ptr[i]);
	}
    }
    a_mutex_unlock(&SharedDataLock);
    return result;
}
Пример #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;
}