diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more stuff for foreign interface.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@474 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-05-16 20:33:00 +00:00
parent 734d6ae2d3
commit 3b3a19f5d9
9 changed files with 131 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
C/absmi.c
View File

@ -5757,7 +5757,7 @@ absmi(int inp)
saveregs();
save_machine_regs();
SREG = (CELL *) YapExecute((CPredicate)(p->TrueCodeOfPred));
SREG = (CELL *) YapExecute(p);
}
restore_machine_regs();
@ -5885,12 +5885,7 @@ absmi(int inp)
ASP = YENV;
saveregs();
save_machine_regs();
{
CPredicate p;
p = (CPredicate)(PREG->u.lds.d);
SREG = (CELL *) YapExecute(p);
}
SREG = (CELL *) YapExecute(PREG->u.lds.p);
restore_machine_regs();
setregs();
if (!SREG) {

30
C/amasm.c
View File

@ -250,6 +250,12 @@ emit_a(CELL a)
return ((CODEADDR) (a));
}
inline static struct pred_entry *
emit_pe(struct pred_entry *a)
{
return (a);
}
inline static CODEADDR
emit_ilabel(register CELL addr)
{
@ -757,7 +763,7 @@ a_p(op_numbers opcode)
code_p->u.sdl.l =
emit_a(Unsigned(code_addr) + label_offset[comit_lab]);
code_p->u.sdl.p =
emit_a((CELL) RepPredProp(fe));
emit_pe(RepPredProp(fe));
}
GONEXT(sdl);
comit_lab = 0;
@ -921,8 +927,8 @@ a_bfunc(CELL pred)
if (ve->KindOfVE == PermVar) {
if (pass_no) {
code_p->opc = emit_op(_call_bfunc_yy);
code_p->u.lxy.p = (CODEADDR) RepPredProp(((Prop)pred));
code_p->u.lyy.l = (CODEADDR) (RepPredProp(((Prop)pred))->TrueCodeOfPred);
code_p->u.lxy.p = RepPredProp(((Prop)pred));
code_p->u.lyy.l = RepPredProp(((Prop)pred))->TrueCodeOfPred;
code_p->u.lyy.y1 = v1;
code_p->u.lyy.y2 = emit_yreg(var_offset);
code_p->u.lyy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
@ -931,8 +937,8 @@ a_bfunc(CELL pred)
} else {
if (pass_no) {
code_p->opc = emit_op(_call_bfunc_yx);
code_p->u.lxy.l = (CODEADDR) (RepPredProp(((Prop)pred))->TrueCodeOfPred);
code_p->u.lxy.p = (CODEADDR) RepPredProp(((Prop)pred));
code_p->u.lxy.l = RepPredProp(((Prop)pred))->TrueCodeOfPred;
code_p->u.lxy.p = RepPredProp(((Prop)pred));
code_p->u.lxy.x = emit_xreg(var_offset);
code_p->u.lxy.y = v1;
code_p->u.lxy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
@ -947,8 +953,8 @@ a_bfunc(CELL pred)
if (ve->KindOfVE == PermVar) {
if (pass_no) {
code_p->opc = emit_op(_call_bfunc_xy);
code_p->u.lxy.l = (CODEADDR) (RepPredProp(((Prop)pred))->TrueCodeOfPred);
code_p->u.lxy.p = (CODEADDR) RepPredProp(((Prop)pred));
code_p->u.lxy.l = RepPredProp(((Prop)pred))->TrueCodeOfPred;
code_p->u.lxy.p = RepPredProp(((Prop)pred));
code_p->u.lxy.x = x1;
code_p->u.lxy.y = emit_yreg(var_offset);
code_p->u.lxy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
@ -957,8 +963,8 @@ a_bfunc(CELL pred)
} else {
if (pass_no) {
code_p->opc = emit_op(_call_bfunc_xx);
code_p->u.lxy.p = (CODEADDR) RepPredProp(((Prop)pred));
code_p->u.lxx.l = (CODEADDR) (RepPredProp(((Prop)pred))->TrueCodeOfPred);
code_p->u.lxy.p = RepPredProp(((Prop)pred));
code_p->u.lxx.l = RepPredProp(((Prop)pred))->TrueCodeOfPred;
code_p->u.lxx.x1 = x1;
code_p->u.lxx.x2 = emit_xreg(var_offset);
code_p->u.lxx.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
@ -1002,7 +1008,7 @@ a_3sws(op_numbers opcode)
code_p->opc = emit_op(opcode);
seq_ptr = cpc->arnds;
code_p->u.slll.s = IPredArity;
code_p->u.slll.p = (CODEADDR)CurrentPred;
code_p->u.slll.p = CurrentPred;
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, cpc->rnd1 >> 1);
if (cpc->rnd1 & 1)
@ -1141,7 +1147,7 @@ a_try(op_numbers opcode, CELL lab, CELL opr)
code_p->opc = emit_op(opcode);
code_p->u.ld.d = emit_a(lab);
code_p->u.ld.s = emit_count(opr);
code_p->u.ld.p = (CODEADDR)CurrentPred;
code_p->u.ld.p = CurrentPred;
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, nofalts);
if (hascut)
@ -1160,7 +1166,7 @@ a_gl_in(op_numbers opcode)
code_p->opc = emit_op(opcode);
code_p->u.ldl.d = emit_a(cpc->rnd1);
code_p->u.ldl.s = emit_count(IPredArity);
code_p->u.ldl.p = (CODEADDR)CurrentPred;
code_p->u.ldl.p = CurrentPred;
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, cpc->rnd2 >> 1);
if (cpc->rnd2 & 1)

88
C/c_interface.c
View File

@ -74,7 +74,7 @@ X_API Int STD_PROTO(Yapcut_fail,(void));
X_API Int STD_PROTO(Yapcut_succeed,(void));
X_API Int STD_PROTO(YapUnify,(Term,Term));
X_API Int STD_PROTO(YapUnify,(Term,Term));
Int STD_PROTO(YapExecute,(CPredicate));
Int STD_PROTO(YapExecute,(PredEntry *));
X_API int STD_PROTO(YapReset,(void));
X_API Int STD_PROTO(YapInit,(yap_init_args *));
X_API Int STD_PROTO(YapFastInit,(char *));
@ -117,6 +117,7 @@ X_API void STD_PROTO(YapHalt,(int));
X_API Term *STD_PROTO(YapTopOfLocalStack,(void));
X_API void *STD_PROTO(YapPredicate,(Atom,Int,Int));
X_API void STD_PROTO(YapPredicateInfo,(void *,Atom *,Int *,Int *));
X_API void STD_PROTO(YapUserCPredicateWithArgs,(char *,CPredicate,Int,Int));
X_API Int STD_PROTO(YapCurrentModule,(void));
static int (*do_getf)(void);
@ -420,10 +421,74 @@ YapUnify(Term t1, Term t2)
return(out);
}
typedef Int (*CPredicate1)(Term);
typedef Int (*CPredicate2)(Term,Term);
typedef Int (*CPredicate3)(Term,Term,Term);
typedef Int (*CPredicate4)(Term,Term,Term,Term);
typedef Int (*CPredicate5)(Term,Term,Term,Term,Term);
typedef Int (*CPredicate6)(Term,Term,Term,Term,Term,Term);
typedef Int (*CPredicate7)(Term,Term,Term,Term,Term,Term,Term);
typedef Int (*CPredicate8)(Term,Term,Term,Term,Term,Term,Term,Term);
Int
YapExecute(CPredicate code)
YapExecute(PredEntry *pe)
{
return((code)());
if (pe->PredFlags & CArgsPredFlag) {
CODEADDR code = pe->TrueCodeOfPred;
switch (pe->ArityOfPE) {
case 0:
{
CPredicate code0 = (CPredicate)code;
return ((code0)());
}
case 1:
{
CPredicate1 code1 = (CPredicate1)code;
return ((code1)(Deref(ARG1)));
}
case 2:
{
CPredicate2 code2 = (CPredicate2)code;
return ((code2)(Deref(ARG1),Deref(ARG2)));
}
case 3:
{
CPredicate3 code3 = (CPredicate3)code;
return ((code3)(Deref(ARG1),Deref(ARG2),Deref(ARG3)));
}
case 4:
{
CPredicate4 code4 = (CPredicate4)code;
return ((code4)(Deref(ARG1),Deref(ARG2),Deref(ARG3),Deref(ARG4)));
}
case 5:
{
CPredicate5 code5 = (CPredicate5)code;
return ((code5)(Deref(ARG1),Deref(ARG2),Deref(ARG3),Deref(ARG4),Deref(ARG5)));
}
case 6:
{
CPredicate6 code6 = (CPredicate6)code;
return ((code6)(Deref(ARG1),Deref(ARG2),Deref(ARG3),Deref(ARG4),Deref(ARG5),Deref(ARG6)));
}
case 7:
{
CPredicate7 code7 = (CPredicate7)code;
return ((code7)(Deref(ARG1),Deref(ARG2),Deref(ARG3),Deref(ARG4),Deref(ARG5),Deref(ARG6),Deref(ARG7)));
}
case 8:
{
CPredicate8 code8 = (CPredicate8)code;
return ((code8)(Deref(ARG1),Deref(ARG2),Deref(ARG3),Deref(ARG4),Deref(ARG5),Deref(ARG6),Deref(ARG7),Deref(ARG8)));
}
default:
return(FALSE);
}
} else {
CPredicate code = (CPredicate)(pe->TrueCodeOfPred);
return((code)());
}
}
X_API Int
@ -1010,6 +1075,23 @@ YapPredicateInfo(void *p, Atom* a, Int* arity, Int* m)
*m = pd->ModuleOfPred;
}
X_API void
YapUserCPredicateWithArgs(char *a, CPredicate f, Int arity, Int mod)
{
PredEntry *pe;
SMALLUNSGN cm = CurrentModule;
CurrentModule = mod;
UserCPredicate(a,f,arity);
if (arity == 0) {
pe = RepPredProp(PredPropByAtom(LookupAtom(a),mod));
} else {
Functor f = MkFunctor(LookupAtom(a), arity);
pe = RepPredProp(PredPropByFunc(f,mod));
}
pe->PredFlags |= CArgsPredFlag;
CurrentModule = cm;
}
X_API Int
YapCurrentModule(void)
{

16
C/cdmgr.c
View File

@ -419,7 +419,7 @@ add_first_static(PredEntry *p, CODEADDR cp, int spy_flag)
yamop *pt = (yamop *)cp;
pt->u.ld.d = cp;
pt->u.ld.p = (CODEADDR)p;
pt->u.ld.p = p;
#ifdef YAPOR
if (SEQUENTIAL_IS_DEFAULT) {
p->PredFlags |= SequentialPredFlag;
@ -515,7 +515,7 @@ add_first_dynamic(PredEntry *p, CODEADDR cp, int spy_flag)
else
p->OpcodeOfPred = ncp->opc = opcode(_try_and_mark);
ncp->u.ld.s = p->ArityOfPE;
ncp->u.ld.p = (CODEADDR)p;
ncp->u.ld.p = p;
ncp->u.ld.d = cp;
#ifdef YAPOR
INIT_YAMOP_LTT(ncp, 1);
@ -530,7 +530,7 @@ add_first_dynamic(PredEntry *p, CODEADDR cp, int spy_flag)
else
((yamop *)cp)->opc = opcode(_retry_and_mark);
((yamop *)cp)->u.ld.s = p->ArityOfPE;
((yamop *)cp)->u.ld.p = (CODEADDR)p;
((yamop *)cp)->u.ld.p = p;
((yamop *)cp)->u.ld.d = (CODEADDR)ncp;
#ifdef KEEP_ENTRY_AGE
/* also, keep a backpointer for the days you delete the clause */
@ -558,7 +558,7 @@ asserta_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
{
yamop *q = (yamop *)cp;
q->u.ld.d = p->FirstClause;
q->u.ld.p = (CODEADDR)p;
q->u.ld.p = p;
#ifdef YAPOR
PUT_YAMOP_LTT(q, YAMOP_LTT((yamop *)(p->FirstClause)) + 1);
#endif /* YAPOR */
@ -611,18 +611,18 @@ asserta_dynam_clause(PredEntry *p, CODEADDR cp)
UNLOCK(ClauseCodeToClause(p->FirstClause)->ClLock);
q->u.ld.d = p->FirstClause;
q->u.ld.s = p->ArityOfPE;
q->u.ld.p = (CODEADDR)p;
q->u.ld.p = p;
if (p->PredFlags & ProfiledPredFlag)
((yamop *)cp)->opc = opcode(_retry_and_mark);
else
((yamop *)cp)->opc = opcode(_profiled_retry_and_mark);
((yamop *)cp)->u.ld.s = p->ArityOfPE;
((yamop *)cp)->u.ld.p = (CODEADDR)p;
((yamop *)cp)->u.ld.p = p;
p->FirstClause = cp;
q = (yamop *)p->CodeOfPred;
q->u.ld.d = cp;
q->u.ld.s = p->ArityOfPE;
q->u.ld.p = (CODEADDR)p;
q->u.ld.p = p;
}
/* p is already locked */
@ -704,7 +704,7 @@ assertz_dynam_clause(PredEntry *p, CODEADDR cp)
q->opc = opcode(_retry_and_mark);
q->u.ld.d = p->CodeOfPred;
q->u.ld.s = p->ArityOfPE;
q->u.ld.p = (CODEADDR)p;
q->u.ld.p = p;
}
static void expand_consult(void)

1
C/load_dl.c
View File

@ -101,7 +101,6 @@ LoadForeign(StringList ofiles, StringList libs,
}
libs = libs->next;
}
return LOAD_SUCCEEDED;
}

4
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.17 2002-05-14 18:24:33 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.18 2002-05-16 20:33:00 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -101,7 +101,7 @@ void STD_PROTO(InitBBPreds,(void));
void STD_PROTO(InitBigNums,(void));
/* c_interface.c */
Int STD_PROTO(YapExecute,(CPredicate));
Int STD_PROTO(YapExecute,(struct pred_entry *));
/* cdmgr.c */
void STD_PROTO(mark_as_fast,(Term));

16
H/amidefs.h
View File

@ -166,7 +166,7 @@ typedef struct yami {
struct table_entry *te; /* pointer to table entry */
#endif /* TABLING */
COUNT s;
CODEADDR p;
struct pred_entry *p;
CODEADDR d;
CELL next;
} ld;
@ -178,7 +178,7 @@ typedef struct yami {
struct table_entry *te; /* pointer to table entry */
#endif /* TABLING */
COUNT s;
CODEADDR p;
struct pred_entry *p;
CODEADDR d;
CODEADDR bl;
CELL next;
@ -196,7 +196,7 @@ typedef struct yami {
struct table_entry *te; /* pointer to table entry */
#endif /* TABLING */
COUNT s;
CODEADDR p;
struct pred_entry *p;
CODEADDR d;
COUNT extra;
CELL next;
@ -215,7 +215,7 @@ typedef struct yami {
struct table_entry *te; /* pointer to table entry */
#endif /* TABLING */
COUNT s;
CODEADDR p;
struct pred_entry *p;
CODEADDR l1;
CODEADDR l2;
CODEADDR l3;
@ -229,7 +229,7 @@ typedef struct yami {
CELL next;
} llll;
struct {
CODEADDR p;
struct pred_entry *p;
CODEADDR l;
AREG x1;
AREG x2;
@ -237,7 +237,7 @@ typedef struct yami {
CELL next;
} lxx;
struct {
CODEADDR p;
struct pred_entry *p;
CODEADDR l;
AREG x;
YREG y;
@ -245,7 +245,7 @@ typedef struct yami {
CELL next;
} lxy;
struct {
CODEADDR p;
struct pred_entry *p;
CODEADDR l;
AREG y1;
YREG y2;
@ -315,7 +315,7 @@ typedef struct yami {
COUNT s;
CODEADDR d;
CODEADDR l;
CODEADDR p;
struct pred_entry *p;
CELL next;
} sdl;
struct {

7
include/c_interface.h
View File

@ -363,6 +363,13 @@ static void (*YapIUserBackCPredicate)() = UserBackCPredicate;
#define UserBackCPredicate(N,F,G,A,B) (*YapIUserBackCPredicate)(N,F,G,A,B)
#endif
/* void UserCPredicate(char *name, int *fn(), int arity) */
extern X_API void PROTO(YapUserCPredicateWithArgs,(char *, int (*)(void), Int,Int));
#ifdef IndirectCalls
static void (*YapIUserCPredicateWithArgs)() = UserCPredicateWithArgs;
#define YapUserCPredicateWithArgs(N,F,A,M) (*YapIUserCPredicateWithArgs)(N,F,A,M)
#endif
/* void CallProlog(Term t) */
extern X_API Int PROTO(YapCallProlog,(Term t));
#ifdef IndirectCalls

1
m4/Yatom.h.m4
View File

@ -162,6 +162,7 @@ Inline(IsValProperty, PropFlags, int, flags, (flags == ValProperty) )
CodeOfPred holds the address of the correspondent C-function.
*/
typedef enum {
CArgsPredFlag = 0x1000000L, /* ! should ! across */
CutTransparentPredFlag = 0x800000L, /* ! should ! across */
SourcePredFlag = 0x400000L, /* static predicate with source declaration */
MetaPredFlag = 0x200000L, /* predicate subject to a meta declaration */