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

improvements to compiler: merged instructions and fixes for ->

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1338 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-07-06 15:10:18 +00:00
parent f6da8078ae
commit 6979a873cc
29 changed files with 481 additions and 342 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
C/absmi.c
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-06-04 07:27:33 $,$Author: ricroc $ * * Last rev: $Date: 2005-07-06 15:10:01 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.168 2005/06/04 07:27:33 ricroc
* long int support for tabling
*
* Revision 1.167 2005/06/03 08:26:31 ricroc * Revision 1.167 2005/06/03 08:26:31 ricroc
* float support for tabling * float support for tabling
* *
@ -321,6 +324,18 @@ void prof_alrm(int signo, siginfo_t *si, ucontext_t *sc)
#endif #endif
#if defined(ANALYST) || defined(DEBUG)
char *Yap_op_names[_std_top + 1] =
{
#define OPCODE(OP,TYPE) #OP
#include "YapOpcodes.h"
#undef OPCODE
};
#endif
Int Int
Yap_absmi(int inp) Yap_absmi(int inp)
{ {
@ -460,8 +475,8 @@ Yap_absmi(int inp)
{ {
op_numbers opcode = _Ystop; op_numbers opcode = _Ystop;
#ifdef DEBUG_XX
op_numbers old_op; op_numbers old_op;
#ifdef DEBUG_XX
unsigned long ops_done; unsigned long ops_done;
#endif #endif
@ -469,28 +484,25 @@ Yap_absmi(int inp)
nextop_write: nextop_write:
#ifdef DEBUG_XX
old_op = opcode; old_op = opcode;
#endif
opcode = PREG->u.o.opcw; opcode = PREG->u.o.opcw;
goto op_switch; goto op_switch;
nextop: nextop:
#ifdef DEBUG_XX
old_op = opcode; old_op = opcode;
#endif
opcode = PREG->opc; opcode = PREG->opc;
op_switch: op_switch:
#ifdef ANALYST #ifdef ANALYST
Yap_opcount[opcode]++; Yap_opcount[opcode]++;
Yap_2opcount[old_op][opcode]++;
#ifdef DEBUG_XX #ifdef DEBUG_XX
ops_done++; ops_done++;
/* if (B->cp_b > 0x103fff90) /* if (B->cp_b > 0x103fff90)
fprintf(stderr,"(%ld) doing %s, done %s, B is %p, HB is %p, H is %p\n", fprintf(stderr,"(%ld) doing %s, done %s, B is %p, HB is %p, H is %p\n",
ops_done,op_names[opcode],op_names[old_op],B,B->cp_h,H);*/ ops_done,Yap_op_names[opcode],Yap_op_names[old_op],B,B->cp_h,H);*/
#endif #endif
#endif /* ANALYST */ #endif /* ANALYST */
@ -6010,6 +6022,19 @@ Yap_absmi(int inp)
GONext(); GONext();
ENDOp(); ENDOp();
Op(put_xx_val, xxxx);
BEGD(d0);
BEGD(d1);
d0 = XREG(PREG->u.xxxx.xl1);
d1 = XREG(PREG->u.xxxx.xl2);
XREG(PREG->u.xxxx.xr1) = d0;
XREG(PREG->u.xxxx.xr2) = d1;
ENDD(d1);
ENDD(d0);
PREG = NEXTOP(PREG, xxxx);
GONext();
ENDOp();
Op(put_y_val, yx); Op(put_y_val, yx);
BEGD(d0); BEGD(d0);
d0 = YREG[PREG->u.yx.y]; d0 = YREG[PREG->u.yx.y];
@ -10437,7 +10462,8 @@ Yap_absmi(int inp)
always_set_pc(); always_set_pc();
GONext(); GONext();
} }
FAIL(); PREG = PREG->u.l.l;
GONext();
BEGP(pt0); BEGP(pt0);
deref_body(d1, pt0, p_eq_nvar1_unk2, p_eq_nvar1_nvar2); deref_body(d1, pt0, p_eq_nvar1_unk2, p_eq_nvar1_nvar2);
@ -10468,7 +10494,6 @@ Yap_absmi(int inp)
if (pt1 != pt0) { if (pt1 != pt0) {
PREG = PREG->u.l.l; PREG = PREG->u.l.l;
GONext(); GONext();
FAIL();
} }
PREG = NEXTOP(PREG, l); PREG = NEXTOP(PREG, l);
GONext(); GONext();

4
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: allocating space * * comments: allocating space *
* version:$Id: alloc.c,v 1.71 2005-05-31 19:42:27 vsc Exp $ * * version:$Id: alloc.c,v 1.72 2005-07-06 15:10:02 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
@ -823,7 +823,7 @@ ExtendWorkSpace(Int s, int fixed_allocation)
MALLOC_T a; MALLOC_T a;
prolog_exec_mode OldPrologMode = Yap_PrologMode; prolog_exec_mode OldPrologMode = Yap_PrologMode;
MALLOC_T base = WorkSpaceTop; MALLOC_T base = WorkSpaceTop;
#if !defined(_AIX) || !defined(__hpux) || !defined(__APPLE__) #if !defined(_AIX) && !defined(__hpux) && !defined(__APPLE__)
int fd; int fd;
#endif #endif

65
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c * * File: amasm.c *
* comments: abstract machine assembler * * comments: abstract machine assembler *
* * * *
* Last rev: $Date: 2005-06-01 21:23:44 $ * * Last rev: $Date: 2005-07-06 15:10:02 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.81 2005/06/01 21:23:44 vsc
* inline compare
*
* Revision 1.80 2005/06/01 20:25:23 vsc * Revision 1.80 2005/06/01 20:25:23 vsc
* == and \= should not need a choice-point in -> * == and \= should not need a choice-point in ->
* *
@ -152,7 +155,7 @@ STATIC_PROTO(yamop *a_e, (op_numbers, yamop *, int));
STATIC_PROTO(yamop *a_ue, (op_numbers, op_numbers, yamop *, int)); STATIC_PROTO(yamop *a_ue, (op_numbers, op_numbers, yamop *, int));
STATIC_PROTO(yamop *a_v, (op_numbers, yamop *, int, struct PSEUDO *)); STATIC_PROTO(yamop *a_v, (op_numbers, yamop *, int, struct PSEUDO *));
STATIC_PROTO(yamop *a_uv, (Ventry *,op_numbers, op_numbers, yamop *, int)); STATIC_PROTO(yamop *a_uv, (Ventry *,op_numbers, op_numbers, yamop *, int));
STATIC_PROTO(yamop *a_vr, (op_numbers, yamop *, int, struct PSEUDO *)); STATIC_PROTO(yamop *a_vr, (op_numbers, yamop *, int, struct intermediates *));
STATIC_PROTO(yamop *a_rv, (op_numbers, OPREG, yamop *, int, struct PSEUDO *)); STATIC_PROTO(yamop *a_rv, (op_numbers, OPREG, yamop *, int, struct PSEUDO *));
STATIC_PROTO(yamop *a_vv, (op_numbers, op_numbers, yamop *, int, struct intermediates *)); STATIC_PROTO(yamop *a_vv, (op_numbers, op_numbers, yamop *, int, struct intermediates *));
STATIC_PROTO(yamop *a_glist, (int *, yamop *, int, struct intermediates *)); STATIC_PROTO(yamop *a_glist, (int *, yamop *, int, struct intermediates *));
@ -533,8 +536,9 @@ a_vv(op_numbers opcode, op_numbers opcodew, yamop *code_p, int pass_no, struct i
} }
inline static yamop * inline static yamop *
a_vr(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc) a_vr(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
{ {
struct PSEUDO *cpc = cip->cpc;
Ventry *ve = (Ventry *) cpc->rnd1; Ventry *ve = (Ventry *) cpc->rnd1;
int is_y_var = (ve->KindOfVE == PermVar); int is_y_var = (ve->KindOfVE == PermVar);
@ -549,7 +553,27 @@ a_vr(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
} }
GONEXT(yx); GONEXT(yx);
} }
else { else if (opcode == _put_x_val &&
cpc->nextInst &&
cpc->nextInst->op == put_val_op &&
!(((Ventry *) cpc->nextInst->rnd1)->KindOfVE == PermVar)) {
/* peephole! two put_x_vars in a row */
if (pass_no) {
OPREG var_offset;
OPREG var_offset2;
Ventry *ve2 = (Ventry *) cpc->nextInst->rnd1;
var_offset = Var_Ref(ve, is_y_var);
code_p->opc = emit_op(_put_xx_val);
code_p->u.xxxx.xl1 = emit_xreg(var_offset);
code_p->u.xxxx.xr1 = emit_x(cpc->rnd2);
var_offset2 = Var_Ref(ve2, is_y_var);
code_p->u.xxxx.xl2 = emit_xreg(var_offset2);
code_p->u.xxxx.xr2 = emit_x(cpc->nextInst->rnd2);
}
cip->cpc = cpc->nextInst;
GONEXT(xxxx);
} else {
if (pass_no) { if (pass_no) {
OPREG var_offset; OPREG var_offset;
@ -877,6 +901,7 @@ a_rc(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
return code_p; return code_p;
} }
inline static yamop * inline static yamop *
a_rb(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip) a_rb(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
{ {
@ -944,7 +969,6 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
op_numbers op; op_numbers op;
int is_test = FALSE; int is_test = FALSE;
code_p = check_alloc(clinfo, code_p, pass_no, cip);
switch (Flags & 0x7f) { switch (Flags & 0x7f) {
case _equal: case _equal:
op = _p_equal; op = _p_equal;
@ -958,6 +982,7 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
is_test = TRUE; is_test = TRUE;
break; break;
case _functor: case _functor:
code_p = check_alloc(clinfo, code_p, pass_no, cip);
op = _p_functor; op = _p_functor;
break; break;
default: default:
@ -967,14 +992,13 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
longjmp(cip->CompilerBotch, 1); longjmp(cip->CompilerBotch, 1);
} }
if (is_test) { if (is_test) {
UInt lab;
if (clinfo->commit_lab) { if (clinfo->commit_lab) {
lab = clinfo->commit_lab; UInt lab = clinfo->commit_lab;
clinfo->commit_lab = 0; clinfo->commit_lab = 0;
return a_l(lab, op, code_p, pass_no, cip);
} else { } else {
lab = (CELL)FAILCODE; return a_il((CELL)FAILCODE, op, code_p, pass_no, cip);
} }
return a_il(lab, op, code_p, pass_no, cip);
} else { } else {
return a_e(op, code_p, pass_no); return a_e(op, code_p, pass_no);
} }
@ -1502,7 +1526,7 @@ a_cut(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip
code_p = check_alloc(clinfo, code_p, pass_no, cip); code_p = check_alloc(clinfo, code_p, pass_no, cip);
if (clinfo->dealloc_found) { if (clinfo->dealloc_found) {
return a_e(_cut_e, code_p, pass_no); return a_e(_cut_e, code_p, pass_no);
} else if (clinfo->alloc_found) { } else if (clinfo->alloc_found == 1) {
return a_e(_cut, code_p, pass_no); return a_e(_cut, code_p, pass_no);
} else { } else {
return a_e(_cut_t, code_p, pass_no); return a_e(_cut_t, code_p, pass_no);
@ -1796,18 +1820,14 @@ a_glist(int *do_not_optimise_uatomp, yamop *code_p, int pass_no, struct intermed
static yamop * static yamop *
a_deallocate(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip) a_deallocate(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip)
{ {
if (clinfo->alloc_found == 2) { if (clinfo->alloc_found == 1) {
/* this should never happen */
if (clinfo->CurrentPred->PredFlags & LogUpdatePredFlag)
code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip);
code_p = a_e(_allocate, code_p, pass_no);
}
if (NEXTOPC == execute_op) { if (NEXTOPC == execute_op) {
cip->cpc = cip->cpc->nextInst; cip->cpc = cip->cpc->nextInst;
code_p = a_p(_dexecute, clinfo, code_p, pass_no, cip); code_p = a_p(_dexecute, clinfo, code_p, pass_no, cip);
} else } else
code_p = a_e(_deallocate, code_p, pass_no); code_p = a_e(_deallocate, code_p, pass_no);
clinfo->dealloc_found = TRUE; clinfo->dealloc_found = TRUE;
}
return code_p; return code_p;
} }
@ -2394,7 +2414,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = cip->code_addr; code_p = cip->code_addr;
cl_u = (union clause_obj *)code_p; cl_u = (union clause_obj *)code_p;
cip->cpc = cip->CodeStart; cip->cpc = cip->CodeStart;
clinfo.alloc_found = clinfo.dealloc_found = FALSE; clinfo.alloc_found = 0;
clinfo.dealloc_found = FALSE;
clinfo.commit_lab = 0L; clinfo.commit_lab = 0L;
clinfo.CurrentPred = cip->CurrentPred; clinfo.CurrentPred = cip->CurrentPred;
cmp_info.c_type = TYPE_XX; cmp_info.c_type = TYPE_XX;
@ -2569,16 +2590,16 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
break; break;
#endif #endif
case get_var_op: case get_var_op:
code_p = a_vr(_get_x_var, code_p, pass_no, cip->cpc); code_p = a_vr(_get_x_var, code_p, pass_no, cip);
break; break;
case put_var_op: case put_var_op:
code_p = a_vr(_put_x_var, code_p, pass_no, cip->cpc); code_p = a_vr(_put_x_var, code_p, pass_no, cip);
break; break;
case get_val_op: case get_val_op:
code_p = a_vr(_get_x_val, code_p, pass_no, cip->cpc); code_p = a_vr(_get_x_val, code_p, pass_no, cip);
break; break;
case put_val_op: case put_val_op:
code_p = a_vr(_put_x_val, code_p, pass_no, cip->cpc); code_p = a_vr(_put_x_val, code_p, pass_no, cip);
break; break;
case get_num_op: case get_num_op:
case get_atom_op: case get_atom_op:
@ -2615,7 +2636,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_rf(_put_struct, code_p, pass_no, cip->cpc); code_p = a_rf(_put_struct, code_p, pass_no, cip->cpc);
break; break;
case put_unsafe_op: case put_unsafe_op:
code_p = a_vr((op_numbers)((int)_put_unsafe - 1), code_p, pass_no, cip->cpc); code_p = a_vr((op_numbers)((int)_put_unsafe - 1), code_p, pass_no, cip);
break; break;
case unify_var_op: case unify_var_op:
code_p = a_uvar(code_p, pass_no, cip); code_p = a_uvar(code_p, pass_no, cip);

149
C/analyst.c
View File

@ -28,17 +28,15 @@ static char SccsId[] = "%W% %G%";
#include <string.h> #include <string.h>
#endif #endif
YAP_ULONG_LONG Yap_opcount[_std_top + 1];
YAP_ULONG_LONG Yap_2opcount[_std_top + 1][_std_top + 1];
STATIC_PROTO(Int p_reset_op_counters, (void)); STATIC_PROTO(Int p_reset_op_counters, (void));
STATIC_PROTO(Int p_show_op_counters, (void)); STATIC_PROTO(Int p_show_op_counters, (void));
STATIC_PROTO(Int p_show_ops_by_group, (void)); STATIC_PROTO(Int p_show_ops_by_group, (void));
static char *op_names[_std_top + 1] =
{
#define OPCODE(OP,TYPE) #OP
#include "YapOpcodes.h"
#undef OPCODE
};
static Int static Int
p_reset_op_counters() p_reset_op_counters()
{ {
@ -46,7 +44,7 @@ p_reset_op_counters()
for (i = 0; i <= _std_top; ++i) for (i = 0; i <= _std_top; ++i)
Yap_opcount[i] = 0; Yap_opcount[i] = 0;
return (TRUE); return TRUE;
} }
static void static void
@ -54,8 +52,8 @@ print_instruction(int inst)
{ {
int j; int j;
fprintf(Yap_stderr, "%s", op_names[inst]); fprintf(Yap_stderr, "%s", Yap_op_names[inst]);
for (j = strlen(op_names[inst]); j < 25; j++) for (j = strlen(Yap_op_names[inst]); j < 25; j++)
putc(' ', Yap_stderr); putc(' ', Yap_stderr);
j = Yap_opcount[inst]; j = Yap_opcount[inst];
if (j < 100000000) { if (j < 100000000) {
@ -82,7 +80,7 @@ print_instruction(int inst)
} }
} }
} }
fprintf(Yap_stderr, "%d\n", Yap_opcount[inst]); fprintf(Yap_stderr, "%llu\n", Yap_opcount[inst]);
} }
static Int static Int
@ -92,10 +90,11 @@ p_show_op_counters()
char *program; char *program;
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (IsVarTerm(t1) || !IsAtomTerm(t1)) if (IsVarTerm(t1) || !IsAtomTerm(t1)) {
return (FALSE); return FALSE;
else } else {
program = RepAtom(AtomOfTerm(t1))->StrOfAE; program = RepAtom(AtomOfTerm(t1))->StrOfAE;
}
fprintf(Yap_stderr, "\n Instructions Executed in %s \n", program); fprintf(Yap_stderr, "\n Instructions Executed in %s \n", program);
for (i = 0; i <= _std_top; ++i) for (i = 0; i <= _std_top; ++i)
@ -119,17 +118,7 @@ p_show_op_counters()
print_instruction(_try_clause); print_instruction(_try_clause);
print_instruction(_try_in); print_instruction(_try_in);
print_instruction(_retry); print_instruction(_retry);
print_instruction(_trust_in);
print_instruction(_trust); print_instruction(_trust);
print_instruction(_retry_first);
print_instruction(_trust_first_in);
print_instruction(_trust_first);
print_instruction(_retry_tail);
print_instruction(_trust_tail_in);
print_instruction(_trust_tail);
print_instruction(_retry_head);
print_instruction(_trust_head_in);
print_instruction(_trust_head);
fprintf(Yap_stderr, "\n Disjunction Instructions\n"); fprintf(Yap_stderr, "\n Disjunction Instructions\n");
print_instruction(_either); print_instruction(_either);
@ -149,13 +138,9 @@ p_show_op_counters()
fprintf(Yap_stderr, "\n Indexing Instructions\n"); fprintf(Yap_stderr, "\n Indexing Instructions\n");
fprintf(Yap_stderr, "\n Switch on Type\n"); fprintf(Yap_stderr, "\n Switch on Type\n");
print_instruction(_switch_on_type); print_instruction(_switch_on_type);
print_instruction(_switch_on_nonv);
print_instruction(_switch_last);
print_instruction(_switch_on_head);
print_instruction(_switch_list_nl); print_instruction(_switch_list_nl);
print_instruction(_switch_list_nl_prefetch); print_instruction(_switch_on_arg_type);
print_instruction(_switch_nv_list); print_instruction(_switch_on_sub_arg_type);
print_instruction(_switch_l_list);
fprintf(Yap_stderr, "\n Switch on Value\n"); fprintf(Yap_stderr, "\n Switch on Value\n");
print_instruction(_if_cons); print_instruction(_if_cons);
print_instruction(_go_on_cons); print_instruction(_go_on_cons);
@ -243,6 +228,7 @@ p_show_op_counters()
print_instruction(_put_x_var); print_instruction(_put_x_var);
print_instruction(_put_y_var); print_instruction(_put_y_var);
print_instruction(_put_x_val); print_instruction(_put_x_val);
print_instruction(_put_xx_val);
print_instruction(_put_y_val); print_instruction(_put_y_val);
print_instruction(_put_unsafe); print_instruction(_put_unsafe);
print_instruction(_put_atom); print_instruction(_put_atom);
@ -290,7 +276,7 @@ p_show_op_counters()
print_instruction(_Ystop); print_instruction(_Ystop);
print_instruction(_Nstop); print_instruction(_Nstop);
return (TRUE); return TRUE;
} }
typedef struct { typedef struct {
@ -429,7 +415,8 @@ p_show_ops_by_group(void)
c_put.nyvar = c_put.nyvar =
Yap_opcount[_put_y_var]; Yap_opcount[_put_y_var];
c_put.nxval = c_put.nxval =
Yap_opcount[_put_x_val]; Yap_opcount[_put_x_val]+
2*Yap_opcount[_put_xx_val];
c_put.nyval = c_put.nyval =
Yap_opcount[_put_y_val]; Yap_opcount[_put_y_val];
c_put.ncons = c_put.ncons =
@ -543,7 +530,7 @@ p_show_ops_by_group(void)
Yap_opcount[_p_arg_cv] + Yap_opcount[_p_arg_cv] +
Yap_opcount[_p_arg_y_vv] + Yap_opcount[_p_arg_y_vv] +
Yap_opcount[_p_arg_y_cv] + Yap_opcount[_p_arg_y_cv] +
Yap_opcount[_p_functor]; Yap_opcount[_p_functor] +
Yap_opcount[_p_func2s_vv] + Yap_opcount[_p_func2s_vv] +
Yap_opcount[_p_func2s_cv] + Yap_opcount[_p_func2s_cv] +
Yap_opcount[_p_func2s_vc] + Yap_opcount[_p_func2s_vc] +
@ -559,8 +546,8 @@ p_show_ops_by_group(void)
Yap_opcount[_cut] + Yap_opcount[_cut] +
Yap_opcount[_cut_t] + Yap_opcount[_cut_t] +
Yap_opcount[_cut_e] + Yap_opcount[_cut_e] +
Yap_opcount[_comit_b_x] + Yap_opcount[_commit_b_x] +
Yap_opcount[_comit_b_y]; Yap_opcount[_commit_b_y];
c_control.nallocs = c_control.nallocs =
Yap_opcount[_allocate] + Yap_opcount[_allocate] +
@ -585,11 +572,6 @@ p_show_ops_by_group(void)
c_cp.ntries = c_cp.ntries =
Yap_opcount[_try_me] + Yap_opcount[_try_me] +
Yap_opcount[_try_me0] +
Yap_opcount[_try_me1] +
Yap_opcount[_try_me2] +
Yap_opcount[_try_me3] +
Yap_opcount[_try_me4] +
Yap_opcount[_try_and_mark] + Yap_opcount[_try_and_mark] +
Yap_opcount[_try_c] + Yap_opcount[_try_c] +
Yap_opcount[_try_clause] + Yap_opcount[_try_clause] +
@ -597,34 +579,14 @@ p_show_ops_by_group(void)
c_cp.nretries = c_cp.nretries =
Yap_opcount[_retry_me] + Yap_opcount[_retry_me] +
Yap_opcount[_retry_me0] +
Yap_opcount[_retry_me1] +
Yap_opcount[_retry_me2] +
Yap_opcount[_retry_me3] +
Yap_opcount[_retry_me4] +
Yap_opcount[_retry_and_mark] + Yap_opcount[_retry_and_mark] +
Yap_opcount[_retry_c] + Yap_opcount[_retry_c] +
Yap_opcount[_retry] + Yap_opcount[_retry] +
Yap_opcount[_trust_in] +
Yap_opcount[_retry_first] +
Yap_opcount[_trust_first_in] +
Yap_opcount[_retry_tail] +
Yap_opcount[_trust_tail_in] +
Yap_opcount[_retry_head] +
Yap_opcount[_trust_head_in] +
Yap_opcount[_or_else]; Yap_opcount[_or_else];
c_cp.ntrusts = c_cp.ntrusts =
Yap_opcount[_trust_me] + Yap_opcount[_trust_me] +
Yap_opcount[_trust_me0] +
Yap_opcount[_trust_me1] +
Yap_opcount[_trust_me2] +
Yap_opcount[_trust_me3] +
Yap_opcount[_trust_me4] +
Yap_opcount[_trust] + Yap_opcount[_trust] +
Yap_opcount[_trust_first] +
Yap_opcount[_trust_tail] +
Yap_opcount[_trust_head] +
Yap_opcount[_or_last]; Yap_opcount[_or_last];
choice_pts = choice_pts =
@ -635,13 +597,9 @@ p_show_ops_by_group(void)
indexes = indexes =
Yap_opcount[_jump_if_var] + Yap_opcount[_jump_if_var] +
Yap_opcount[_switch_on_type] + Yap_opcount[_switch_on_type] +
Yap_opcount[_switch_on_nonv] +
Yap_opcount[_switch_last] +
Yap_opcount[_switch_on_head] +
Yap_opcount[_switch_list_nl] + Yap_opcount[_switch_list_nl] +
Yap_opcount[_switch_list_nl_prefetch] + Yap_opcount[_switch_on_arg_type] +
Yap_opcount[_switch_nv_list] + Yap_opcount[_switch_on_sub_arg_type] +
Yap_opcount[_switch_l_list] +
Yap_opcount[_switch_on_cons] + Yap_opcount[_switch_on_cons] +
Yap_opcount[_go_on_cons] + Yap_opcount[_go_on_cons] +
Yap_opcount[_if_cons] + Yap_opcount[_if_cons] +
@ -820,16 +778,65 @@ p_show_ops_by_group(void)
fprintf(Yap_stderr, " TOTAL instructions: %8d (%3d%%)\n\n", total, fprintf(Yap_stderr, " TOTAL instructions: %8d (%3d%%)\n\n", total,
(total * 100) / total); (total * 100) / total);
return (TRUE); return TRUE;
}
static Int
p_show_sequences(void)
{
int i, j;
YAP_ULONG_LONG min;
YAP_ULONG_LONG sum = 0;
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "shows_sequences/1");
return FALSE;
}
if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "shows_sequences/1");
return FALSE;
}
min = (YAP_ULONG_LONG)IntegerOfTerm(t);
if (min <= 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "shows_sequences/1");
return FALSE;
}
if (min <= 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "shows_sequences/1");
return FALSE;
}
for (i = 0; i <= _std_top; ++i) {
sum += Yap_opcount[i];
}
for (i = 0; i <= _std_top; ++i) {
for (j = 0; j <= _std_top; ++j) {
YAP_ULONG_LONG seqs = Yap_2opcount[i][j];
if (seqs && sum/seqs <= min) {
/*
Term t[3], t0;
Functor f =
t[0] = Yap_MkFloatTerm(((double)seqs*100.0)/sum);
t[1] = Yap_LookupAtom(Yap_op_names[i]);
t[2] = Yap_LookupAtom(Yap_op_names[j]);
t0 = MkApplTerm(
Yap_MkPairTerm(Yap_op_names[i]
*/
fprintf(stderr,"%f -> %s,%s\n",((double)seqs*100.0)/sum,Yap_op_names[i],Yap_op_names[j]);
/* we found one */
}
}
}
return TRUE;
} }
void void
Yap_InitAnalystPreds(void) Yap_InitAnalystPreds(void)
{ {
Yap_InitCPred("reset_op_counters", 0, p_reset_op_counters, SafePredFlag |SyncPredFlag); Yap_InitCPred("wam_profile_reset_op_counters", 0, p_reset_op_counters, SafePredFlag |SyncPredFlag);
Yap_InitCPred("show_op_counters", 1, p_show_op_counters, SafePredFlag|SyncPredFlag); Yap_InitCPred("wam_profile_show_op_counters", 1, p_show_op_counters, SafePredFlag|SyncPredFlag);
Yap_InitCPred("show_ops_by_group", 1, p_show_ops_by_group, SafePredFlag |SyncPredFlag); Yap_InitCPred("wam_profile_show_ops_by_group", 1, p_show_ops_by_group, SafePredFlag |SyncPredFlag);
Yap_InitCPred("wam_profile_show_sequences", 1, p_show_sequences, SafePredFlag |SyncPredFlag);
} }
#endif /* ANALYST */ #endif /* ANALYST */

2
C/arrays.c
View File

@ -769,7 +769,7 @@ p_create_static_array(void)
/* Create a named array */ /* Create a named array */
AtomEntry *ae = RepAtom(AtomOfTerm(t)); AtomEntry *ae = RepAtom(AtomOfTerm(t));
StaticArrayEntry *pp; StaticArrayEntry *pp;
ArrayEntry *app = (ArrayEntry *) pp; ArrayEntry *app;
WRITE_LOCK(ae->ARWLock); WRITE_LOCK(ae->ARWLock);
pp = RepStaticArrayProp(ae->PropsOfAE); pp = RepStaticArrayProp(ae->PropsOfAE);

9
C/cdmgr.c
View File

@ -11,8 +11,11 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * comments: Code manager *
* * * *
* Last rev: $Date: 2005-06-08 00:35:27 $,$Author: vsc $ * * Last rev: $Date: 2005-07-06 15:10:03 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.163 2005/06/08 00:35:27 vsc
* fix silly calls such as 0.15 ( bug reported by Jude Shavlik)
*
* Revision 1.162 2005/06/04 07:27:33 ricroc * Revision 1.162 2005/06/04 07:27:33 ricroc
* long int support for tabling * long int support for tabling
* *
@ -877,7 +880,7 @@ kill_static_child_indxs(StaticIndex *indx)
kill_static_child_indxs(cl); kill_static_child_indxs(cl);
cl = next; cl = next;
} }
Yap_FreeCodeSpace((CODEADDR)indx); Yap_FreeCodeSpace((char *)indx);
} }
static void static void
@ -919,7 +922,7 @@ kill_off_lu_block(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
} }
} }
#endif #endif
Yap_FreeCodeSpace((CODEADDR)c); Yap_FreeCodeSpace((char *)c);
} }
static void static void

222
C/compiler.c
View File

@ -11,8 +11,12 @@
* File: compiler.c * * File: compiler.c *
* comments: Clause compiler * * comments: Clause compiler *
* * * *
* Last rev: $Date: 2005-05-25 21:43:32 $,$Author: vsc $ * * Last rev: $Date: 2005-07-06 15:10:03 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* 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.
*
* Revision 1.66 2005/05/12 03:36:32 vsc * Revision 1.66 2005/05/12 03:36:32 vsc
* debugger was making predicates meta instead of testing * debugger was making predicates meta instead of testing
* fix handling of dbrefs in facts and in subarguments. * fix handling of dbrefs in facts and in subarguments.
@ -135,6 +139,7 @@ typedef struct compiler_struct_struct {
Int vadr; Int vadr;
Int *Uses; Int *Uses;
Term *Contents; Term *Contents;
int needs_env;
CIntermediates cint; CIntermediates cint;
} compiler_struct; } compiler_struct;
@ -389,7 +394,7 @@ reset_vars(Ventry *vtable)
static Term static Term
optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cglobs) optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cglobs)
{ {
CExpEntry *p = cglobs->common_exps, *parent = cglobs->common_exps; CExpEntry *p = cglobs->common_exps;
int cmp = 0; int cmp = 0;
if (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t))) if (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t)))
@ -400,23 +405,18 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl
cmp = Yap_compare_terms(t, (p->TermOfCE)); cmp = Yap_compare_terms(t, (p->TermOfCE));
H = oldH; H = oldH;
if (cmp > 0) { if (cmp) {
parent = p; p = p->NextCE;
p = p->RightCE; } else {
}
else if (cmp < 0) {
parent = p;
p = p->LeftCE;
}
else
break; break;
} }
}
if (p != NULL) { /* already there */ if (p != NULL) { /* already there */
return (p->VarOfCE); return (p->VarOfCE);
} }
/* first occurrence */ /* first occurrence */
if (cglobs->onbranch) if (cglobs->onbranch || level > 1)
return (t); return t;
++(cglobs->n_common_exps); ++(cglobs->n_common_exps);
p = (CExpEntry *) Yap_AllocCMem(sizeof(CExpEntry), &cglobs->cint); p = (CExpEntry *) Yap_AllocCMem(sizeof(CExpEntry), &cglobs->cint);
@ -427,14 +427,8 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl
save_machine_regs(); save_machine_regs();
longjmp(cglobs->cint.CompilerBotch,4); longjmp(cglobs->cint.CompilerBotch,4);
} }
p->RightCE = NULL; p->NextCE = cglobs->common_exps;
p->LeftCE = NULL;
if (parent == NULL)
cglobs->common_exps = p; cglobs->common_exps = p;
else if (cmp > 0)
parent->RightCE = p;
else /* if (cmp < 0) */
parent->LeftCE = p;
if (IsApplTerm(t)) if (IsApplTerm(t))
c_var(p->VarOfCE, save_appl_flag, arity, level, cglobs); c_var(p->VarOfCE, save_appl_flag, arity, level, cglobs);
else if (IsPairTerm(t)) else if (IsPairTerm(t))
@ -615,7 +609,7 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
: unify_num_op) : : unify_num_op) :
write_num_op), (CELL) t, Zero, &cglobs->cint); write_num_op), (CELL) t, Zero, &cglobs->cint);
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
if (optimizer_on && (!cglobs->onhead || argno != 1 || level > 1) && level < 6) { if (optimizer_on && level < 6) {
t = optimize_ce(t, arity, level, cglobs); t = optimize_ce(t, arity, level, cglobs);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
c_var(t, argno, arity, level, cglobs); c_var(t, argno, arity, level, cglobs);
@ -664,7 +658,7 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
} }
#endif #endif
if (optimizer_on && (!cglobs->onhead || argno != 1 || level > 1)) { if (optimizer_on) {
t = optimize_ce(t, arity, level, cglobs); t = optimize_ce(t, arity, level, cglobs);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
c_var(t, argno, arity, level, cglobs); c_var(t, argno, arity, level, cglobs);
@ -693,39 +687,70 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
static void static void
c_eq(Term t1, Term t2, compiler_struct *cglobs) c_eq(Term t1, Term t2, compiler_struct *cglobs)
{ {
Term t; if (IsNonVarTerm(t1)) {
if (IsVarTerm(t2)) {
--cglobs->tmpreg; Term t = t1;
if (IsVarTerm(t2)) t1 = t2;
t = t2, t2 = t1, t1 = t; t2 = t;
if (IsVarTerm(t1)) { } else {
if (IsVarTerm(t2)) { /* both are variables */ /* compile unification */
if (IsNewVar(t2)) if (IsAtomicTerm(t1)) {
t = t2, t2 = t1, t1 = t; /* just check if they unify */
c_var(t2, cglobs->tmpreg, 2, 0, cglobs); if (!IsAtomicTerm(t2) || !Yap_unify(t1,t2)) {
cglobs->onhead = 1; /* they don't */
c_var(t1, cglobs->tmpreg, 2, 0, cglobs); Yap_emit(fail_op, Zero, Zero, &cglobs->cint);
cglobs->onhead = 0; return;
} }
else if (IsNewVar(t1)) { /* they do */
c_arg(cglobs->tmpreg, t2, 0, 0, cglobs); Yap_emit(nop_op, Zero, Zero, &cglobs->cint);
cglobs->onhead = 1; return;
c_var(t1, cglobs->tmpreg, 2, 0, cglobs); } else if (IsPairTerm(t1)) {
cglobs->onhead = 0; /* just check if they unify */
if (!IsPairTerm(t2)) {
/* they don't */
Yap_emit(fail_op, Zero, Zero, &cglobs->cint);
return;
} }
else { /* t2 is non var */ /* they might */
c_var(t1, cglobs->tmpreg, 2, 0, cglobs); c_eq(HeadOfTerm(t1), HeadOfTerm(t2), cglobs);
cglobs->onhead = 1; c_eq(TailOfTerm(t1), TailOfTerm(t2), cglobs);
c_arg(cglobs->tmpreg, t2, 0, 0, cglobs); } else if (IsRefTerm(t1)) {
cglobs->onhead = 0; /* just check if they unify */
if (t1 != t2) {
/* they don't */
Yap_emit(fail_op, Zero, Zero, &cglobs->cint);
return;
}
/* they do */
Yap_emit(nop_op, Zero, Zero, &cglobs->cint);
} else {
/* compound terms */
Functor f = FunctorOfTerm(t1);
UInt i, max;
/* just check if they unify */
if (!IsApplTerm(t2) ||
FunctorOfTerm(t2) != f) {
/* they don't */
Yap_emit(fail_op, Zero, Zero, &cglobs->cint);
return;
}
/* they might */
max = ArityOfFunctor(f);
for (i=0; i < max; i++) {
c_eq(ArgOfTerm(i+1,t1), ArgOfTerm(i+1,t2), cglobs);
}
return;
} }
} }
else {
c_arg(cglobs->tmpreg, t1, 0, 0, cglobs);
cglobs->onhead = 1;
c_arg(cglobs->tmpreg, t2, 0, 0, cglobs);
cglobs->onhead = 0;
} }
c_var(t1, 0, 0, 0, cglobs);
cglobs->onhead = TRUE;
if (IsVarTerm(t2)) {
c_var(t2, 0, 0, 0, cglobs);
} else {
c_arg(0, t2, 0, 0, cglobs);
}
cglobs->onhead = FALSE;
} }
static void static void
@ -1139,6 +1164,7 @@ c_functor(Term Goal, int mod, compiler_struct *cglobs)
Term t1 = ArgOfTerm(1, Goal); Term t1 = ArgOfTerm(1, Goal);
Term t2 = ArgOfTerm(2, Goal); Term t2 = ArgOfTerm(2, Goal);
Term t3 = ArgOfTerm(3, Goal); Term t3 = ArgOfTerm(3, Goal);
if (IsVarTerm(t1) && IsNewVar(t1)) { if (IsVarTerm(t1) && IsNewVar(t1)) {
c_bifun(_functor, t2, t3, t1, mod, cglobs); c_bifun(_functor, t2, t3, t1, mod, cglobs);
} else if (IsNonVarTerm(t1)) { } else if (IsNonVarTerm(t1)) {
@ -1164,6 +1190,7 @@ c_functor(Term Goal, int mod, compiler_struct *cglobs)
} else { } else {
Functor f = FunctorOfTerm(Goal); Functor f = FunctorOfTerm(Goal);
Prop p0 = PredPropByFunc(f, mod); Prop p0 = PredPropByFunc(f, mod);
if (profiling) if (profiling)
Yap_emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero, &cglobs->cint); Yap_emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero, &cglobs->cint);
else if (call_counting) else if (call_counting)
@ -1288,6 +1315,8 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
CELL l1 = ++cglobs->labelno; CELL l1 = ++cglobs->labelno;
CELL l2 = ++cglobs->labelno; CELL l2 = ++cglobs->labelno;
/* I need an either_me */
cglobs->needs_env = TRUE;
if (profiling) if (profiling)
Yap_emit(enter_profiling_op, (CELL)RepPredProp(PredPropByAtom(AtomRepeat,0)), Zero, &cglobs->cint); Yap_emit(enter_profiling_op, (CELL)RepPredProp(PredPropByAtom(AtomRepeat,0)), Zero, &cglobs->cint);
else if (call_counting) else if (call_counting)
@ -1337,9 +1366,9 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
f = FunctorOfTerm(Goal); f = FunctorOfTerm(Goal);
p = RepPredProp(p0 = Yap_PredPropByFunctorNonThreadLocal(f, mod)); p = RepPredProp(p0 = Yap_PredPropByFunctorNonThreadLocal(f, mod));
if (f == FunctorOr) { if (f == FunctorOr) {
Term arg;
CELL l = ++cglobs->labelno; CELL l = ++cglobs->labelno;
CELL m = ++cglobs->labelno; CELL m = ++cglobs->labelno;
Term arg;
int save = cglobs->onlast; int save = cglobs->onlast;
int savegoalno = cglobs->goalno; int savegoalno = cglobs->goalno;
int frst = TRUE; int frst = TRUE;
@ -1374,6 +1403,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
} }
else { else {
optimizing_commit = FALSE; optimizing_commit = FALSE;
cglobs->needs_env = TRUE;
Yap_emit_3ops(either_op, l, Zero, Zero, &cglobs->cint); Yap_emit_3ops(either_op, l, Zero, Zero, &cglobs->cint);
Yap_emit(restore_tmps_op, Zero, Zero, &cglobs->cint); Yap_emit(restore_tmps_op, Zero, Zero, &cglobs->cint);
frst = FALSE; frst = FALSE;
@ -1384,6 +1414,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
Yap_emit(label_op, l, Zero, &cglobs->cint); Yap_emit(label_op, l, Zero, &cglobs->cint);
Yap_emit(pushpop_or_op, Zero, Zero, &cglobs->cint); Yap_emit(pushpop_or_op, Zero, Zero, &cglobs->cint);
Yap_emit_3ops(orelse_op, l = ++cglobs->labelno, Zero, Zero, &cglobs->cint); Yap_emit_3ops(orelse_op, l = ++cglobs->labelno, Zero, Zero, &cglobs->cint);
cglobs->needs_env = TRUE;
} }
/* /*
* if(IsApplTerm(arg) && * if(IsApplTerm(arg) &&
@ -1429,12 +1460,16 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
cglobs->onlast = save; cglobs->onlast = save;
c_goal(ArgOfTerm(2, arg), mod, cglobs); c_goal(ArgOfTerm(2, arg), mod, cglobs);
} }
else else {
/* standard disjunction */
c_goal(ArgOfTerm(1, Goal), mod, cglobs); c_goal(ArgOfTerm(1, Goal), mod, cglobs);
}
if (!cglobs->onlast) { if (!cglobs->onlast) {
Yap_emit(jump_op, m, Zero, &cglobs->cint); Yap_emit(jump_op, m, Zero, &cglobs->cint);
} }
if (!optimizing_commit || !cglobs->onlast) {
cglobs->goalno = savegoalno + 1; cglobs->goalno = savegoalno + 1;
}
Goal = ArgOfTerm(2, Goal); Goal = ArgOfTerm(2, Goal);
++cglobs->curbranch; ++cglobs->curbranch;
cglobs->onbranch = cglobs->curbranch; cglobs->onbranch = cglobs->curbranch;
@ -1442,9 +1477,9 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
&& FunctorOfTerm(Goal) == FunctorOr); && FunctorOfTerm(Goal) == FunctorOr);
Yap_emit(pushpop_or_op, Zero, Zero, &cglobs->cint); Yap_emit(pushpop_or_op, Zero, Zero, &cglobs->cint);
Yap_emit(label_op, l, Zero, &cglobs->cint); Yap_emit(label_op, l, Zero, &cglobs->cint);
if (!optimizing_commit) if (!optimizing_commit) {
Yap_emit(orlast_op, Zero, Zero, &cglobs->cint); Yap_emit(orlast_op, Zero, Zero, &cglobs->cint);
else { } else {
optimizing_commit = FALSE; /* not really necessary */ optimizing_commit = FALSE; /* not really necessary */
} }
c_goal(Goal, mod, cglobs); c_goal(Goal, mod, cglobs);
@ -1474,6 +1509,8 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
int save = cglobs->onlast; int save = cglobs->onlast;
Term commitvar; Term commitvar;
/* for now */
cglobs->needs_env = TRUE;
commitvar = MkVarTerm(); commitvar = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) { if (H == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
@ -1713,8 +1750,10 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
Yap_emit(sync_op, (CELL)p, (CELL)(p->ArityOfPE), &cglobs->cint); Yap_emit(sync_op, (CELL)p, (CELL)(p->ArityOfPE), &cglobs->cint);
#endif /* YAPOR */ #endif /* YAPOR */
if (p->FunctorOfPred == FunctorExecuteInMod) { if (p->FunctorOfPred == FunctorExecuteInMod) {
cglobs->needs_env = TRUE;
Yap_emit_4ops(call_op, (CELL) p0, Zero, Zero, ArgOfTerm(2,Goal), &cglobs->cint); Yap_emit_4ops(call_op, (CELL) p0, Zero, Zero, ArgOfTerm(2,Goal), &cglobs->cint);
} else { } else {
cglobs->needs_env = TRUE;
Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &cglobs->cint); Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &cglobs->cint);
} }
/* functor is allowed to call the garbage collector */ /* functor is allowed to call the garbage collector */
@ -1739,6 +1778,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
if (is_tabled(cglobs->cint.CurrentPred)) { if (is_tabled(cglobs->cint.CurrentPred)) {
cglobs->needs_env = TRUE;
Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &cglobs->cint); Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &cglobs->cint);
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
} }
@ -1750,6 +1790,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
#endif #endif
} }
else { else {
cglobs->needs_env = TRUE;
Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &cglobs->cint); Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &cglobs->cint);
} }
} }
@ -1807,7 +1848,7 @@ inline static int
usesvar(compiler_vm_op ic) usesvar(compiler_vm_op ic)
{ {
if (ic >= get_var_op && ic <= put_val_op) if (ic >= get_var_op && ic <= put_val_op)
return (TRUE); return TRUE;
switch (ic) { switch (ic) {
case save_b_op: case save_b_op:
case commit_b_op: case commit_b_op:
@ -1873,7 +1914,7 @@ AssignPerm(PInstr *pc, compiler_struct *cglobs)
x->Var = v; x->Var = v;
EnvTmps = x; EnvTmps = x;
} }
} } else
#endif #endif
if (pc->op == call_op || pc->op == either_op || pc->op == orelse_op || pc->op == push_or_op) { if (pc->op == call_op || pc->op == either_op || pc->op == orelse_op || pc->op == push_or_op) {
#ifdef LOCALISE_VOIDS #ifdef LOCALISE_VOIDS
@ -1895,7 +1936,6 @@ 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);
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 /*
@ -1905,10 +1945,10 @@ AssignPerm(PInstr *pc, compiler_struct *cglobs)
v->NoOfVE = PermVar | (nperm++); v->NoOfVE = PermVar | (nperm++);
v->KindOfVE = PermVar; v->KindOfVE = PermVar;
v->FlagsOfVE |= PermFlag; v->FlagsOfVE |= PermFlag;
} } else {
else
v->NoOfVE = v->KindOfVE = TempVar; v->NoOfVE = v->KindOfVE = TempVar;
} }
}
} else if (pc->op == empty_call_op) { } else if (pc->op == empty_call_op) {
pc->rnd2 = nperm; pc->rnd2 = nperm;
} else if (pc->op == call_op || pc->op == either_op || pc->op == orelse_op || pc->op == push_or_op) { } else if (pc->op == call_op || pc->op == either_op || pc->op == orelse_op || pc->op == push_or_op) {
@ -2277,7 +2317,7 @@ checktemp(Int arg, Int rn, compiler_vm_op ic, compiler_struct *cglobs)
target2 = cglobs->MaxCTemps; target2 = cglobs->MaxCTemps;
n = v->RCountOfVE - 1; n = v->RCountOfVE - 1;
while (q != v->LastOpForV && (q = q->nextInst) != NIL) { while (q != v->LastOpForV && (q = q->nextInst) != NIL) {
if (q->rnd2 < 0); if (q->rnd2 <= 0); /* don't try to use REGISTER 0 */
else if (usesvar(ic = q->op) && arg == q->rnd1) { else if (usesvar(ic = q->op) && arg == q->rnd1) {
--n; --n;
if (ic == put_val_op) { if (ic == put_val_op) {
@ -2410,6 +2450,7 @@ c_layout(compiler_struct *cglobs)
/* tell put_values used in bip optimisation */ /* tell put_values used in bip optimisation */
int rn_kills = 0; int rn_kills = 0;
Int rn_to_kill[2]; Int rn_to_kill[2];
int needs_either = 0;
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;
@ -2426,10 +2467,9 @@ c_layout(compiler_struct *cglobs)
} }
cglobs->cint.cpc->nextInst = savepc; cglobs->cint.cpc->nextInst = savepc;
if (cglobs->needs_env) {
nperm = 0; nperm = 0;
AssignPerm(cglobs->cint.CodeStart, cglobs); AssignPerm(cglobs->cint.CodeStart, cglobs);
/* vsc: need to do it from the beginning to find which perm vars are active */
/* CheckUnsafe(cglobs->BodyStart, cglobs); */
#ifdef DEBUG #ifdef DEBUG
cglobs->pbvars = 0; cglobs->pbvars = 0;
#endif #endif
@ -2444,6 +2484,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;
@ -2463,6 +2504,12 @@ c_layout(compiler_struct *cglobs)
Int arg = cglobs->cint.cpc->rnd1; Int arg = cglobs->cint.cpc->rnd1;
Int rn = cglobs->cint.cpc->rnd2; Int rn = cglobs->cint.cpc->rnd2;
switch (ic) { switch (ic) {
case pop_or_op:
if (needs_either)
needs_either--;
case either_op:
needs_either++;
break;
#ifdef TABLING_INNER_CUTS #ifdef TABLING_INNER_CUTS
case cut_op: case cut_op:
case cutexit_op: case cutexit_op:
@ -2471,6 +2518,9 @@ c_layout(compiler_struct *cglobs)
#endif /* TABLING_INNER_CUTS */ #endif /* TABLING_INNER_CUTS */
case allocate_op: case allocate_op:
case deallocate_op: case deallocate_op:
if (!cglobs->needs_env) {
cglobs->cint.cpc->op = nop_op;
} else {
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
@ -2482,6 +2532,7 @@ c_layout(compiler_struct *cglobs)
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
#endif #endif
}
break; break;
case pop_op: case pop_op:
ic = (cglobs->cint.cpc->nextInst)->op; ic = (cglobs->cint.cpc->nextInst)->op;
@ -2608,19 +2659,36 @@ c_layout(compiler_struct *cglobs)
break; break;
case safe_call_op: case safe_call_op:
Arity = RepPredProp((Prop) arg)->ArityOfPE; Arity = RepPredProp((Prop) arg)->ArityOfPE;
/*
vsc: The variables will be in use after this!!!!
for (rn = 1; rn <= Arity; ++rn) for (rn = 1; rn <= Arity; ++rn)
--cglobs->Uses[rn]; --cglobs->Uses[rn];
*/
break; break;
case call_op: case call_op:
case label_op: case orelse_op:
/* case orlast_op:
* for(rn=1; rn<cglobs->MaxCTemps; ++rn) cglobs->Uses[rn] = {
* cglobs->Contents[rn] = NIL;
*/
up = cglobs->Uses; up = cglobs->Uses;
cop = cglobs->Contents; cop = cglobs->Contents;
for (rn = 1; rn < cglobs->MaxCTemps; ++rn) for (rn = 1; rn < cglobs->MaxCTemps; ++rn) {
*up++ = *cop++ = NIL; *up++ = *cop++ = NIL;
}
}
break;
case label_op:
{
up = cglobs->Uses;
cop = cglobs->Contents;
for (rn = 0; rn <= cglobs->MaxCTemps; ++rn) {
if (*cop != (TempVar | rn)) {
*up++ = *cop++ = NIL;
} else {
up++;
cop++;
}
}
}
break; break;
case cut_op: case cut_op:
case cutexit_op: case cutexit_op:
@ -2690,6 +2758,21 @@ c_optimize(PInstr *pc)
PInstr *npc = pc->nextInst; PInstr *npc = pc->nextInst;
pc->nextInst = opc; pc->nextInst = opc;
switch (pc->op) { switch (pc->op) {
case put_val_op:
case get_var_op:
case get_val_op:
{
Ventry *ve = (Ventry *) pc->rnd1;
if (ve->KindOfVE == TempVar) {
UInt argno = ve->NoOfVE & MaskVarAdrs;
if (argno == pc->rnd2) {
pc->op = nop_op;
}
}
}
onTail = 1;
break;
case save_pair_op: case save_pair_op:
{ {
Term ve = (Term) pc->rnd1; Term ve = (Term) pc->rnd1;
@ -2894,7 +2977,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
save_machine_regs(); save_machine_regs();
longjmp(cglobs.cint.CompilerBotch,3); longjmp(cglobs.cint.CompilerBotch,3);
} }
cglobs.Uses = (Term *)(H+maxvnum); cglobs.Uses = (Int *)(H+maxvnum);
cglobs.Contents = (Term *)(H+maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps); cglobs.Contents = (Term *)(H+maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps);
cglobs.curbranch = cglobs.onbranch = 0; cglobs.curbranch = cglobs.onbranch = 0;
cglobs.branch_pointer = cglobs.parent_branches; cglobs.branch_pointer = cglobs.parent_branches;
@ -2902,6 +2985,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
cglobs.max_args = 0; cglobs.max_args = 0;
cglobs.nvars = 0; cglobs.nvars = 0;
cglobs.tmpreg = 0; cglobs.tmpreg = 0;
cglobs.needs_env = FALSE;
/* /*
* 2000 added to H in case we need to construct call(G) when G is a * 2000 added to H in case we need to construct call(G) when G is a
* variable used as a goal * variable used as a goal

13
C/computils.c
View File

@ -11,8 +11,13 @@
* 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-01-04 02:50:21 $ * * Last rev: $Date: 2005-07-06 15:10:04 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.26 2005/01/04 02:50:21 vsc
* - allow MegaClauses with blobs
* - change Diffs to be thread specific
* - include Christian's updates
*
* Revision 1.25 2004/11/19 17:14:13 vsc * Revision 1.25 2004/11/19 17:14:13 vsc
* a few fixes for 64 bit compiling. * a few fixes for 64 bit compiling.
* *
@ -101,7 +106,7 @@ Yap_is_a_test_pred (Term arg, Term mod)
return FALSE; return FALSE;
if (pe->PredFlags & AsmPredFlag) { if (pe->PredFlags & AsmPredFlag) {
int op = pe->PredFlags & 0x7f; int op = pe->PredFlags & 0x7f;
if (op >= _atom && op <= _primitive) { if (op >= _atom && op <= _eq) {
return TRUE; return TRUE;
} }
return FALSE; return FALSE;
@ -379,7 +384,6 @@ ShowOp (char *f, struct PSEUDO *cpc)
Yap_DebugPutc (Yap_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X'); Yap_DebugPutc (Yap_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X');
Yap_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), Yap_DebugPutc, 0); Yap_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), Yap_DebugPutc, 0);
} }
break;
case 'm': case 'm':
Yap_plwrite (MkAtomTerm ((Atom) arg), Yap_DebugPutc, 0); Yap_plwrite (MkAtomTerm ((Atom) arg), Yap_DebugPutc, 0);
Yap_DebugPutc (Yap_c_error_stream,'/'); Yap_DebugPutc (Yap_c_error_stream,'/');
@ -527,7 +531,8 @@ static char *opformat[] =
"nop", "nop",
"get_var\t\t%v,%r", "get_var\t\t%v,%r",
"put_var\t\t%v,%r", "put_var\t\t%v,%r",
"get_val\t\t%v,%r", "get_val\t\t%v,%r"
,
"put_val\t\t%v,%r", "put_val\t\t%v,%r",
"get_atom\t%a,%r", "get_atom\t%a,%r",
"put_atom\t%a,%r", "put_atom\t%a,%r",

1
C/errors.c
View File

@ -522,6 +522,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[1]; Term ti[1];
i = strlen(tmpbuf);
ti[0] = where; ti[0] = where;
nt[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("consistency_error"),1), 1, ti); nt[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("consistency_error"),1), 1, ti);
tp = tmpbuf+i; tp = tmpbuf+i;

2
C/grow.c
View File

@ -893,7 +893,7 @@ growatomtable(void)
Atom natom; Atom natom;
CELL hash; CELL hash;
hash = HashFunction(ap->StrOfAE) % nsize; hash = HashFunction((unsigned char *)ap->StrOfAE) % nsize;
natom = ap->NextOfAE; natom = ap->NextOfAE;
ap->NextOfAE = ntb[hash].Entry; ap->NextOfAE = ntb[hash].Entry;
ntb[hash].Entry = catom; ntb[hash].Entry = catom;

23
C/heapgc.c
View File

@ -831,7 +831,7 @@ static void
init_dbtable(tr_fr_ptr trail_ptr) { init_dbtable(tr_fr_ptr trail_ptr) {
DeadClause *cl = DeadClauses; DeadClause *cl = DeadClauses;
db_vec0 = db_vec = (CODEADDR)TR; db_vec0 = db_vec = (ADDR)TR;
db_root = RBTreeCreate(); db_root = RBTreeCreate();
while (trail_ptr > (tr_fr_ptr)Yap_TrailBase) { while (trail_ptr > (tr_fr_ptr)Yap_TrailBase) {
register CELL trail_cell; register CELL trail_cell;
@ -890,17 +890,6 @@ init_dbtable(tr_fr_ptr trail_ptr) {
} }
} }
#ifndef ANALYST
static char *op_names[_std_top + 1] =
{
#define OPCODE(OP,TYPE) #OP
#include "YapOpcodes.h"
#undef OPCODE
};
#endif
#ifdef DEBUG #ifdef DEBUG
/* #define INSTRUMENT_GC 1 */ /* #define INSTRUMENT_GC 1 */
@ -1481,7 +1470,7 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
if (size < 0) { if (size < 0) {
PredEntry *pe = EnvPreg(gc_ENV[E_CP]); PredEntry *pe = EnvPreg(gc_ENV[E_CP]);
op_numbers op = Yap_op_from_opcode(ENV_ToOp(gc_ENV[E_CP])); op_numbers op = Yap_op_from_opcode(ENV_ToOp(gc_ENV[E_CP]));
fprintf(Yap_stderr,"ENV %p-%p(%d) %s\n", gc_ENV, pvbmap, size-EnvSizeInCells, op_names[op]); fprintf(Yap_stderr,"ENV %p-%p(%d) %s\n", gc_ENV, pvbmap, size-EnvSizeInCells, Yap_op_names[op]);
if (pe->ArityOfPE) if (pe->ArityOfPE)
fprintf(Yap_stderr," %s/%d\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE); fprintf(Yap_stderr," %s/%d\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE);
else else
@ -1730,11 +1719,11 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
PredEntry *pe = Yap_PredForChoicePt(gc_B); PredEntry *pe = Yap_PredForChoicePt(gc_B);
if (pe == NULL) { if (pe == NULL) {
fprintf(Yap_stderr,"%% marked %ld (%s)\n", total_marked, op_names[opnum]); fprintf(Yap_stderr,"%% marked %ld (%s)\n", total_marked, Yap_op_names[opnum]);
} else if (pe->ArityOfPE) { } else if (pe->ArityOfPE) {
fprintf(Yap_stderr,"%% %s/%d marked %ld (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]); fprintf(Yap_stderr,"%% %s/%d marked %ld (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, Yap_op_names[opnum]);
} else { } else {
fprintf(Yap_stderr,"%% %s marked %ld (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked, op_names[opnum]); fprintf(Yap_stderr,"%% %s marked %ld (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked, Yap_op_names[opnum]);
} }
} }
{ {
@ -1985,7 +1974,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
* object * object
*/ */
static void static inline void
into_relocation_chain(CELL_PTR current, CELL_PTR next) into_relocation_chain(CELL_PTR current, CELL_PTR next)
{ {
#ifdef TAGS_FAST_OPS #ifdef TAGS_FAST_OPS

5
C/init.c
View File

@ -192,10 +192,6 @@ void **Yap_ABSMI_OPCODES;
int Yap_sockets_io=0; int Yap_sockets_io=0;
#endif #endif
#if ANALYST
int Yap_opcount[_std_top + 1];
#endif
#if DEBUG #if DEBUG
#if COROUTINING #if COROUTINING
int Yap_Portray_delays = FALSE; int Yap_Portray_delays = FALSE;
@ -903,6 +899,7 @@ InitCodes(void)
Yap_heap_regs->consultbase = Yap_heap_regs->consultsp = Yap_heap_regs->consultbase = Yap_heap_regs->consultsp =
Yap_heap_regs->consultlow + Yap_heap_regs->consultcapacity; Yap_heap_regs->consultlow + Yap_heap_regs->consultcapacity;
Yap_heap_regs->compiler_compile_mode = 0; /* fast will be for native code */ Yap_heap_regs->compiler_compile_mode = 0; /* fast will be for native code */
Yap_heap_regs->compiler_optimizer_on = TRUE;
Yap_heap_regs->maxdepth = 0; Yap_heap_regs->maxdepth = 0;
Yap_heap_regs->maxlist = 0; Yap_heap_regs->maxlist = 0;

4
C/iopreds.c
View File

@ -859,12 +859,8 @@ p_prompt (void)
#include <readline/readline.h> #include <readline/readline.h>
#endif #endif
extern void add_history (const char *);
static char *ttyptr = NULL; static char *ttyptr = NULL;
static char *myrl_line = (char *) NULL; static char *myrl_line = (char *) NULL;
static int cur_out_sno = 2; static int cur_out_sno = 2;

22
C/stdpreds.c
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-05-26 18:01:11 $,$Author: rslopes $ * * Last rev: $Date: 2005-07-06 15:10:14 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.89 2005/05/26 18:01:11 rslopes
* *** empty log message ***
*
* Revision 1.88 2005/04/27 20:09:25 vsc * Revision 1.88 2005/04/27 20:09:25 vsc
* indexing code could get confused with suspension points * indexing code could get confused with suspension points
* some further improvements on oveflow handling * some further improvements on oveflow handling
@ -343,17 +346,6 @@ search_pc_pred(yamop *pc_ptr,clauseentry *beg, clauseentry *end) {
extern void Yap_InitAbsmi(void); extern void Yap_InitAbsmi(void);
extern int rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit0); extern int rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit0);
#ifdef ANALYST
static char *op_names[_std_top + 1] =
{
#define OPCODE(OP,TYPE) #OP
#include "YapOpcodes.h"
#undef OPCODE
};
#else
extern char *op_names[];
#endif
static Int profend(void); static Int profend(void);
static int static int
@ -409,13 +401,13 @@ showprofres(UInt type) {
} }
if (oldpc>(void *) rational_tree_loop && oldpc<(void *) Yap_InitAbsmi) { InUnify++; continue; } if (oldpc>(void *) rational_tree_loop && oldpc<(void *) Yap_InitAbsmi) { InUnify++; continue; }
y=(yamop *) ((long) pc_ptr-20); y=(yamop *) ((long) pc_ptr-20);
if ((void *) y->opc==Yap_ABSMI_OPCODES[_call_cpred] || (void *) y->opc==Yap_ABSMI_OPCODES[_call_usercpred]) { if (y->opc==Yap_opcode(_call_cpred) || y->opc==Yap_opcode(_call_usercpred)) {
InCCall++; /* I Was in a C Call */ InCCall++; /* I Was in a C Call */
pc_ptr=y; pc_ptr=y;
/* /*
printf("Aqui está um call_cpred(%p) \n",y->u.sla.sla_u.p->cs.f_code); printf("Aqui está um call_cpred(%p) \n",y->u.sla.sla_u.p->cs.f_code);
for(i=0;i<_std_top && pc_ptr->opc!=Yap_ABSMI_OPCODES[i];i++); for(i=0;i<_std_top && pc_ptr->opc!=Yap_ABSMI_OPCODES[i];i++);
printf("Outro syscall diferente %s\n", op_names[i]); printf("Outro syscall diferente %s\n", Yap_op_names[i]);
*/ */
continue; continue;
} }
@ -1521,7 +1513,7 @@ p_atom_length(void)
} }
return((Int)strlen(RepAtom(AtomOfTerm(t1))->StrOfAE) == len); return((Int)strlen(RepAtom(AtomOfTerm(t1))->StrOfAE) == len);
} else { } else {
Term tj = MkIntTerm(strlen(RepAtom(AtomOfTerm(t1))->StrOfAE)); Term tj = MkIntegerTerm(strlen(RepAtom(AtomOfTerm(t1))->StrOfAE));
return Yap_unify_constant(t2,tj); return Yap_unify_constant(t2,tj);
} }
} }

6
C/sysbits.c
View File

@ -1785,8 +1785,10 @@ p_shell (void)
int child = fork (); int child = fork ();
if (child == 0) if (child == 0)
{ /* let the children go */ { /* let the children go */
execl (shell, shell, "-c", Yap_FileNameBuf, NIL); if (!execl (shell, shell, "-c", Yap_FileNameBuf, NIL)) {
exit (TRUE); exit(-1);
}
exit(TRUE);
} }
{ /* put the father on wait */ { /* put the father on wait */
int result = child < 0 || int result = child < 0 ||

4
H/Yap.h
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 * * File: Yap.h.m4 *
* mods: * * mods: *
* comments: main header file for YAP * * comments: main header file for YAP *
* version: $Id: Yap.h,v 1.3 2005-05-31 08:19:31 ricroc Exp $ * * version: $Id: Yap.h,v 1.4 2005-07-06 15:10:14 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#include "config.h" #include "config.h"
@ -649,7 +649,7 @@ typedef enum
if you place things in the lower addresses (power to the libc people). if you place things in the lower addresses (power to the libc people).
*/ */
#if (defined(_AIX) || defined(_WIN32) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__linux__) || defined(IN_SECOND_QUADRANT) || defined(__CYGWIN__)) #if (defined(_AIX) || defined(_WIN32) || defined(__APPLE__) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__linux__) || defined(IN_SECOND_QUADRANT) || defined(__CYGWIN__))
#define USE_LOW32_TAGS 1 #define USE_LOW32_TAGS 1
#endif #endif

28
H/YapOpcodes.h
View File

@ -11,8 +11,11 @@
* File: YapOpcodes.h * * File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes * * comments: Central Table with all YAP opcodes *
* * * *
* Last rev: $Date: 2005-06-04 07:26:43 $ * * Last rev: $Date: 2005-07-06 15:10:15 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.30 2005/06/04 07:26:43 ricroc
* long int support for tabling
*
* Revision 1.29 2005/06/03 08:18:25 ricroc * Revision 1.29 2005/06/03 08:18:25 ricroc
* float support for tabling * float support for tabling
* *
@ -129,11 +132,11 @@
OPCODE(get_x_val ,xx), OPCODE(get_x_val ,xx),
OPCODE(get_y_val ,yx), OPCODE(get_y_val ,yx),
OPCODE(get_atom ,xc), OPCODE(get_atom ,xc),
OPCODE(get_2atoms ,cc), OPCODE(get_2atoms ,cc), /* peephole */
OPCODE(get_3atoms ,ccc), OPCODE(get_3atoms ,ccc), /* peephole */
OPCODE(get_4atoms ,cccc), OPCODE(get_4atoms ,cccc), /* peephole */
OPCODE(get_5atoms ,ccccc), OPCODE(get_5atoms ,ccccc), /* peephole */
OPCODE(get_6atoms ,cccccc), OPCODE(get_6atoms ,cccccc), /* peephole */
OPCODE(get_float ,xc), OPCODE(get_float ,xc),
OPCODE(get_longint ,xc), OPCODE(get_longint ,xc),
OPCODE(get_bigint ,xc), OPCODE(get_bigint ,xc),
@ -154,6 +157,7 @@
OPCODE(put_x_val ,xx), OPCODE(put_x_val ,xx),
OPCODE(put_y_val ,yx), OPCODE(put_y_val ,yx),
OPCODE(put_unsafe ,yx), OPCODE(put_unsafe ,yx),
OPCODE(put_xx_val ,xxxx), /* peephole */
OPCODE(put_atom ,xc), OPCODE(put_atom ,xc),
OPCODE(put_list ,x), OPCODE(put_list ,x),
OPCODE(put_struct ,xf), OPCODE(put_struct ,xf),
@ -231,14 +235,14 @@
OPCODE(write_n_atoms ,sc), OPCODE(write_n_atoms ,sc),
OPCODE(unify_n_voids ,os), OPCODE(unify_n_voids ,os),
OPCODE(write_n_voids ,s), OPCODE(write_n_voids ,s),
OPCODE(glist_valx ,ss), OPCODE(glist_valx ,ss), /* peephole */
OPCODE(glist_valy ,xy), OPCODE(glist_valy ,xy), /* peephole */
OPCODE(fcall ,sla), OPCODE(fcall ,sla),
OPCODE(dexecute ,l), OPCODE(dexecute ,l),
OPCODE(gl_void_varx ,xx), OPCODE(gl_void_varx ,xx), /* peephole */
OPCODE(gl_void_vary ,xy), OPCODE(gl_void_vary ,xy), /* peephole */
OPCODE(gl_void_valx ,xx), OPCODE(gl_void_valx ,xx), /* peephole */
OPCODE(gl_void_valy ,xy), OPCODE(gl_void_valy ,xy), /* peephole */
OPCODE(unify_x_loc ,ox), OPCODE(unify_x_loc ,ox),
OPCODE(unify_y_loc ,oy), OPCODE(unify_y_loc ,oy),
OPCODE(write_x_loc ,ox), OPCODE(write_x_loc ,ox),

11
H/absmi.h
View File

@ -148,17 +148,6 @@ register struct yami* P1REG asm ("bp"); /* can't use yamop before Yap.h */
**********************************************************************/ **********************************************************************/
#include <stdio.h> #include <stdio.h>
#endif #endif
#ifdef ANALYST
static char *op_names[_std_top + 1] =
{
#define OPCODE(OP,TYPE) #OP
#include "YapOpcodes.h"
#undef OPCODE
};
#endif
#if PUSH_REGS #if PUSH_REGS

24
H/amidefs.h
View File

@ -11,8 +11,11 @@
* File: amidefs.h * * File: amidefs.h *
* comments: Abstract machine peculiarities * * comments: Abstract machine peculiarities *
* * * *
* Last rev: $Date: 2005-05-30 06:07:35 $ * * Last rev: $Date: 2005-07-06 15:10:15 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.28 2005/05/30 06:07:35 vsc
* changes to support more tagging schemes from tabulation.
*
* Revision 1.27 2005/04/10 04:01:13 vsc * Revision 1.27 2005/04/10 04:01:13 vsc
* bug fixes, I hope! * bug fixes, I hope!
* *
@ -85,9 +88,13 @@ typedef enum {
#undef OPCODE #undef OPCODE
} op_numbers; } op_numbers;
#define _std_top _p_execute_tail #define _std_top _p_execute_tail
/* use similar trick for keeping instruction names */
#if defined(ANALYST) || defined(DEBUG)
extern char *Yap_op_names[_std_top + 1];
#endif
typedef enum { typedef enum {
_atom, _atom,
_atomic, _atomic,
@ -100,9 +107,9 @@ typedef enum {
_cut_by, _cut_by,
_db_ref, _db_ref,
_primitive, _primitive,
_equal,
_dif, _dif,
_eq, _eq,
_equal,
_plus, _plus,
_minus, _minus,
_times, _times,
@ -497,6 +504,13 @@ typedef struct yami {
wamreg x2; wamreg x2;
CELL next; CELL next;
} xxx; } xxx;
struct {
wamreg xl1;
wamreg xl2;
wamreg xr1;
wamreg xr2;
CELL next;
} xxxx;
struct { struct {
wamreg x; wamreg x;
Int c; Int c;
@ -720,7 +734,9 @@ extern void **Yap_ABSMI_OPCODES;
/* used to find out how many instructions of each kind are executed */ /* used to find out how many instructions of each kind are executed */
#ifdef ANALYST #ifdef ANALYST
extern int Yap_opcount[_std_top+1]; extern YAP_ULONG_LONG Yap_opcount[_std_top + 1];
extern YAP_ULONG_LONG Yap_2opcount[_std_top + 1][_std_top + 1];
#endif /* ANALYST */ #endif /* ANALYST */
#if DEPTH_LIMIT #if DEPTH_LIMIT

7
H/clause.h
View File

@ -309,12 +309,11 @@ typedef enum {
} find_pred_type; } find_pred_type;
Int STD_PROTO(Yap_PredForCode,(yamop *, find_pred_type, Atom *, UInt *, Term *)); Int STD_PROTO(Yap_PredForCode,(yamop *, find_pred_type, Atom *, UInt *, Term *));
#ifdef DEBUG
void STD_PROTO(Yap_bug_location,(yamop *));
LogUpdClause *STD_PROTO(Yap_new_ludbe,(Term, PredEntry *, UInt)); LogUpdClause *STD_PROTO(Yap_new_ludbe,(Term, PredEntry *, UInt));
Term STD_PROTO(Yap_LUInstance,(LogUpdClause *, UInt)); Term STD_PROTO(Yap_LUInstance,(LogUpdClause *, UInt));
#ifdef DEBUG
void STD_PROTO(Yap_bug_location,(yamop *));
#endif #endif

19
H/compile.h
View File

@ -201,7 +201,7 @@ typedef struct CEXPENTRY {
Term TermOfCE; Term TermOfCE;
PInstr *CodeOfCE; PInstr *CodeOfCE;
Term VarOfCE; Term VarOfCE;
struct CEXPENTRY *RightCE, *LeftCE; struct CEXPENTRY *NextCE;
} CExpEntry; } CExpEntry;
@ -242,14 +242,15 @@ typedef struct intermediates {
#define PermVar 0x03000000L #define PermVar 0x03000000L
#define save_b_flag 10000 #define save_b_flag 0x10000
#define commit_b_flag 10001 #define commit_b_flag 0x10001
#define save_appl_flag 10002 #define save_appl_flag 0x10002
#define save_pair_flag 10004 #define save_pair_flag 0x10004
#define f_flag 10008 #define f_flag 0x10008
#define bt1_flag 10010 #define bt1_flag 0x10010
#define bt2_flag 10020 #define bt2_flag 0x10020
#define patch_b_flag 10040 #define patch_b_flag 0x10040
#define init_v_flag 0x10080
#define Zero 0 #define Zero 0

14
H/rclause.h
View File

@ -12,8 +12,11 @@
* File: rclause.h * * File: rclause.h *
* comments: walk through a clause * * comments: walk through a clause *
* * * *
* Last rev: $Date: 2005-06-04 07:26:43 $,$Author: ricroc $ * * Last rev: $Date: 2005-07-06 15:10:15 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.7 2005/06/04 07:26:43 ricroc
* long int support for tabling
*
* Revision 1.6 2005/06/03 08:18:25 ricroc * Revision 1.6 2005/06/03 08:18:25 ricroc
* float support for tabling * float support for tabling
* *
@ -86,7 +89,7 @@ restore_opcodes(yamop *pc)
op_numbers op = Yap_op_from_opcode(pc->opc); op_numbers op = Yap_op_from_opcode(pc->opc);
pc->opc = Yap_opcode(op); pc->opc = Yap_opcode(op);
#ifdef DEBUG_RESTORE2 #ifdef DEBUG_RESTORE2
fprintf(stderr, "%s ", op_names[op]); fprintf(stderr, "%s ", Yap_op_names[op]);
#endif #endif
switch (op) { switch (op) {
case _Nstop: case _Nstop:
@ -368,6 +371,13 @@ restore_opcodes(yamop *pc)
pc->u.xx.xl = XAdjust(pc->u.xx.xl); pc->u.xx.xl = XAdjust(pc->u.xx.xl);
pc = NEXTOP(pc,xx); pc = NEXTOP(pc,xx);
break; break;
case _put_xx_val:
pc->u.xxxx.xr1 = XAdjust(pc->u.xxxx.xr1);
pc->u.xxxx.xl1 = XAdjust(pc->u.xxxx.xl1);
pc->u.xxxx.xr2 = XAdjust(pc->u.xxxx.xr2);
pc->u.xxxx.xl2 = XAdjust(pc->u.xxxx.xl2);
pc = NEXTOP(pc,xxxx);
break;
/* instructions type yx */ /* instructions type yx */
case _get_y_var: case _get_y_var:
case _get_y_val: case _get_y_val:

16
H/rheap.h
View File

@ -11,8 +11,12 @@
* File: rheap.h * * File: rheap.h *
* comments: walk through heap code * * comments: walk through heap code *
* * * *
* Last rev: $Date: 2005-06-01 13:53:46 $,$Author: vsc $ * * Last rev: $Date: 2005-07-06 15:10:15 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.50 2005/06/01 13:53:46 vsc
* improve bb routines to use the DB efficiently
* change interface between DB and BB.
*
* Revision 1.49 2005/05/30 03:26:37 vsc * Revision 1.49 2005/05/30 03:26:37 vsc
* add some atom gc fixes * add some atom gc fixes
* *
@ -71,16 +75,6 @@ static char SccsId[] = "@(#)rheap.c 1.3 3/15/90";
#define Atomics 0 #define Atomics 0
#define Funcs 1 #define Funcs 1
#if DEBUG_RESTORE2
static char *op_names[_std_top + 1] =
{
#define OPCODE(OP,TYPE) #OP
#include "YapOpcodes.h"
#undef OPCODE
};
#endif /* DEBUG_RESTORE2 */
/* Now, everything on its place so you must adjust the pointers */ /* Now, everything on its place so you must adjust the pointers */
static void static void

3
H/sshift.h
View File

@ -228,7 +228,8 @@ inline EXTERN Functor
FuncAdjust (Functor f) FuncAdjust (Functor f)
{ {
if (!IsExtensionFunctor(f)) if (!IsExtensionFunctor(f))
return (Functor) ((Functor) (CharP (f) + HDiff)); return (Functor) ((CharP (f) + HDiff));
return f;
} }

4
H/yapio.h
View File

@ -320,10 +320,10 @@ extern int Yap_Portray_delays;
#endif #endif
#endif #endif
EXTERN inline UInt STD_PROTO(HashFunction, (char *)); EXTERN inline UInt STD_PROTO(HashFunction, (unsigned char *));
EXTERN inline UInt EXTERN inline UInt
HashFunction(char *CHP) HashFunction(unsigned char *CHP)
{ {
/* djb2 */ /* djb2 */
UInt hash = 5381; UInt hash = 5381;

45
library/ordsets.yap
View File

@ -156,39 +156,36 @@ ord_intersect(L1, L2, L) :-
% is true when Intersection is the ordered representation of Set1 % is true when Intersection is the ordered representation of Set1
% and Set2, provided that Set1 and Set2 are ordered sets. % and Set2, provided that Set1 and Set2 are ordered sets.
ord_intersection(_, [], []) :- !.
ord_intersection([], _, []) :- !. ord_intersection([], _, []) :- !.
ord_intersection([_|_], [], []) :- !.
ord_intersection([Head1|Tail1], [Head2|Tail2], Intersection) :- ord_intersection([Head1|Tail1], [Head2|Tail2], Intersection) :-
compare(Order, Head1, Head2), ( Head1 == Head2 ->
ord_intersection(Order, Head1, Tail1, Head2, Tail2, Intersection). Intersection = [Head1|Tail],
ord_intersection(Tail1, Tail2, Tail)
ord_intersection(=, Head, Tail1, _, Tail2, [Head|Intersection]) :- ;
ord_intersection(Tail1, Tail2, Intersection). Head1 @< Head2 ->
ord_intersection(<, _, Tail1, Head2, Tail2, Intersection) :- ord_intersection(Tail1, [Head2|Tail2], Intersection)
ord_intersection(Tail1, [Head2|Tail2], Intersection). ;
ord_intersection(>, Head1, Tail1, _, Tail2, Intersection) :- ord_intersection([Head1|Tail1], Tail2, Intersection)
ord_intersection([Head1|Tail1], Tail2, Intersection). ).
% ord_intersection(+Set1, +Set2, ?Intersection, ?Difference) % ord_intersection(+Set1, +Set2, ?Intersection, ?Difference)
% is true when Intersection is the ordered representation of Set1 % is true when Intersection is the ordered representation of Set1
% and Set2, provided that Set1 and Set2 are ordered sets. % and Set2, provided that Set1 and Set2 are ordered sets.
ord_intersection(_, [], [], []) :- !.
ord_intersection([], L, [], L) :- !. ord_intersection([], L, [], L) :- !.
ord_intersection([_|_], [], [], []) :- !.
ord_intersection([Head1|Tail1], [Head2|Tail2], Intersection, Difference) :- ord_intersection([Head1|Tail1], [Head2|Tail2], Intersection, Difference) :-
compare(Order, Head1, Head2), ( Head1 == Head2 ->
ord_intersection(Order, Head1, Tail1, Head2, Tail2, Intersection, Difference). Intersection = [Head1|Tail],
ord_intersection(Tail1, Tail2, Tail, Difference)
ord_intersection(=, Head, Tail1, _, Tail2, [Head|Intersection], Difference) :- ;
ord_intersection(Tail1, Tail2, Intersection, Difference). Head1 @< Head2 ->
ord_intersection(<, _, Tail1, Head2, Tail2, Intersection, Difference) :- ord_intersection(Tail1, [Head2|Tail2], Intersection, Difference)
ord_intersection(Tail1, [Head2|Tail2], Intersection, Difference). ;
ord_intersection(>, Head1, Tail1, Head2, Tail2, Intersection, [Head2|Difference]) :- Difference = [Head2|HDifference],
ord_intersection([Head1|Tail1], Tail2, Intersection, Difference). ord_intersection([Head1|Tail1], Tail2, Intersection, HDifference)
).
% ord_seteq(+Set1, +Set2) % ord_seteq(+Set1, +Set2)

2
m4/Yatom.h.m4
View File

@ -571,5 +571,3 @@ typedef enum {
CHARSIO_MODULE = 4, CHARSIO_MODULE = 4,
TERMS_MODULE = 5 TERMS_MODULE = 5
} default_modules; } default_modules;

8
pl/boot.yap
View File

@ -16,6 +16,12 @@
*************************************************************************/ *************************************************************************/
% process an input clause % process an input clause
'$test'(I,D,H,[Y|L]) :-
arg(I,D,X), ( X=':' ; integer(X)),
arg(I,H,Y), var(Y), !,
I1 is I-1,
'$module_u_vars'(I1,D,H,L).
% This one should come first so that disjunctions and long distance % This one should come first so that disjunctions and long distance
% cuts are compiled right with co-routining. % cuts are compiled right with co-routining.
@ -31,7 +37,7 @@ true :- true.
repeat, repeat,
'$set_input'(user),'$set_output'(user), '$set_input'(user),'$set_output'(user),
'$current_module'(Module), '$current_module'(Module),
( Module=user -> ( Module==user ->
'$compile_mode'(_,0) '$compile_mode'(_,0)
; ;
format(user_error,'[~w]~n', [Module]) format(user_error,'[~w]~n', [Module])

4
pl/debug.yap
View File

@ -219,6 +219,7 @@ leash(X) :-
-----------------------------------------------------------------------------*/ -----------------------------------------------------------------------------*/
debugging :- debugging :-
( recorded('$debug',on,_) -> ( recorded('$debug',on,_) ->
'$print_message'(help,debug(debug)) '$print_message'(help,debug(debug))
@ -375,6 +376,7 @@ debugging :-
fail fail
). ).
'$enter_goal'(GoalNumber, G, Module) :- '$enter_goal'(GoalNumber, G, Module) :-
'$avoid_goal'(GoalNumber, G, Module), !. '$avoid_goal'(GoalNumber, G, Module), !.
'$enter_goal'(GoalNumber, G, Module) :- '$enter_goal'(GoalNumber, G, Module) :-
@ -420,7 +422,6 @@ debugging :-
'$continue_debugging'(InControl,G,M), '$continue_debugging'(InControl,G,M),
'$execute_nonstop'(G, M). '$execute_nonstop'(G, M).
'$trace'(P,G,Module,L) :- '$trace'(P,G,Module,L) :-
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
@ -446,6 +447,7 @@ debugging :-
), ),
!. !.
'$unleashed'(call) :- get_value('$leash',L), L /\ 2'1000 =:= 0. '$unleashed'(call) :- get_value('$leash',L), L /\ 2'1000 =:= 0.
'$unleashed'(exit) :- get_value('$leash',L), L /\ 2'0100 =:= 0. '$unleashed'(exit) :- get_value('$leash',L), L /\ 2'0100 =:= 0.
'$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0. '$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0.