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:
parent
ed92d70e68
commit
030d16c40f
17
C/absmi.c
17
C/absmi.c
@ -10,8 +10,11 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* first steps to allow mavars with tabling
|
||||
* fix trailing for tabling with multiple get_cons
|
||||
@ -2686,6 +2689,17 @@ Yap_absmi(int inp)
|
||||
#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 *
|
||||
\************************************************************************/
|
||||
@ -6649,6 +6663,7 @@ Yap_absmi(int inp)
|
||||
#ifdef FROZEN_STACKS
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
|
||||
#ifdef SBA
|
||||
if (YREG > (CELL *) top_b || YREG < H) ASP = (CELL *)top_b;
|
||||
#else
|
||||
|
@ -528,6 +528,9 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
|
||||
#ifdef TABLING
|
||||
p->TableOfPred = NULL;
|
||||
#endif /* TABLING */
|
||||
#ifdef BEAM
|
||||
p->beamTable = NULL;
|
||||
#endif /* BEAM */
|
||||
/* careful that they don't cross MkFunctor */
|
||||
p->NextOfPE = fe->PropsOfFE;
|
||||
if (PRED_GOAL_EXPANSION_FUNC) {
|
||||
@ -568,6 +571,9 @@ Yap_NewThreadPred(PredEntry *ap)
|
||||
#ifdef TABLING
|
||||
p->TableOfPred = NULL;
|
||||
#endif /* TABLING */
|
||||
#ifdef BEAM
|
||||
p->beamTable = NULL;
|
||||
#endif
|
||||
/* careful that they don't cross MkFunctor */
|
||||
p->NextOfPE = AbsPredProp(ThreadHandle[worker_id].local_preds);
|
||||
ThreadHandle[worker_id].local_preds = p;
|
||||
@ -607,6 +613,9 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
|
||||
#ifdef TABLING
|
||||
p->TableOfPred = NULL;
|
||||
#endif /* TABLING */
|
||||
#ifdef BEAM
|
||||
p->beamTable = NULL;
|
||||
#endif
|
||||
/* careful that they don't cross MkFunctor */
|
||||
p->NextOfPE = ae->PropsOfAE;
|
||||
if (PRED_GOAL_EXPANSION_FUNC) {
|
||||
|
13
C/amasm.c
13
C/amasm.c
@ -11,8 +11,11 @@
|
||||
* File: amasm.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* 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 name_op:
|
||||
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:
|
||||
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "instruction %d found while assembling", (int) cip->cpc->op);
|
||||
save_machine_regs();
|
||||
|
92
C/compiler.c
92
C/compiler.c
@ -11,8 +11,11 @@
|
||||
* File: compiler.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* fix compiler bug in 1 << X, found by Nuno Fonseca.
|
||||
* compiler internal errors get their own message.
|
||||
@ -103,6 +106,11 @@ static char SccsId[] = "%W% %G%";
|
||||
#include <string.h>
|
||||
#endif
|
||||
|
||||
#ifdef BEAM
|
||||
extern int EAM;
|
||||
//extern PInstr *CodeStart, *ppc, *ppc1, *BodyStart, *ppc_body;
|
||||
#endif
|
||||
|
||||
typedef struct branch_descriptor {
|
||||
int id; /* the branch id */
|
||||
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;
|
||||
int cmp = 0;
|
||||
|
||||
#ifdef BEAM
|
||||
if (EAM) return t;
|
||||
#endif
|
||||
|
||||
if (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t)))
|
||||
return (t);
|
||||
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 */
|
||||
/* first we fetch the arguments */
|
||||
|
||||
if (IsVarTerm(t1)) {
|
||||
if (IsNewVar(t1)) {
|
||||
char s[32];
|
||||
@ -1583,6 +1596,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
|
||||
}
|
||||
else if (p->PredFlags & AsmPredFlag) {
|
||||
int op = p->PredFlags & 0x7f;
|
||||
|
||||
if (profiling)
|
||||
Yap_emit(enter_profiling_op, (CELL)p, Zero, &cglobs->cint);
|
||||
else if (call_counting)
|
||||
@ -1635,8 +1649,13 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
|
||||
c_args(Goal, 0, cglobs);
|
||||
}
|
||||
}
|
||||
#ifdef BEAM
|
||||
else if (p->PredFlags & BinaryTestPredFlag && !EAM) {
|
||||
#else
|
||||
else if (p->PredFlags & BinaryTestPredFlag) {
|
||||
#endif
|
||||
Term a1 = ArgOfTerm(1,Goal);
|
||||
|
||||
if (IsVarTerm(a1) && !IsNewVar(a1)) {
|
||||
Term a2 = ArgOfTerm(2,Goal);
|
||||
if (IsVarTerm(a2) && !IsNewVar(a2)) {
|
||||
@ -1659,7 +1678,6 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
|
||||
save_machine_regs();
|
||||
longjmp(cglobs->cint.CompilerBotch,4);
|
||||
}
|
||||
|
||||
c_eq(t2, a2, cglobs);
|
||||
c_var(a1, bt1_flag, 2, 0, cglobs);
|
||||
cglobs->current_p0 = p0;
|
||||
@ -1673,8 +1691,8 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
|
||||
save_machine_regs();
|
||||
longjmp(cglobs->cint.CompilerBotch,4);
|
||||
}
|
||||
|
||||
c_eq(t1, a1, cglobs);
|
||||
|
||||
if (IsVarTerm(a2) && !IsNewVar(a2)) {
|
||||
c_var(t1, bt1_flag, 2, 0, cglobs);
|
||||
cglobs->current_p0 = p0;
|
||||
@ -1687,7 +1705,6 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
|
||||
save_machine_regs();
|
||||
longjmp(cglobs->cint.CompilerBotch,4);
|
||||
}
|
||||
|
||||
c_eq(t2, a2, cglobs);
|
||||
c_var(t1, bt1_flag, 2, 0, cglobs);
|
||||
cglobs->current_p0 = p0;
|
||||
@ -1817,9 +1834,22 @@ c_body(Term Body, int mod, compiler_struct *cglobs)
|
||||
}
|
||||
c_goal(ArgOfTerm(1, Body), mod, cglobs);
|
||||
Body = t2;
|
||||
#ifdef BEAM
|
||||
if (EAM) Yap_emit(endgoal_op, Zero, Zero, &cglobs->cint);
|
||||
#endif
|
||||
|
||||
}
|
||||
cglobs->onlast = TRUE;
|
||||
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
|
||||
@ -1842,7 +1872,11 @@ c_head(Term t, compiler_struct *cglobs)
|
||||
}
|
||||
|
||||
/* number of permanent variables in the clause */
|
||||
#ifdef BEAM
|
||||
int nperm;
|
||||
#else
|
||||
static int nperm;
|
||||
#endif
|
||||
|
||||
inline static int
|
||||
usesvar(compiler_vm_op ic)
|
||||
@ -1936,6 +1970,16 @@ AssignPerm(PInstr *pc, compiler_struct *cglobs)
|
||||
uses_var = usesvar(pc->op);
|
||||
if (uses_var) {
|
||||
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->AgeOfVE > 1 && (v->AgeOfVE > v->FirstOfVE))
|
||||
|| v->KindOfVE == PermVar /*
|
||||
@ -2454,6 +2498,11 @@ c_layout(compiler_struct *cglobs)
|
||||
|
||||
rn_to_kill[0] = rn_to_kill[1] = 0;
|
||||
cglobs->cint.cpc = cglobs->BodyStart;
|
||||
/*
|
||||
#ifdef BEAM
|
||||
if (!cglobs->is_a_fact || EAM) {
|
||||
#else
|
||||
*/
|
||||
if (!cglobs->is_a_fact) {
|
||||
while (v != NIL) {
|
||||
if (v->FlagsOfVE & BranchVar) {
|
||||
@ -2467,7 +2516,11 @@ c_layout(compiler_struct *cglobs)
|
||||
}
|
||||
cglobs->cint.cpc->nextInst = savepc;
|
||||
|
||||
#ifdef BEAM
|
||||
if (cglobs->needs_env || EAM) {
|
||||
#else
|
||||
if (cglobs->needs_env) {
|
||||
#endif
|
||||
nperm = 0;
|
||||
AssignPerm(cglobs->cint.CodeStart, cglobs);
|
||||
#ifdef DEBUG
|
||||
@ -2485,6 +2538,7 @@ c_layout(compiler_struct *cglobs)
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
cglobs->MaxCTemps = cglobs->nvars + cglobs->max_args - cglobs->tmpreg + cglobs->n_common_exps + 2;
|
||||
if (cglobs->MaxCTemps >= MaxTemps)
|
||||
cglobs->MaxCTemps = MaxTemps;
|
||||
@ -2496,7 +2550,9 @@ c_layout(compiler_struct *cglobs)
|
||||
*cop++ = NIL;
|
||||
}
|
||||
}
|
||||
|
||||
CheckVoids(cglobs);
|
||||
|
||||
/* second scan: allocate registers */
|
||||
cglobs->cint.cpc = cglobs->cint.CodeStart;
|
||||
while (cglobs->cint.cpc) {
|
||||
@ -2542,7 +2598,11 @@ c_layout(compiler_struct *cglobs)
|
||||
case get_var_op:
|
||||
--cglobs->Uses[rn];
|
||||
if (checktemp(arg, rn, ic, cglobs)) {
|
||||
#ifdef BEAM
|
||||
if (cglobs->vreg == rn && !EAM)
|
||||
#else
|
||||
if (cglobs->vreg == rn)
|
||||
#endif
|
||||
cglobs->cint.cpc->op = nop_op;
|
||||
}
|
||||
cglobs->Contents[rn] = cglobs->vadr;
|
||||
@ -2590,7 +2650,11 @@ c_layout(compiler_struct *cglobs)
|
||||
case put_val_op:
|
||||
rn = checkreg(arg, rn, ic, TRUE, cglobs);
|
||||
checktemp(arg, rn, ic, cglobs);
|
||||
#ifdef BEAM
|
||||
if (cglobs->Contents[rn] == (Term)cglobs->vadr && !EAM)
|
||||
#else
|
||||
if (cglobs->Contents[rn] == (Term)cglobs->vadr)
|
||||
#endif
|
||||
cglobs->cint.cpc->op = nop_op;
|
||||
cglobs->Contents[rn] = cglobs->vadr;
|
||||
++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));
|
||||
/* phase 1 : produce skeleton code and variable information */
|
||||
c_head(head, &cglobs);
|
||||
|
||||
if (cglobs.is_a_fact && !cglobs.vtable) {
|
||||
#ifdef TABLING
|
||||
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;
|
||||
#endif /* TABLING_INNER_CUTS */
|
||||
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);
|
||||
/* Insert blobs at the very end */
|
||||
|
||||
if (cglobs.cint.BlobsStart != NULL) {
|
||||
cglobs.cint.cpc->nextInst = cglobs.cint.BlobsStart;
|
||||
cglobs.cint.BlobsStart = NULL;
|
||||
}
|
||||
|
||||
reset_vars(cglobs.vtable);
|
||||
H = HB;
|
||||
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])
|
||||
Yap_ShowCode(&cglobs.cint);
|
||||
#endif
|
||||
|
||||
#ifdef BEAM
|
||||
void codigo_eam(compiler_struct *);
|
||||
if (EAM) codigo_eam(&cglobs);
|
||||
#endif
|
||||
|
||||
/* phase 3: assemble code */
|
||||
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 */
|
||||
if (acode == 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);
|
||||
}
|
||||
#endif /* LOW_PROF */
|
||||
|
||||
return(acode);
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef BEAM
|
||||
#include "toeam.c"
|
||||
#endif
|
||||
|
||||
|
@ -11,8 +11,11 @@
|
||||
* File: computils.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* - allow MegaClauses with blobs
|
||||
* - change Diffs to be thread specific
|
||||
@ -336,6 +339,14 @@ ShowOp (char *f, struct PSEUDO *cpc)
|
||||
if (ch == '%')
|
||||
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 'n':
|
||||
Yap_plwrite ((Term) arg, Yap_DebugPutc, 0);
|
||||
@ -654,6 +665,31 @@ static char *opformat[] =
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
"clause_with_cut",
|
||||
#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",
|
||||
"binary_cfunc\t\t%v,%P",
|
||||
"blob\t%O"
|
||||
|
20
C/eval.c
20
C/eval.c
@ -32,8 +32,8 @@ yap_error_number Yap_matherror = YAP_NO_ERROR;
|
||||
#define E_FUNC blob_type
|
||||
#define E_ARGS arith_retptr 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 RFLOAT(v) (o)->dbl = v; return(double_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)
|
||||
{ /* X is Y */
|
||||
union arith_ret res;
|
||||
|
25
C/grow.c
25
C/grow.c
@ -769,6 +769,31 @@ fix_compiler_instructions(PInstr *pcpc)
|
||||
case table_new_answer_op:
|
||||
case table_try_single_op:
|
||||
#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;
|
||||
}
|
||||
if (ncpc != NULL) {
|
||||
|
@ -11,8 +11,11 @@
|
||||
* File: index.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* fix debugger to do well nonsource predicates.
|
||||
*
|
||||
@ -2240,6 +2243,9 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
case _trie_try_long:
|
||||
case _trie_retry_long:
|
||||
#endif /* TABLING */
|
||||
#ifdef BEAM
|
||||
case _run_eam:
|
||||
#endif
|
||||
clause->Tag = (CELL)NULL;
|
||||
return;
|
||||
}
|
||||
|
16
C/iopreds.c
16
C/iopreds.c
@ -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
|
||||
p_write (void)
|
||||
{ /* '$write'(+Flags,?Term) */
|
||||
|
122
C/stdpreds.c
122
C/stdpreds.c
@ -11,8 +11,11 @@
|
||||
* File: stdpreds.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* 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_univ, (void));
|
||||
STD_PROTO(static Int p_abort, (void));
|
||||
#ifdef BEAM
|
||||
STD_PROTO(Int p_halt, (void));
|
||||
#else
|
||||
STD_PROTO(static Int p_halt, (void));
|
||||
#endif
|
||||
STD_PROTO(static Int init_current_atom, (void));
|
||||
STD_PROTO(static Int cont_current_atom, (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_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
|
||||
|
||||
@ -2055,12 +2140,22 @@ p_abort(void)
|
||||
return(FALSE);
|
||||
}
|
||||
|
||||
#ifdef BEAM
|
||||
extern void exit_eam(char *s);
|
||||
|
||||
Int
|
||||
#else
|
||||
static Int
|
||||
#endif
|
||||
p_halt(void)
|
||||
{ /* halt */
|
||||
Term t = Deref(ARG1);
|
||||
Int out;
|
||||
|
||||
#ifdef BEAM
|
||||
if (EAM) exit_eam("\n\n[ Prolog execution halted ]\n");
|
||||
#endif
|
||||
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,t,"halt/1");
|
||||
return(FALSE);
|
||||
@ -2871,6 +2966,16 @@ p_has_yap_or(void)
|
||||
#endif
|
||||
}
|
||||
|
||||
static Int
|
||||
p_has_eam(void)
|
||||
{
|
||||
#ifdef BEAM
|
||||
return(TRUE);
|
||||
#else
|
||||
return(FALSE);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_set_yap_flags(void)
|
||||
@ -3106,6 +3211,11 @@ Yap_InitBackCPreds(void)
|
||||
SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPredBack("current_op", 3, 3, init_current_op, cont_current_op,
|
||||
SafePredFlag|SyncPredFlag);
|
||||
#ifdef BEAM
|
||||
Yap_InitCPredBack("eam", 1, 0, start_eam, cont_eam,
|
||||
SafePredFlag);
|
||||
#endif
|
||||
|
||||
Yap_InitBackIO();
|
||||
Yap_InitBackDB();
|
||||
Yap_InitUserBacks();
|
||||
@ -3150,6 +3260,15 @@ Yap_InitCPreds(void)
|
||||
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("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("$lock_system", 0, p_lock_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("$hidden", 1, p_hidden, 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
|
||||
Yap_InitCPred("profinit",0, profinit, SafePredFlag);
|
||||
Yap_InitCPred("profend" ,0, profend, SafePredFlag);
|
||||
|
@ -1463,7 +1463,7 @@ InitSignals (void)
|
||||
#ifndef MPW
|
||||
my_signal (SIGFPE, HandleMatherr);
|
||||
#endif
|
||||
#if HAVE_SIGSEGV && !defined(THREADS)
|
||||
#if HAVE_SIGSEGV && !defined(THREADS)
|
||||
my_signal_info (SIGSEGV, HandleSIGSEGV);
|
||||
#endif
|
||||
#ifdef ACOW
|
||||
|
Reference in New Issue
Block a user