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 *
* 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 $
* 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
* float support for tabling
*
@ -321,6 +324,18 @@ void prof_alrm(int signo, siginfo_t *si, ucontext_t *sc)
#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
Yap_absmi(int inp)
{
@ -460,8 +475,8 @@ Yap_absmi(int inp)
{
op_numbers opcode = _Ystop;
#ifdef DEBUG_XX
op_numbers old_op;
#ifdef DEBUG_XX
unsigned long ops_done;
#endif
@ -469,28 +484,25 @@ Yap_absmi(int inp)
nextop_write:
#ifdef DEBUG_XX
old_op = opcode;
#endif
opcode = PREG->u.o.opcw;
goto op_switch;
nextop:
#ifdef DEBUG_XX
old_op = opcode;
#endif
opcode = PREG->opc;
op_switch:
#ifdef ANALYST
Yap_opcount[opcode]++;
Yap_2opcount[old_op][opcode]++;
#ifdef DEBUG_XX
ops_done++;
/* if (B->cp_b > 0x103fff90)
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 /* ANALYST */
@ -6010,6 +6022,19 @@ Yap_absmi(int inp)
GONext();
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);
BEGD(d0);
d0 = YREG[PREG->u.yx.y];
@ -10437,7 +10462,8 @@ Yap_absmi(int inp)
always_set_pc();
GONext();
}
FAIL();
PREG = PREG->u.l.l;
GONext();
BEGP(pt0);
deref_body(d1, pt0, p_eq_nvar1_unk2, p_eq_nvar1_nvar2);
@ -10468,7 +10494,6 @@ Yap_absmi(int inp)
if (pt1 != pt0) {
PREG = PREG->u.l.l;
GONext();
FAIL();
}
PREG = NEXTOP(PREG, l);
GONext();

4
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* 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
static char SccsId[] = "%W% %G%";
@ -823,7 +823,7 @@ ExtendWorkSpace(Int s, int fixed_allocation)
MALLOC_T a;
prolog_exec_mode OldPrologMode = Yap_PrologMode;
MALLOC_T base = WorkSpaceTop;
#if !defined(_AIX) || !defined(__hpux) || !defined(__APPLE__)
#if !defined(_AIX) && !defined(__hpux) && !defined(__APPLE__)
int fd;
#endif

77
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c *
* 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 $
* Revision 1.81 2005/06/01 21:23:44 vsc
* inline compare
*
* Revision 1.80 2005/06/01 20:25:23 vsc
* == 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_v, (op_numbers, yamop *, int, struct PSEUDO *));
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_vv, (op_numbers, op_numbers, 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 *
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;
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);
}
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) {
OPREG var_offset;
@ -877,6 +901,7 @@ a_rc(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
return code_p;
}
inline static yamop *
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;
int is_test = FALSE;
code_p = check_alloc(clinfo, code_p, pass_no, cip);
switch (Flags & 0x7f) {
case _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;
break;
case _functor:
code_p = check_alloc(clinfo, code_p, pass_no, cip);
op = _p_functor;
break;
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);
}
if (is_test) {
UInt lab;
if (clinfo->commit_lab) {
lab = clinfo->commit_lab;
UInt lab = clinfo->commit_lab;
clinfo->commit_lab = 0;
return a_l(lab, op, code_p, pass_no, cip);
} 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 {
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);
if (clinfo->dealloc_found) {
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);
} else {
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 *
a_deallocate(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (clinfo->alloc_found == 2) {
/* 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 (clinfo->alloc_found == 1) {
if (NEXTOPC == execute_op) {
cip->cpc = cip->cpc->nextInst;
code_p = a_p(_dexecute, clinfo, code_p, pass_no, cip);
} else
code_p = a_e(_deallocate, code_p, pass_no);
clinfo->dealloc_found = TRUE;
}
if (NEXTOPC == execute_op) {
cip->cpc = cip->cpc->nextInst;
code_p = a_p(_dexecute, clinfo, code_p, pass_no, cip);
} else
code_p = a_e(_deallocate, code_p, pass_no);
clinfo->dealloc_found = TRUE;
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;
cl_u = (union clause_obj *)code_p;
cip->cpc = cip->CodeStart;
clinfo.alloc_found = clinfo.dealloc_found = FALSE;
clinfo.alloc_found = 0;
clinfo.dealloc_found = FALSE;
clinfo.commit_lab = 0L;
clinfo.CurrentPred = cip->CurrentPred;
cmp_info.c_type = TYPE_XX;
@ -2568,17 +2589,17 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_n(_write_s_end, Unsigned(0));
break;
#endif
case get_var_op:
code_p = a_vr(_get_x_var, code_p, pass_no, cip->cpc);
case get_var_op:
code_p = a_vr(_get_x_var, code_p, pass_no, cip);
break;
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;
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;
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;
case get_num_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);
break;
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;
case unify_var_op:
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>
#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_show_op_counters, (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
p_reset_op_counters()
{
@ -46,7 +44,7 @@ p_reset_op_counters()
for (i = 0; i <= _std_top; ++i)
Yap_opcount[i] = 0;
return (TRUE);
return TRUE;
}
static void
@ -54,8 +52,8 @@ print_instruction(int inst)
{
int j;
fprintf(Yap_stderr, "%s", op_names[inst]);
for (j = strlen(op_names[inst]); j < 25; j++)
fprintf(Yap_stderr, "%s", Yap_op_names[inst]);
for (j = strlen(Yap_op_names[inst]); j < 25; j++)
putc(' ', Yap_stderr);
j = Yap_opcount[inst];
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
@ -92,10 +90,11 @@ p_show_op_counters()
char *program;
Term t1 = Deref(ARG1);
if (IsVarTerm(t1) || !IsAtomTerm(t1))
return (FALSE);
else
if (IsVarTerm(t1) || !IsAtomTerm(t1)) {
return FALSE;
} else {
program = RepAtom(AtomOfTerm(t1))->StrOfAE;
}
fprintf(Yap_stderr, "\n Instructions Executed in %s \n", program);
for (i = 0; i <= _std_top; ++i)
@ -119,17 +118,7 @@ p_show_op_counters()
print_instruction(_try_clause);
print_instruction(_try_in);
print_instruction(_retry);
print_instruction(_trust_in);
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");
print_instruction(_either);
@ -149,13 +138,9 @@ p_show_op_counters()
fprintf(Yap_stderr, "\n Indexing Instructions\n");
fprintf(Yap_stderr, "\n Switch on Type\n");
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_prefetch);
print_instruction(_switch_nv_list);
print_instruction(_switch_l_list);
print_instruction(_switch_on_arg_type);
print_instruction(_switch_on_sub_arg_type);
fprintf(Yap_stderr, "\n Switch on Value\n");
print_instruction(_if_cons);
print_instruction(_go_on_cons);
@ -243,6 +228,7 @@ p_show_op_counters()
print_instruction(_put_x_var);
print_instruction(_put_y_var);
print_instruction(_put_x_val);
print_instruction(_put_xx_val);
print_instruction(_put_y_val);
print_instruction(_put_unsafe);
print_instruction(_put_atom);
@ -290,7 +276,7 @@ p_show_op_counters()
print_instruction(_Ystop);
print_instruction(_Nstop);
return (TRUE);
return TRUE;
}
typedef struct {
@ -429,7 +415,8 @@ p_show_ops_by_group(void)
c_put.nyvar =
Yap_opcount[_put_y_var];
c_put.nxval =
Yap_opcount[_put_x_val];
Yap_opcount[_put_x_val]+
2*Yap_opcount[_put_xx_val];
c_put.nyval =
Yap_opcount[_put_y_val];
c_put.ncons =
@ -543,7 +530,7 @@ p_show_ops_by_group(void)
Yap_opcount[_p_arg_cv] +
Yap_opcount[_p_arg_y_vv] +
Yap_opcount[_p_arg_y_cv] +
Yap_opcount[_p_functor];
Yap_opcount[_p_functor] +
Yap_opcount[_p_func2s_vv] +
Yap_opcount[_p_func2s_cv] +
Yap_opcount[_p_func2s_vc] +
@ -559,8 +546,8 @@ p_show_ops_by_group(void)
Yap_opcount[_cut] +
Yap_opcount[_cut_t] +
Yap_opcount[_cut_e] +
Yap_opcount[_comit_b_x] +
Yap_opcount[_comit_b_y];
Yap_opcount[_commit_b_x] +
Yap_opcount[_commit_b_y];
c_control.nallocs =
Yap_opcount[_allocate] +
@ -585,11 +572,6 @@ p_show_ops_by_group(void)
c_cp.ntries =
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_c] +
Yap_opcount[_try_clause] +
@ -597,34 +579,14 @@ p_show_ops_by_group(void)
c_cp.nretries =
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_c] +
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];
c_cp.ntrusts =
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_first] +
Yap_opcount[_trust_tail] +
Yap_opcount[_trust_head] +
Yap_opcount[_or_last];
choice_pts =
@ -635,13 +597,9 @@ p_show_ops_by_group(void)
indexes =
Yap_opcount[_jump_if_var] +
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_prefetch] +
Yap_opcount[_switch_nv_list] +
Yap_opcount[_switch_l_list] +
Yap_opcount[_switch_on_arg_type] +
Yap_opcount[_switch_on_sub_arg_type] +
Yap_opcount[_switch_on_cons] +
Yap_opcount[_go_on_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,
(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
Yap_InitAnalystPreds(void)
{
Yap_InitCPred("reset_op_counters", 0, p_reset_op_counters, SafePredFlag |SyncPredFlag);
Yap_InitCPred("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_reset_op_counters", 0, p_reset_op_counters, SafePredFlag |SyncPredFlag);
Yap_InitCPred("wam_profile_show_op_counters", 1, p_show_op_counters, 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 */

2
C/arrays.c
View File

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

9
C/cdmgr.c
View File

@ -11,8 +11,11 @@
* File: cdmgr.c *
* 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 $
* 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
* long int support for tabling
*
@ -877,7 +880,7 @@ kill_static_child_indxs(StaticIndex *indx)
kill_static_child_indxs(cl);
cl = next;
}
Yap_FreeCodeSpace((CODEADDR)indx);
Yap_FreeCodeSpace((char *)indx);
}
static void
@ -919,7 +922,7 @@ kill_off_lu_block(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
}
}
#endif
Yap_FreeCodeSpace((CODEADDR)c);
Yap_FreeCodeSpace((char *)c);
}
static void

270
C/compiler.c
View File

@ -11,8 +11,12 @@
* File: compiler.c *
* 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 $
* 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
* debugger was making predicates meta instead of testing
* fix handling of dbrefs in facts and in subarguments.
@ -135,6 +139,7 @@ typedef struct compiler_struct_struct {
Int vadr;
Int *Uses;
Term *Contents;
int needs_env;
CIntermediates cint;
} compiler_struct;
@ -389,7 +394,7 @@ reset_vars(Ventry *vtable)
static Term
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;
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));
H = oldH;
if (cmp > 0) {
parent = p;
p = p->RightCE;
}
else if (cmp < 0) {
parent = p;
p = p->LeftCE;
}
else
if (cmp) {
p = p->NextCE;
} else {
break;
}
}
if (p != NULL) { /* already there */
return (p->VarOfCE);
}
/* first occurrence */
if (cglobs->onbranch)
return (t);
if (cglobs->onbranch || level > 1)
return t;
++(cglobs->n_common_exps);
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();
longjmp(cglobs->cint.CompilerBotch,4);
}
p->RightCE = NULL;
p->LeftCE = NULL;
if (parent == NULL)
cglobs->common_exps = p;
else if (cmp > 0)
parent->RightCE = p;
else /* if (cmp < 0) */
parent->LeftCE = p;
p->NextCE = cglobs->common_exps;
cglobs->common_exps = p;
if (IsApplTerm(t))
c_var(p->VarOfCE, save_appl_flag, arity, level, cglobs);
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) :
write_num_op), (CELL) t, Zero, &cglobs->cint);
} 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);
if (IsVarTerm(t)) {
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
if (optimizer_on && (!cglobs->onhead || argno != 1 || level > 1)) {
if (optimizer_on) {
t = optimize_ce(t, arity, level, cglobs);
if (IsVarTerm(t)) {
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
c_eq(Term t1, Term t2, compiler_struct *cglobs)
{
Term t;
--cglobs->tmpreg;
if (IsVarTerm(t2))
t = t2, t2 = t1, t1 = t;
if (IsVarTerm(t1)) {
if (IsVarTerm(t2)) { /* both are variables */
if (IsNewVar(t2))
t = t2, t2 = t1, t1 = t;
c_var(t2, cglobs->tmpreg, 2, 0, cglobs);
cglobs->onhead = 1;
c_var(t1, cglobs->tmpreg, 2, 0, cglobs);
cglobs->onhead = 0;
}
else if (IsNewVar(t1)) {
c_arg(cglobs->tmpreg, t2, 0, 0, cglobs);
cglobs->onhead = 1;
c_var(t1, cglobs->tmpreg, 2, 0, cglobs);
cglobs->onhead = 0;
}
else { /* t2 is non var */
c_var(t1, cglobs->tmpreg, 2, 0, cglobs);
cglobs->onhead = 1;
c_arg(cglobs->tmpreg, t2, 0, 0, cglobs);
cglobs->onhead = 0;
if (IsNonVarTerm(t1)) {
if (IsVarTerm(t2)) {
Term t = t1;
t1 = t2;
t2 = t;
} else {
/* compile unification */
if (IsAtomicTerm(t1)) {
/* just check if they unify */
if (!IsAtomicTerm(t2) || !Yap_unify(t1,t2)) {
/* they don't */
Yap_emit(fail_op, Zero, Zero, &cglobs->cint);
return;
}
/* they do */
Yap_emit(nop_op, Zero, Zero, &cglobs->cint);
return;
} else if (IsPairTerm(t1)) {
/* just check if they unify */
if (!IsPairTerm(t2)) {
/* they don't */
Yap_emit(fail_op, Zero, Zero, &cglobs->cint);
return;
}
/* they might */
c_eq(HeadOfTerm(t1), HeadOfTerm(t2), cglobs);
c_eq(TailOfTerm(t1), TailOfTerm(t2), cglobs);
} else if (IsRefTerm(t1)) {
/* 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
@ -1139,6 +1164,7 @@ c_functor(Term Goal, int mod, compiler_struct *cglobs)
Term t1 = ArgOfTerm(1, Goal);
Term t2 = ArgOfTerm(2, Goal);
Term t3 = ArgOfTerm(3, Goal);
if (IsVarTerm(t1) && IsNewVar(t1)) {
c_bifun(_functor, t2, t3, t1, mod, cglobs);
} else if (IsNonVarTerm(t1)) {
@ -1164,6 +1190,7 @@ c_functor(Term Goal, int mod, compiler_struct *cglobs)
} else {
Functor f = FunctorOfTerm(Goal);
Prop p0 = PredPropByFunc(f, mod);
if (profiling)
Yap_emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero, &cglobs->cint);
else if (call_counting)
@ -1288,6 +1315,8 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
CELL l1 = ++cglobs->labelno;
CELL l2 = ++cglobs->labelno;
/* I need an either_me */
cglobs->needs_env = TRUE;
if (profiling)
Yap_emit(enter_profiling_op, (CELL)RepPredProp(PredPropByAtom(AtomRepeat,0)), Zero, &cglobs->cint);
else if (call_counting)
@ -1337,9 +1366,9 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
f = FunctorOfTerm(Goal);
p = RepPredProp(p0 = Yap_PredPropByFunctorNonThreadLocal(f, mod));
if (f == FunctorOr) {
Term arg;
CELL l = ++cglobs->labelno;
CELL m = ++cglobs->labelno;
Term arg;
int save = cglobs->onlast;
int savegoalno = cglobs->goalno;
int frst = TRUE;
@ -1374,6 +1403,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
}
else {
optimizing_commit = FALSE;
cglobs->needs_env = TRUE;
Yap_emit_3ops(either_op, l, Zero, Zero, &cglobs->cint);
Yap_emit(restore_tmps_op, Zero, Zero, &cglobs->cint);
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(pushpop_or_op, Zero, Zero, &cglobs->cint);
Yap_emit_3ops(orelse_op, l = ++cglobs->labelno, Zero, Zero, &cglobs->cint);
cglobs->needs_env = TRUE;
}
/*
* if(IsApplTerm(arg) &&
@ -1429,12 +1460,16 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
cglobs->onlast = save;
c_goal(ArgOfTerm(2, arg), mod, cglobs);
}
else
else {
/* standard disjunction */
c_goal(ArgOfTerm(1, Goal), mod, cglobs);
}
if (!cglobs->onlast) {
Yap_emit(jump_op, m, Zero, &cglobs->cint);
}
cglobs->goalno = savegoalno + 1;
if (!optimizing_commit || !cglobs->onlast) {
cglobs->goalno = savegoalno + 1;
}
Goal = ArgOfTerm(2, Goal);
++cglobs->curbranch;
cglobs->onbranch = cglobs->curbranch;
@ -1442,9 +1477,9 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
&& FunctorOfTerm(Goal) == FunctorOr);
Yap_emit(pushpop_or_op, Zero, 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);
else {
} else {
optimizing_commit = FALSE; /* not really necessary */
}
c_goal(Goal, mod, cglobs);
@ -1474,6 +1509,8 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
int save = cglobs->onlast;
Term commitvar;
/* for now */
cglobs->needs_env = TRUE;
commitvar = MkVarTerm();
if (H == (CELL *)cglobs->cint.freep0) {
/* 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);
#endif /* YAPOR */
if (p->FunctorOfPred == FunctorExecuteInMod) {
cglobs->needs_env = TRUE;
Yap_emit_4ops(call_op, (CELL) p0, Zero, Zero, ArgOfTerm(2,Goal), &cglobs->cint);
} else {
cglobs->needs_env = TRUE;
Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &cglobs->cint);
}
/* functor is allowed to call the garbage collector */
@ -1739,6 +1778,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
if (is_tabled(cglobs->cint.CurrentPred)) {
cglobs->needs_env = TRUE;
Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &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
}
else {
cglobs->needs_env = TRUE;
Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &cglobs->cint);
}
}
@ -1807,7 +1848,7 @@ inline static int
usesvar(compiler_vm_op ic)
{
if (ic >= get_var_op && ic <= put_val_op)
return (TRUE);
return TRUE;
switch (ic) {
case save_b_op:
case commit_b_op:
@ -1873,7 +1914,7 @@ AssignPerm(PInstr *pc, compiler_struct *cglobs)
x->Var = v;
EnvTmps = x;
}
}
} else
#endif
if (pc->op == call_op || pc->op == either_op || pc->op == orelse_op || pc->op == push_or_op) {
#ifdef LOCALISE_VOIDS
@ -1895,7 +1936,6 @@ AssignPerm(PInstr *pc, compiler_struct *cglobs)
uses_var = usesvar(pc->op);
if (uses_var) {
Ventry *v = (Ventry *) (pc->rnd1);
if (v->NoOfVE == Unassigned) {
if ((v->AgeOfVE > 1 && (v->AgeOfVE > v->FirstOfVE))
|| v->KindOfVE == PermVar /*
@ -1905,9 +1945,9 @@ AssignPerm(PInstr *pc, compiler_struct *cglobs)
v->NoOfVE = PermVar | (nperm++);
v->KindOfVE = PermVar;
v->FlagsOfVE |= PermFlag;
}
else
} else {
v->NoOfVE = v->KindOfVE = TempVar;
}
}
} else if (pc->op == empty_call_op) {
pc->rnd2 = nperm;
@ -2277,7 +2317,7 @@ checktemp(Int arg, Int rn, compiler_vm_op ic, compiler_struct *cglobs)
target2 = cglobs->MaxCTemps;
n = v->RCountOfVE - 1;
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) {
--n;
if (ic == put_val_op) {
@ -2410,6 +2450,7 @@ c_layout(compiler_struct *cglobs)
/* tell put_values used in bip optimisation */
int rn_kills = 0;
Int rn_to_kill[2];
int needs_either = 0;
rn_to_kill[0] = rn_to_kill[1] = 0;
cglobs->cint.cpc = cglobs->BodyStart;
@ -2426,23 +2467,23 @@ c_layout(compiler_struct *cglobs)
}
cglobs->cint.cpc->nextInst = savepc;
nperm = 0;
AssignPerm(cglobs->cint.CodeStart, cglobs);
/* vsc: need to do it from the beginning to find which perm vars are active */
/* CheckUnsafe(cglobs->BodyStart, cglobs); */
if (cglobs->needs_env) {
nperm = 0;
AssignPerm(cglobs->cint.CodeStart, cglobs);
#ifdef DEBUG
cglobs->pbvars = 0;
cglobs->pbvars = 0;
#endif
CheckUnsafe(cglobs->cint.CodeStart, cglobs);
CheckUnsafe(cglobs->cint.CodeStart, cglobs);
#ifdef DEBUG
if (cglobs->pbvars != nperm) {
Yap_Error_TYPE = INTERNAL_COMPILER_ERROR;
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "wrong number of variables found in bitmap";
save_machine_regs();
longjmp(cglobs->cint.CompilerBotch, 2);
}
if (cglobs->pbvars != nperm) {
Yap_Error_TYPE = INTERNAL_COMPILER_ERROR;
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "wrong number of variables found in bitmap";
save_machine_regs();
longjmp(cglobs->cint.CompilerBotch, 2);
}
#endif
}
}
cglobs->MaxCTemps = cglobs->nvars + cglobs->max_args - cglobs->tmpreg + cglobs->n_common_exps + 2;
if (cglobs->MaxCTemps >= MaxTemps)
@ -2463,6 +2504,12 @@ c_layout(compiler_struct *cglobs)
Int arg = cglobs->cint.cpc->rnd1;
Int rn = cglobs->cint.cpc->rnd2;
switch (ic) {
case pop_or_op:
if (needs_either)
needs_either--;
case either_op:
needs_either++;
break;
#ifdef TABLING_INNER_CUTS
case cut_op:
case cutexit_op:
@ -2471,17 +2518,21 @@ c_layout(compiler_struct *cglobs)
#endif /* TABLING_INNER_CUTS */
case allocate_op:
case deallocate_op:
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
if (is_tabled(cglobs->cint.CurrentPred))
if (!cglobs->needs_env) {
cglobs->cint.cpc->op = nop_op;
else
#endif /* TABLING */
if (cglobs->goalno == 1 && !cglobs->or_found && nperm == 0)
} else {
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
if (is_tabled(cglobs->cint.CurrentPred))
cglobs->cint.cpc->op = nop_op;
else
#endif /* TABLING */
if (cglobs->goalno == 1 && !cglobs->or_found && nperm == 0)
cglobs->cint.cpc->op = nop_op;
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
#endif
}
break;
case pop_op:
ic = (cglobs->cint.cpc->nextInst)->op;
@ -2608,19 +2659,36 @@ c_layout(compiler_struct *cglobs)
break;
case safe_call_op:
Arity = RepPredProp((Prop) arg)->ArityOfPE;
for (rn = 1; rn <= Arity; ++rn)
/*
vsc: The variables will be in use after this!!!!
for (rn = 1; rn <= Arity; ++rn)
--cglobs->Uses[rn];
*/
break;
case call_op:
case orelse_op:
case orlast_op:
{
up = cglobs->Uses;
cop = cglobs->Contents;
for (rn = 1; rn < cglobs->MaxCTemps; ++rn) {
*up++ = *cop++ = NIL;
}
}
break;
case label_op:
/*
* for(rn=1; rn<cglobs->MaxCTemps; ++rn) cglobs->Uses[rn] =
* cglobs->Contents[rn] = NIL;
*/
up = cglobs->Uses;
cop = cglobs->Contents;
for (rn = 1; rn < cglobs->MaxCTemps; ++rn)
*up++ = *cop++ = NIL;
{
up = cglobs->Uses;
cop = cglobs->Contents;
for (rn = 0; rn <= cglobs->MaxCTemps; ++rn) {
if (*cop != (TempVar | rn)) {
*up++ = *cop++ = NIL;
} else {
up++;
cop++;
}
}
}
break;
case cut_op:
case cutexit_op:
@ -2690,6 +2758,21 @@ c_optimize(PInstr *pc)
PInstr *npc = pc->nextInst;
pc->nextInst = opc;
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:
{
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();
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.curbranch = cglobs.onbranch = 0;
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.nvars = 0;
cglobs.tmpreg = 0;
cglobs.needs_env = FALSE;
/*
* 2000 added to H in case we need to construct call(G) when G is a
* variable used as a goal

15
C/computils.c
View File

@ -11,8 +11,13 @@
* File: computils.c *
* 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 $
* 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
* a few fixes for 64 bit compiling.
*
@ -101,7 +106,7 @@ Yap_is_a_test_pred (Term arg, Term mod)
return FALSE;
if (pe->PredFlags & AsmPredFlag) {
int op = pe->PredFlags & 0x7f;
if (op >= _atom && op <= _primitive) {
if (op >= _atom && op <= _eq) {
return TRUE;
}
return FALSE;
@ -368,7 +373,7 @@ ShowOp (char *f, struct PSEUDO *cpc)
Yap_DebugPutc (Yap_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X');
Yap_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), Yap_DebugPutc, 0);
}
break;
break;
case 'N':
{
Ventry *v;
@ -379,7 +384,6 @@ ShowOp (char *f, struct PSEUDO *cpc)
Yap_DebugPutc (Yap_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X');
Yap_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), Yap_DebugPutc, 0);
}
break;
case 'm':
Yap_plwrite (MkAtomTerm ((Atom) arg), Yap_DebugPutc, 0);
Yap_DebugPutc (Yap_c_error_stream,'/');
@ -527,7 +531,8 @@ static char *opformat[] =
"nop",
"get_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",
"get_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;
Term ti[1];
i = strlen(tmpbuf);
ti[0] = where;
nt[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("consistency_error"),1), 1, ti);
tp = tmpbuf+i;

2
C/grow.c
View File

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

23
C/heapgc.c
View File

@ -831,7 +831,7 @@ static void
init_dbtable(tr_fr_ptr trail_ptr) {
DeadClause *cl = DeadClauses;
db_vec0 = db_vec = (CODEADDR)TR;
db_vec0 = db_vec = (ADDR)TR;
db_root = RBTreeCreate();
while (trail_ptr > (tr_fr_ptr)Yap_TrailBase) {
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
/* #define INSTRUMENT_GC 1 */
@ -1481,7 +1470,7 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
if (size < 0) {
PredEntry *pe = EnvPreg(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)
fprintf(Yap_stderr," %s/%d\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE);
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);
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) {
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 {
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
*/
static void
static inline void
into_relocation_chain(CELL_PTR current, CELL_PTR next)
{
#ifdef TAGS_FAST_OPS

5
C/init.c
View File

@ -192,10 +192,6 @@ void **Yap_ABSMI_OPCODES;
int Yap_sockets_io=0;
#endif
#if ANALYST
int Yap_opcount[_std_top + 1];
#endif
#if DEBUG
#if COROUTINING
int Yap_Portray_delays = FALSE;
@ -903,6 +899,7 @@ InitCodes(void)
Yap_heap_regs->consultbase = Yap_heap_regs->consultsp =
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_optimizer_on = TRUE;
Yap_heap_regs->maxdepth = 0;
Yap_heap_regs->maxlist = 0;

4
C/iopreds.c
View File

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

22
C/stdpreds.c
View File

@ -11,8 +11,11 @@
* File: stdpreds.c *
* 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 $
* Revision 1.89 2005/05/26 18:01:11 rslopes
* *** empty log message ***
*
* Revision 1.88 2005/04/27 20:09:25 vsc
* indexing code could get confused with suspension points
* 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 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
@ -409,13 +401,13 @@ showprofres(UInt type) {
}
if (oldpc>(void *) rational_tree_loop && oldpc<(void *) Yap_InitAbsmi) { InUnify++; continue; }
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 */
pc_ptr=y;
/*
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++);
printf("Outro syscall diferente %s\n", op_names[i]);
printf("Outro syscall diferente %s\n", Yap_op_names[i]);
*/
continue;
}
@ -1521,7 +1513,7 @@ p_atom_length(void)
}
return((Int)strlen(RepAtom(AtomOfTerm(t1))->StrOfAE) == len);
} else {
Term tj = MkIntTerm(strlen(RepAtom(AtomOfTerm(t1))->StrOfAE));
Term tj = MkIntegerTerm(strlen(RepAtom(AtomOfTerm(t1))->StrOfAE));
return Yap_unify_constant(t2,tj);
}
}

6
C/sysbits.c
View File

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

4
H/Yap.h
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* 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"
@ -649,7 +649,7 @@ typedef enum
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
#endif

28
H/YapOpcodes.h
View File

@ -11,8 +11,11 @@
* File: YapOpcodes.h *
* 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 $
* 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
* float support for tabling
*
@ -129,11 +132,11 @@
OPCODE(get_x_val ,xx),
OPCODE(get_y_val ,yx),
OPCODE(get_atom ,xc),
OPCODE(get_2atoms ,cc),
OPCODE(get_3atoms ,ccc),
OPCODE(get_4atoms ,cccc),
OPCODE(get_5atoms ,ccccc),
OPCODE(get_6atoms ,cccccc),
OPCODE(get_2atoms ,cc), /* peephole */
OPCODE(get_3atoms ,ccc), /* peephole */
OPCODE(get_4atoms ,cccc), /* peephole */
OPCODE(get_5atoms ,ccccc), /* peephole */
OPCODE(get_6atoms ,cccccc), /* peephole */
OPCODE(get_float ,xc),
OPCODE(get_longint ,xc),
OPCODE(get_bigint ,xc),
@ -154,6 +157,7 @@
OPCODE(put_x_val ,xx),
OPCODE(put_y_val ,yx),
OPCODE(put_unsafe ,yx),
OPCODE(put_xx_val ,xxxx), /* peephole */
OPCODE(put_atom ,xc),
OPCODE(put_list ,x),
OPCODE(put_struct ,xf),
@ -231,14 +235,14 @@
OPCODE(write_n_atoms ,sc),
OPCODE(unify_n_voids ,os),
OPCODE(write_n_voids ,s),
OPCODE(glist_valx ,ss),
OPCODE(glist_valy ,xy),
OPCODE(glist_valx ,ss), /* peephole */
OPCODE(glist_valy ,xy), /* peephole */
OPCODE(fcall ,sla),
OPCODE(dexecute ,l),
OPCODE(gl_void_varx ,xx),
OPCODE(gl_void_vary ,xy),
OPCODE(gl_void_valx ,xx),
OPCODE(gl_void_valy ,xy),
OPCODE(gl_void_varx ,xx), /* peephole */
OPCODE(gl_void_vary ,xy), /* peephole */
OPCODE(gl_void_valx ,xx), /* peephole */
OPCODE(gl_void_valy ,xy), /* peephole */
OPCODE(unify_x_loc ,ox),
OPCODE(unify_y_loc ,oy),
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>
#endif
#ifdef ANALYST
static char *op_names[_std_top + 1] =
{
#define OPCODE(OP,TYPE) #OP
#include "YapOpcodes.h"
#undef OPCODE
};
#endif
#if PUSH_REGS

24
H/amidefs.h
View File

@ -11,8 +11,11 @@
* File: amidefs.h *
* 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 $
* 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
* bug fixes, I hope!
*
@ -85,9 +88,13 @@ typedef enum {
#undef OPCODE
} op_numbers;
#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 {
_atom,
_atomic,
@ -100,9 +107,9 @@ typedef enum {
_cut_by,
_db_ref,
_primitive,
_equal,
_dif,
_eq,
_equal,
_plus,
_minus,
_times,
@ -497,6 +504,13 @@ typedef struct yami {
wamreg x2;
CELL next;
} xxx;
struct {
wamreg xl1;
wamreg xl2;
wamreg xr1;
wamreg xr2;
CELL next;
} xxxx;
struct {
wamreg x;
Int c;
@ -720,7 +734,9 @@ extern void **Yap_ABSMI_OPCODES;
/* used to find out how many instructions of each kind are executed */
#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 */
#if DEPTH_LIMIT

9
H/clause.h
View File

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

19
H/compile.h
View File

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

14
H/rclause.h
View File

@ -12,8 +12,11 @@
* File: rclause.h *
* 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 $
* 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
* float support for tabling
*
@ -86,7 +89,7 @@ restore_opcodes(yamop *pc)
op_numbers op = Yap_op_from_opcode(pc->opc);
pc->opc = Yap_opcode(op);
#ifdef DEBUG_RESTORE2
fprintf(stderr, "%s ", op_names[op]);
fprintf(stderr, "%s ", Yap_op_names[op]);
#endif
switch (op) {
case _Nstop:
@ -368,6 +371,13 @@ restore_opcodes(yamop *pc)
pc->u.xx.xl = XAdjust(pc->u.xx.xl);
pc = NEXTOP(pc,xx);
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 */
case _get_y_var:
case _get_y_val:

16
H/rheap.h
View File

@ -11,8 +11,12 @@
* File: rheap.h *
* 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 $
* 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
* add some atom gc fixes
*
@ -71,16 +75,6 @@ static char SccsId[] = "@(#)rheap.c 1.3 3/15/90";
#define Atomics 0
#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 */
static void

3
H/sshift.h
View File

@ -228,7 +228,8 @@ inline EXTERN Functor
FuncAdjust (Functor 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
EXTERN inline UInt STD_PROTO(HashFunction, (char *));
EXTERN inline UInt STD_PROTO(HashFunction, (unsigned char *));
EXTERN inline UInt
HashFunction(char *CHP)
HashFunction(unsigned char *CHP)
{
/* djb2 */
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
% and Set2, provided that Set1 and Set2 are ordered sets.
ord_intersection(_, [], []) :- !.
ord_intersection([], _, []) :- !.
ord_intersection([_|_], [], []) :- !.
ord_intersection([Head1|Tail1], [Head2|Tail2], Intersection) :-
compare(Order, Head1, Head2),
ord_intersection(Order, Head1, Tail1, Head2, Tail2, Intersection).
ord_intersection(=, Head, Tail1, _, Tail2, [Head|Intersection]) :-
ord_intersection(Tail1, 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).
( Head1 == Head2 ->
Intersection = [Head1|Tail],
ord_intersection(Tail1, Tail2, Tail)
;
Head1 @< Head2 ->
ord_intersection(Tail1, [Head2|Tail2], Intersection)
;
ord_intersection([Head1|Tail1], Tail2, Intersection)
).
% ord_intersection(+Set1, +Set2, ?Intersection, ?Difference)
% is true when Intersection is the ordered representation of Set1
% and Set2, provided that Set1 and Set2 are ordered sets.
ord_intersection(_, [], [], []) :- !.
ord_intersection([], L, [], L) :- !.
ord_intersection([_|_], [], [], []) :- !.
ord_intersection([Head1|Tail1], [Head2|Tail2], Intersection, Difference) :-
compare(Order, Head1, Head2),
ord_intersection(Order, Head1, Tail1, Head2, Tail2, Intersection, Difference).
ord_intersection(=, Head, Tail1, _, Tail2, [Head|Intersection], Difference) :-
ord_intersection(Tail1, 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]) :-
ord_intersection([Head1|Tail1], Tail2, Intersection, Difference).
( Head1 == Head2 ->
Intersection = [Head1|Tail],
ord_intersection(Tail1, Tail2, Tail, Difference)
;
Head1 @< Head2 ->
ord_intersection(Tail1, [Head2|Tail2], Intersection, Difference)
;
Difference = [Head2|HDifference],
ord_intersection([Head1|Tail1], Tail2, Intersection, HDifference)
).
% ord_seteq(+Set1, +Set2)

2
m4/Yatom.h.m4
View File

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

8
pl/boot.yap
View File

@ -16,6 +16,12 @@
*************************************************************************/
% 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
% cuts are compiled right with co-routining.
@ -31,7 +37,7 @@ true :- true.
repeat,
'$set_input'(user),'$set_output'(user),
'$current_module'(Module),
( Module=user ->
( Module==user ->
'$compile_mode'(_,0)
;
format(user_error,'[~w]~n', [Module])

4
pl/debug.yap
View File

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