BEAM for YAP update...

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1385 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
rslopes 2005-09-08 22:06:45 +00:00
parent ed92d70e68
commit 030d16c40f
11 changed files with 349 additions and 13 deletions

View File

@ -10,8 +10,11 @@
* * * *
* File: absmi.c * * File: absmi.c *
* comments: Portable abstract machine interpreter * * comments: Portable abstract machine interpreter *
* Last rev: $Date: 2005-08-12 17:00:00 $,$Author: ricroc $ * * Last rev: $Date: 2005-09-08 22:06:44 $,$Author: rslopes $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.175 2005/08/12 17:00:00 ricroc
* TABLING FIX: support for incomplete tables
*
* Revision 1.174 2005/08/05 14:55:02 vsc * Revision 1.174 2005/08/05 14:55:02 vsc
* first steps to allow mavars with tabling * first steps to allow mavars with tabling
* fix trailing for tabling with multiple get_cons * fix trailing for tabling with multiple get_cons
@ -2686,6 +2689,17 @@ Yap_absmi(int inp)
#endif /* TABLING */ #endif /* TABLING */
#ifdef BEAM
extern int eam_am(PredEntry *);
Op(run_eam, s);
if (!eam_am((PredEntry *) PREG->u.s.s)) FAIL();
PREG = NEXTOP(PREG, s);
GONext();
ENDOp();
#endif
/************************************************************************\ /************************************************************************\
* Get Instructions * * Get Instructions *
\************************************************************************/ \************************************************************************/
@ -6649,6 +6663,7 @@ Yap_absmi(int inp)
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
choiceptr top_b = PROTECT_FROZEN_B(B); choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef SBA #ifdef SBA
if (YREG > (CELL *) top_b || YREG < H) ASP = (CELL *)top_b; if (YREG > (CELL *) top_b || YREG < H) ASP = (CELL *)top_b;
#else #else

View File

@ -528,6 +528,9 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
#ifdef TABLING #ifdef TABLING
p->TableOfPred = NULL; p->TableOfPred = NULL;
#endif /* TABLING */ #endif /* TABLING */
#ifdef BEAM
p->beamTable = NULL;
#endif /* BEAM */
/* careful that they don't cross MkFunctor */ /* careful that they don't cross MkFunctor */
p->NextOfPE = fe->PropsOfFE; p->NextOfPE = fe->PropsOfFE;
if (PRED_GOAL_EXPANSION_FUNC) { if (PRED_GOAL_EXPANSION_FUNC) {
@ -568,6 +571,9 @@ Yap_NewThreadPred(PredEntry *ap)
#ifdef TABLING #ifdef TABLING
p->TableOfPred = NULL; p->TableOfPred = NULL;
#endif /* TABLING */ #endif /* TABLING */
#ifdef BEAM
p->beamTable = NULL;
#endif
/* careful that they don't cross MkFunctor */ /* careful that they don't cross MkFunctor */
p->NextOfPE = AbsPredProp(ThreadHandle[worker_id].local_preds); p->NextOfPE = AbsPredProp(ThreadHandle[worker_id].local_preds);
ThreadHandle[worker_id].local_preds = p; ThreadHandle[worker_id].local_preds = p;
@ -607,6 +613,9 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
#ifdef TABLING #ifdef TABLING
p->TableOfPred = NULL; p->TableOfPred = NULL;
#endif /* TABLING */ #endif /* TABLING */
#ifdef BEAM
p->beamTable = NULL;
#endif
/* careful that they don't cross MkFunctor */ /* careful that they don't cross MkFunctor */
p->NextOfPE = ae->PropsOfAE; p->NextOfPE = ae->PropsOfAE;
if (PRED_GOAL_EXPANSION_FUNC) { if (PRED_GOAL_EXPANSION_FUNC) {

View File

@ -11,8 +11,11 @@
* File: amasm.c * * File: amasm.c *
* comments: abstract machine assembler * * comments: abstract machine assembler *
* * * *
* Last rev: $Date: 2005-08-02 03:09:49 $ * * Last rev: $Date: 2005-09-08 22:06:44 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.83 2005/08/02 03:09:49 vsc
* fix debugger to do well nonsource predicates.
*
* Revision 1.82 2005/07/06 15:10:02 vsc * Revision 1.82 2005/07/06 15:10:02 vsc
* improvements to compiler: merged instructions and fixes for -> * improvements to compiler: merged instructions and fixes for ->
* *
@ -3076,6 +3079,14 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case nop_op: case nop_op:
case name_op: case name_op:
break; break;
#ifdef BEAM
case body_op:
case endgoal_op:
break;
case run_op:
code_p=a_n(_run_eam,cip->cpc->rnd2,code_p,pass_no);
break;
#endif
default: default:
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "instruction %d found while assembling", (int) cip->cpc->op); Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "instruction %d found while assembling", (int) cip->cpc->op);
save_machine_regs(); save_machine_regs();

View File

@ -11,8 +11,11 @@
* File: compiler.c * * File: compiler.c *
* comments: Clause compiler * * comments: Clause compiler *
* * * *
* Last rev: $Date: 2005-07-06 15:10:03 $,$Author: vsc $ * * Last rev: $Date: 2005-09-08 22:06:44 $,$Author: rslopes $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.68 2005/07/06 15:10:03 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.67 2005/05/25 21:43:32 vsc * Revision 1.67 2005/05/25 21:43:32 vsc
* fix compiler bug in 1 << X, found by Nuno Fonseca. * fix compiler bug in 1 << X, found by Nuno Fonseca.
* compiler internal errors get their own message. * compiler internal errors get their own message.
@ -103,6 +106,11 @@ static char SccsId[] = "%W% %G%";
#include <string.h> #include <string.h>
#endif #endif
#ifdef BEAM
extern int EAM;
//extern PInstr *CodeStart, *ppc, *ppc1, *BodyStart, *ppc_body;
#endif
typedef struct branch_descriptor { typedef struct branch_descriptor {
int id; /* the branch id */ int id; /* the branch id */
Term cm; /* if a banch is associated with a commit */ Term cm; /* if a banch is associated with a commit */
@ -397,6 +405,10 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl
CExpEntry *p = cglobs->common_exps; CExpEntry *p = cglobs->common_exps;
int cmp = 0; int cmp = 0;
#ifdef BEAM
if (EAM) return t;
#endif
if (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t))) if (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t)))
return (t); return (t);
while (p != NULL) { while (p != NULL) {
@ -810,6 +822,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, compiler_struct *cglobs)
{ {
/* compile Z = X Op Y arithmetic function */ /* compile Z = X Op Y arithmetic function */
/* first we fetch the arguments */ /* first we fetch the arguments */
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
if (IsNewVar(t1)) { if (IsNewVar(t1)) {
char s[32]; char s[32];
@ -1583,6 +1596,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
} }
else if (p->PredFlags & AsmPredFlag) { else if (p->PredFlags & AsmPredFlag) {
int op = p->PredFlags & 0x7f; int op = p->PredFlags & 0x7f;
if (profiling) if (profiling)
Yap_emit(enter_profiling_op, (CELL)p, Zero, &cglobs->cint); Yap_emit(enter_profiling_op, (CELL)p, Zero, &cglobs->cint);
else if (call_counting) else if (call_counting)
@ -1635,8 +1649,13 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
c_args(Goal, 0, cglobs); c_args(Goal, 0, cglobs);
} }
} }
#ifdef BEAM
else if (p->PredFlags & BinaryTestPredFlag && !EAM) {
#else
else if (p->PredFlags & BinaryTestPredFlag) { else if (p->PredFlags & BinaryTestPredFlag) {
#endif
Term a1 = ArgOfTerm(1,Goal); Term a1 = ArgOfTerm(1,Goal);
if (IsVarTerm(a1) && !IsNewVar(a1)) { if (IsVarTerm(a1) && !IsNewVar(a1)) {
Term a2 = ArgOfTerm(2,Goal); Term a2 = ArgOfTerm(2,Goal);
if (IsVarTerm(a2) && !IsNewVar(a2)) { if (IsVarTerm(a2) && !IsNewVar(a2)) {
@ -1659,7 +1678,6 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
save_machine_regs(); save_machine_regs();
longjmp(cglobs->cint.CompilerBotch,4); longjmp(cglobs->cint.CompilerBotch,4);
} }
c_eq(t2, a2, cglobs); c_eq(t2, a2, cglobs);
c_var(a1, bt1_flag, 2, 0, cglobs); c_var(a1, bt1_flag, 2, 0, cglobs);
cglobs->current_p0 = p0; cglobs->current_p0 = p0;
@ -1673,8 +1691,8 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
save_machine_regs(); save_machine_regs();
longjmp(cglobs->cint.CompilerBotch,4); longjmp(cglobs->cint.CompilerBotch,4);
} }
c_eq(t1, a1, cglobs); c_eq(t1, a1, cglobs);
if (IsVarTerm(a2) && !IsNewVar(a2)) { if (IsVarTerm(a2) && !IsNewVar(a2)) {
c_var(t1, bt1_flag, 2, 0, cglobs); c_var(t1, bt1_flag, 2, 0, cglobs);
cglobs->current_p0 = p0; cglobs->current_p0 = p0;
@ -1687,7 +1705,6 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
save_machine_regs(); save_machine_regs();
longjmp(cglobs->cint.CompilerBotch,4); longjmp(cglobs->cint.CompilerBotch,4);
} }
c_eq(t2, a2, cglobs); c_eq(t2, a2, cglobs);
c_var(t1, bt1_flag, 2, 0, cglobs); c_var(t1, bt1_flag, 2, 0, cglobs);
cglobs->current_p0 = p0; cglobs->current_p0 = p0;
@ -1817,9 +1834,22 @@ c_body(Term Body, int mod, compiler_struct *cglobs)
} }
c_goal(ArgOfTerm(1, Body), mod, cglobs); c_goal(ArgOfTerm(1, Body), mod, cglobs);
Body = t2; Body = t2;
#ifdef BEAM
if (EAM) Yap_emit(endgoal_op, Zero, Zero, &cglobs->cint);
#endif
} }
cglobs->onlast = TRUE; cglobs->onlast = TRUE;
c_goal(Body, mod, cglobs); c_goal(Body, mod, cglobs);
#ifdef BEAM
if (EAM && cglobs->goalno > 1) {
if (cglobs->cint.cpc->op==procceed_op) {
cglobs->cint.cpc->op=endgoal_op;
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
} else
Yap_emit(endgoal_op, Zero, Zero, &cglobs->cint);
}
#endif
} }
static void static void
@ -1842,7 +1872,11 @@ c_head(Term t, compiler_struct *cglobs)
} }
/* number of permanent variables in the clause */ /* number of permanent variables in the clause */
#ifdef BEAM
int nperm;
#else
static int nperm; static int nperm;
#endif
inline static int inline static int
usesvar(compiler_vm_op ic) usesvar(compiler_vm_op ic)
@ -1936,6 +1970,16 @@ AssignPerm(PInstr *pc, compiler_struct *cglobs)
uses_var = usesvar(pc->op); uses_var = usesvar(pc->op);
if (uses_var) { if (uses_var) {
Ventry *v = (Ventry *) (pc->rnd1); Ventry *v = (Ventry *) (pc->rnd1);
#ifdef BEAM
if (EAM) {
if (v->NoOfVE == Unassigned || v->KindOfVE!=PermVar) {
v->NoOfVE = PermVar | (nperm++);
v->KindOfVE = PermVar;
v->FlagsOfVE |= PermFlag;
}
}
#endif
if (v->NoOfVE == Unassigned) { if (v->NoOfVE == Unassigned) {
if ((v->AgeOfVE > 1 && (v->AgeOfVE > v->FirstOfVE)) if ((v->AgeOfVE > 1 && (v->AgeOfVE > v->FirstOfVE))
|| v->KindOfVE == PermVar /* || v->KindOfVE == PermVar /*
@ -2454,6 +2498,11 @@ c_layout(compiler_struct *cglobs)
rn_to_kill[0] = rn_to_kill[1] = 0; rn_to_kill[0] = rn_to_kill[1] = 0;
cglobs->cint.cpc = cglobs->BodyStart; cglobs->cint.cpc = cglobs->BodyStart;
/*
#ifdef BEAM
if (!cglobs->is_a_fact || EAM) {
#else
*/
if (!cglobs->is_a_fact) { if (!cglobs->is_a_fact) {
while (v != NIL) { while (v != NIL) {
if (v->FlagsOfVE & BranchVar) { if (v->FlagsOfVE & BranchVar) {
@ -2467,7 +2516,11 @@ c_layout(compiler_struct *cglobs)
} }
cglobs->cint.cpc->nextInst = savepc; cglobs->cint.cpc->nextInst = savepc;
#ifdef BEAM
if (cglobs->needs_env || EAM) {
#else
if (cglobs->needs_env) { if (cglobs->needs_env) {
#endif
nperm = 0; nperm = 0;
AssignPerm(cglobs->cint.CodeStart, cglobs); AssignPerm(cglobs->cint.CodeStart, cglobs);
#ifdef DEBUG #ifdef DEBUG
@ -2485,6 +2538,7 @@ c_layout(compiler_struct *cglobs)
#endif #endif
} }
} }
cglobs->MaxCTemps = cglobs->nvars + cglobs->max_args - cglobs->tmpreg + cglobs->n_common_exps + 2; cglobs->MaxCTemps = cglobs->nvars + cglobs->max_args - cglobs->tmpreg + cglobs->n_common_exps + 2;
if (cglobs->MaxCTemps >= MaxTemps) if (cglobs->MaxCTemps >= MaxTemps)
cglobs->MaxCTemps = MaxTemps; cglobs->MaxCTemps = MaxTemps;
@ -2496,7 +2550,9 @@ c_layout(compiler_struct *cglobs)
*cop++ = NIL; *cop++ = NIL;
} }
} }
CheckVoids(cglobs); CheckVoids(cglobs);
/* second scan: allocate registers */ /* second scan: allocate registers */
cglobs->cint.cpc = cglobs->cint.CodeStart; cglobs->cint.cpc = cglobs->cint.CodeStart;
while (cglobs->cint.cpc) { while (cglobs->cint.cpc) {
@ -2542,7 +2598,11 @@ c_layout(compiler_struct *cglobs)
case get_var_op: case get_var_op:
--cglobs->Uses[rn]; --cglobs->Uses[rn];
if (checktemp(arg, rn, ic, cglobs)) { if (checktemp(arg, rn, ic, cglobs)) {
#ifdef BEAM
if (cglobs->vreg == rn && !EAM)
#else
if (cglobs->vreg == rn) if (cglobs->vreg == rn)
#endif
cglobs->cint.cpc->op = nop_op; cglobs->cint.cpc->op = nop_op;
} }
cglobs->Contents[rn] = cglobs->vadr; cglobs->Contents[rn] = cglobs->vadr;
@ -2590,7 +2650,11 @@ c_layout(compiler_struct *cglobs)
case put_val_op: case put_val_op:
rn = checkreg(arg, rn, ic, TRUE, cglobs); rn = checkreg(arg, rn, ic, TRUE, cglobs);
checktemp(arg, rn, ic, cglobs); checktemp(arg, rn, ic, cglobs);
#ifdef BEAM
if (cglobs->Contents[rn] == (Term)cglobs->vadr && !EAM)
#else
if (cglobs->Contents[rn] == (Term)cglobs->vadr) if (cglobs->Contents[rn] == (Term)cglobs->vadr)
#endif
cglobs->cint.cpc->op = nop_op; cglobs->cint.cpc->op = nop_op;
cglobs->Contents[rn] = cglobs->vadr; cglobs->Contents[rn] = cglobs->vadr;
++cglobs->Uses[rn]; ++cglobs->Uses[rn];
@ -3042,6 +3106,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
cglobs.is_a_fact = (body == MkAtomTerm(AtomTrue)); cglobs.is_a_fact = (body == MkAtomTerm(AtomTrue));
/* phase 1 : produce skeleton code and variable information */ /* phase 1 : produce skeleton code and variable information */
c_head(head, &cglobs); c_head(head, &cglobs);
if (cglobs.is_a_fact && !cglobs.vtable) { if (cglobs.is_a_fact && !cglobs.vtable) {
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs.cint.CurrentPred->PRWLock); READ_LOCK(cglobs.cint.CurrentPred->PRWLock);
@ -3070,12 +3135,19 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
cglobs->cut_mark = cpc; cglobs->cut_mark = cpc;
#endif /* TABLING_INNER_CUTS */ #endif /* TABLING_INNER_CUTS */
Yap_emit(allocate_op, Zero, Zero, &cglobs.cint); Yap_emit(allocate_op, Zero, Zero, &cglobs.cint);
#ifdef BEAM
if (EAM) Yap_emit(body_op, Zero, Zero, &cglobs.cint);
#endif
c_body(body, mod, &cglobs); c_body(body, mod, &cglobs);
/* Insert blobs at the very end */ /* Insert blobs at the very end */
if (cglobs.cint.BlobsStart != NULL) { if (cglobs.cint.BlobsStart != NULL) {
cglobs.cint.cpc->nextInst = cglobs.cint.BlobsStart; cglobs.cint.cpc->nextInst = cglobs.cint.BlobsStart;
cglobs.cint.BlobsStart = NULL; cglobs.cint.BlobsStart = NULL;
} }
reset_vars(cglobs.vtable); reset_vars(cglobs.vtable);
H = HB; H = HB;
if (B != NULL) { if (B != NULL) {
@ -3103,10 +3175,15 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
if (Yap_Option['f' - 96]) if (Yap_Option['f' - 96])
Yap_ShowCode(&cglobs.cint); Yap_ShowCode(&cglobs.cint);
#endif #endif
#ifdef BEAM
void codigo_eam(compiler_struct *);
if (EAM) codigo_eam(&cglobs);
#endif
/* phase 3: assemble code */ /* phase 3: assemble code */
acode = Yap_assemble(ASSEMBLING_CLAUSE, src, cglobs.cint.CurrentPred, (cglobs.is_a_fact && !cglobs.hasdbrefs), &cglobs.cint); acode = Yap_assemble(ASSEMBLING_CLAUSE, src, cglobs.cint.CurrentPred, (cglobs.is_a_fact && !cglobs.hasdbrefs), &cglobs.cint);
/* check first if there was space for us */ /* check first if there was space for us */
if (acode == NULL) { if (acode == NULL) {
return NULL; return NULL;
@ -3116,7 +3193,12 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
Yap_inform_profiler_of_clause(acode, ProfEnd, cglobs.cint.CurrentPred,0); Yap_inform_profiler_of_clause(acode, ProfEnd, cglobs.cint.CurrentPred,0);
} }
#endif /* LOW_PROF */ #endif /* LOW_PROF */
return(acode); return(acode);
} }
} }
#ifdef BEAM
#include "toeam.c"
#endif

View File

@ -11,8 +11,11 @@
* File: computils.c * * File: computils.c *
* comments: some useful routines for YAP's compiler * * comments: some useful routines for YAP's compiler *
* * * *
* Last rev: $Date: 2005-07-06 15:10:04 $ * * Last rev: $Date: 2005-09-08 22:06:44 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.27 2005/07/06 15:10:04 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.26 2005/01/04 02:50:21 vsc * Revision 1.26 2005/01/04 02:50:21 vsc
* - allow MegaClauses with blobs * - allow MegaClauses with blobs
* - change Diffs to be thread specific * - change Diffs to be thread specific
@ -336,6 +339,14 @@ ShowOp (char *f, struct PSEUDO *cpc)
if (ch == '%') if (ch == '%')
switch (ch = *f++) switch (ch = *f++)
{ {
#ifdef BEAM
case '1':
Yap_plwrite(MkIntTerm(rn), Yap_DebugPutc, 0);
break;
case '4':
Yap_plwrite(MkIntTerm(arg), Yap_DebugPutc, 0);
break;
#endif
case 'a': case 'a':
case 'n': case 'n':
Yap_plwrite ((Term) arg, Yap_DebugPutc, 0); Yap_plwrite ((Term) arg, Yap_DebugPutc, 0);
@ -654,6 +665,31 @@ static char *opformat[] =
#ifdef TABLING_INNER_CUTS #ifdef TABLING_INNER_CUTS
"clause_with_cut", "clause_with_cut",
#endif /* TABLING_INNER_CUTS */ #endif /* TABLING_INNER_CUTS */
#ifdef BEAM
"run_op %1,%4",
"body_op %1",
"endgoal_op",
"try_me_op %1,%4",
"retry_me_op %1,%4",
"trust_me_op %1,%4",
"only_1_clause_op %1,%4",
"create_first_box_op %1,%4",
"create_box_op %1,%4",
"create_last_box_op %1,%4",
"remove_box_op %1,%4",
"remove_last_box_op %1,%4",
"prepare_tries",
"std_base_op %1,%4",
"direct_safe_call",
"commit_op",
"skip_while_var_op",
"wait_while_var_op",
"force_wait_op",
"write_op",
"is_op",
"equal_op",
"exit",
#endif
"fetch_args_for_bccall\t%v", "fetch_args_for_bccall\t%v",
"binary_cfunc\t\t%v,%P", "binary_cfunc\t\t%v,%P",
"blob\t%O" "blob\t%O"

View File

@ -32,8 +32,8 @@ yap_error_number Yap_matherror = YAP_NO_ERROR;
#define E_FUNC blob_type #define E_FUNC blob_type
#define E_ARGS arith_retptr o #define E_ARGS arith_retptr o
#define USE_E_ARGS o #define USE_E_ARGS o
#define RBIG(v) (o)->big = v; return(big_int_e)
#define RBIG(v) (o)->big = v; return(big_int_e)
#define RINT(v) (o)->Int = v; return(long_int_e) #define RINT(v) (o)->Int = v; return(long_int_e)
#define RFLOAT(v) (o)->dbl = v; return(double_e) #define RFLOAT(v) (o)->dbl = v; return(double_e)
#define RERROR() return(db_ref_e) #define RERROR() return(db_ref_e)
@ -181,7 +181,23 @@ Yap_Eval(Term t, E_ARGS)
} }
} }
static Int #ifdef BEAM
Int BEAM_is(void);
Int
BEAM_is(void)
{ /* X is Y */
union arith_ret res;
blob_type bt;
bt = Eval(Deref(XREGS[2]), &res);
if (bt==db_ref_e) return (NULL);
return (EvalToTerm(bt,&res));
}
#endif
static Int
p_is(void) p_is(void)
{ /* X is Y */ { /* X is Y */
union arith_ret res; union arith_ret res;

View File

@ -769,6 +769,31 @@ fix_compiler_instructions(PInstr *pcpc)
case table_new_answer_op: case table_new_answer_op:
case table_try_single_op: case table_try_single_op:
#endif /* TABLING */ #endif /* TABLING */
#ifdef BEAM
case run_op:
case body_op:
case endgoal_op:
case try_me_op:
case retry_me_op:
case trust_me_op:
case only_1_clause_op:
case create_first_box_op:
case create_box_op:
case create_last_box_op:
case remove_box_op:
case remove_last_box_op:
case prepare_tries:
case std_base_op:
case direct_safe_call_op:
case commit_op:
case skip_while_var_op:
case wait_while_var_op:
case force_wait_op:
case write_op:
case is_op:
case equal_op:
case exit_op:
#endif
break; break;
} }
if (ncpc != NULL) { if (ncpc != NULL) {

View File

@ -11,8 +11,11 @@
* File: index.c * * File: index.c *
* comments: Indexing a Prolog predicate * * comments: Indexing a Prolog predicate *
* * * *
* Last rev: $Date: 2005-08-17 18:48:35 $,$Author: vsc $ * * Last rev: $Date: 2005-09-08 22:06:44 $,$Author: rslopes $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.144 2005/08/17 18:48:35 vsc
* fix bug in processing overflows of expand_clauses.
*
* Revision 1.143 2005/08/02 03:09:50 vsc * Revision 1.143 2005/08/02 03:09:50 vsc
* fix debugger to do well nonsource predicates. * fix debugger to do well nonsource predicates.
* *
@ -2240,6 +2243,9 @@ add_info(ClauseDef *clause, UInt regno)
case _trie_try_long: case _trie_try_long:
case _trie_retry_long: case _trie_retry_long:
#endif /* TABLING */ #endif /* TABLING */
#ifdef BEAM
case _run_eam:
#endif
clause->Tag = (CELL)NULL; clause->Tag = (CELL)NULL;
return; return;
} }

View File

@ -2726,6 +2726,22 @@ p_current_output (void)
} }
} }
#ifdef BEAM
int beam_write (void)
{
Yap_StartSlots();
Yap_plwrite (ARG1, Stream[Yap_c_output_stream].stream_putc, 0);
if (EX != 0L) {
Term ball = EX;
EX = 0L;
Yap_JumpToEnv(ball);
return(FALSE);
}
return (TRUE);
}
#endif
static Int static Int
p_write (void) p_write (void)
{ /* '$write'(+Flags,?Term) */ { /* '$write'(+Flags,?Term) */

View File

@ -11,8 +11,11 @@
* File: stdpreds.c * * File: stdpreds.c *
* comments: General-purpose C implemented system predicates * * comments: General-purpose C implemented system predicates *
* * * *
* Last rev: $Date: 2005-08-04 15:45:53 $,$Author: ricroc $ * * Last rev: $Date: 2005-09-08 22:06:45 $,$Author: rslopes $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.93 2005/08/04 15:45:53 ricroc
* TABLING NEW: support to limit the table space size
*
* Revision 1.92 2005/07/20 13:54:27 rslopes * Revision 1.92 2005/07/20 13:54:27 rslopes
* solved warning: cast from pointer to integer of different size * solved warning: cast from pointer to integer of different size
* *
@ -173,7 +176,11 @@ STD_PROTO(static Int p_number_chars, (void));
STD_PROTO(static Int p_number_codes, (void)); STD_PROTO(static Int p_number_codes, (void));
STD_PROTO(static Int p_univ, (void)); STD_PROTO(static Int p_univ, (void));
STD_PROTO(static Int p_abort, (void)); STD_PROTO(static Int p_abort, (void));
#ifdef BEAM
STD_PROTO(Int p_halt, (void));
#else
STD_PROTO(static Int p_halt, (void)); STD_PROTO(static Int p_halt, (void));
#endif
STD_PROTO(static Int init_current_atom, (void)); STD_PROTO(static Int init_current_atom, (void));
STD_PROTO(static Int cont_current_atom, (void)); STD_PROTO(static Int cont_current_atom, (void));
STD_PROTO(static Int init_current_predicate, (void)); STD_PROTO(static Int init_current_predicate, (void));
@ -208,6 +215,84 @@ STD_PROTO(static Int p_walltime, (void));
STD_PROTO(static Int p_access_yap_flags, (void)); STD_PROTO(static Int p_access_yap_flags, (void));
STD_PROTO(static Int p_set_yap_flags, (void)); STD_PROTO(static Int p_set_yap_flags, (void));
#ifdef BEAM
STD_PROTO(Int use_eam, (void));
STD_PROTO(Int eager_split, (void));
STD_PROTO(Int force_wait, (void));
STD_PROTO(Int commit, (void));
STD_PROTO(Int skip_while_var, (void));
STD_PROTO(Int wait_while_var, (void));
STD_PROTO(Int show_time, (void));
STD_PROTO(Int start_eam, (void));
STD_PROTO(Int cont_eam, (void));
extern int EAM;
extern int eam_am(PredEntry*);
extern int showTime(void);
Int start_eam(void) {
if (eam_am((PredEntry *) 0x1)) return (TRUE);
else { cut_fail(); return (FALSE); }
}
Int cont_eam(void) {
if (eam_am((PredEntry *) 0x2)) return (TRUE);
else { cut_fail(); return (FALSE); }
}
Int use_eam(void) {
if (EAM) EAM=0;
else { Yap_PutValue(Yap_FullLookupAtom("$c_arith"),0); EAM=1; }
return(TRUE);
}
Int commit(void) {
if (EAM) {
printf("Nao deveria ter sido chamado commit do stdpreds\n");
exit(1);
}
return(TRUE);
}
Int skip_while_var(void) {
if (EAM) {
printf("Nao deveria ter sido chamado skip_while_var do stdpreds\n");
exit(1);
}
return(TRUE);
}
Int wait_while_var(void) {
if (EAM) {
printf("Nao deveria ter sido chamado wait_while_var do stdpreds\n");
exit(1);
}
return(TRUE);
}
Int force_wait(void) {
if (EAM) {
printf("Nao deveria ter sido chamado force_wait do stdpreds\n");
exit(1);
}
return(TRUE);
}
Int eager_split(void) {
if (EAM) {
printf("Nao deveria ter sido chamado eager_split do stdpreds\n");
exit(1);
}
return(TRUE);
}
Int show_time(void) /* MORE PRECISION */
{
return (showTime());
}
#endif /* BEAM */
#ifdef LOW_PROF #ifdef LOW_PROF
@ -2055,12 +2140,22 @@ p_abort(void)
return(FALSE); return(FALSE);
} }
#ifdef BEAM
extern void exit_eam(char *s);
Int
#else
static Int static Int
#endif
p_halt(void) p_halt(void)
{ /* halt */ { /* halt */
Term t = Deref(ARG1); Term t = Deref(ARG1);
Int out; Int out;
#ifdef BEAM
if (EAM) exit_eam("\n\n[ Prolog execution halted ]\n");
#endif
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"halt/1"); Yap_Error(INSTANTIATION_ERROR,t,"halt/1");
return(FALSE); return(FALSE);
@ -2871,6 +2966,16 @@ p_has_yap_or(void)
#endif #endif
} }
static Int
p_has_eam(void)
{
#ifdef BEAM
return(TRUE);
#else
return(FALSE);
#endif
}
static Int static Int
p_set_yap_flags(void) p_set_yap_flags(void)
@ -3106,6 +3211,11 @@ Yap_InitBackCPreds(void)
SafePredFlag|SyncPredFlag|HiddenPredFlag); SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPredBack("current_op", 3, 3, init_current_op, cont_current_op, Yap_InitCPredBack("current_op", 3, 3, init_current_op, cont_current_op,
SafePredFlag|SyncPredFlag); SafePredFlag|SyncPredFlag);
#ifdef BEAM
Yap_InitCPredBack("eam", 1, 0, start_eam, cont_eam,
SafePredFlag);
#endif
Yap_InitBackIO(); Yap_InitBackIO();
Yap_InitBackDB(); Yap_InitBackDB();
Yap_InitUserBacks(); Yap_InitUserBacks();
@ -3150,6 +3260,15 @@ Yap_InitCPreds(void)
Yap_InitCPred("$access_yap_flags", 2, p_access_yap_flags, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$access_yap_flags", 2, p_access_yap_flags, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("abort", 0, p_abort, SyncPredFlag); Yap_InitCPred("abort", 0, p_abort, SyncPredFlag);
#ifdef BEAM
Yap_InitCPred("@", 0, eager_split, SafePredFlag);
Yap_InitCPred(":", 0, force_wait, SafePredFlag);
Yap_InitCPred("/", 0, commit, SafePredFlag);
Yap_InitCPred("skip_while_var",1,skip_while_var,SafePredFlag);
Yap_InitCPred("wait_while_var",1,wait_while_var,SafePredFlag);
Yap_InitCPred("eamtime", 0, show_time, SafePredFlag);
Yap_InitCPred("eam", 0, use_eam, SafePredFlag);
#endif
Yap_InitCPred("$halt", 1, p_halt, SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$halt", 1, p_halt, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$lock_system", 0, p_lock_system, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$lock_system", 0, p_lock_system, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$unlock_system", 0, p_unlock_system, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$unlock_system", 0, p_unlock_system, SafePredFlag|HiddenPredFlag);
@ -3171,6 +3290,7 @@ Yap_InitCPreds(void)
Yap_InitCPred("unhide", 1, p_unhide, SafePredFlag|SyncPredFlag); Yap_InitCPred("unhide", 1, p_unhide, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$hidden", 1, p_hidden, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$hidden", 1, p_hidden, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$has_yap_or", 0, p_has_yap_or, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$has_yap_or", 0, p_has_yap_or, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$has_eam", 0, p_has_eam, SafePredFlag|SyncPredFlag|HiddenPredFlag);
#ifdef LOW_PROF #ifdef LOW_PROF
Yap_InitCPred("profinit",0, profinit, SafePredFlag); Yap_InitCPred("profinit",0, profinit, SafePredFlag);
Yap_InitCPred("profend" ,0, profend, SafePredFlag); Yap_InitCPred("profend" ,0, profend, SafePredFlag);

View File

@ -1463,7 +1463,7 @@ InitSignals (void)
#ifndef MPW #ifndef MPW
my_signal (SIGFPE, HandleMatherr); my_signal (SIGFPE, HandleMatherr);
#endif #endif
#if HAVE_SIGSEGV && !defined(THREADS) #if HAVE_SIGSEGV && !defined(THREADS)
my_signal_info (SIGSEGV, HandleSIGSEGV); my_signal_info (SIGSEGV, HandleSIGSEGV);
#endif #endif
#ifdef ACOW #ifdef ACOW