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

massive changes to support new scheme for arithmetic:

Browse Source 
- compilation and assembly support
This commit is contained in:
Vítor Santos Costa 2008-12-09 12:54:27 +00:00
parent 2e8d898e86
commit a36be5bf20
15 changed files with 2121 additions and 416 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1052
C/absmi.c
View File

File diff suppressed because it is too large Load Diff

389
C/amasm.c
View File

@ -564,6 +564,185 @@ a_v(op_numbers opcodex, op_numbers opcodey, yamop *code_p, int pass_no, struct P
return code_p;
}
inline static yamop *
a_fi(op_numbers opcodex, op_numbers opcodey, yamop *code_p, int pass_no, struct PSEUDO *cpc, UInt lab, struct intermediates *cip)
{
Ventry *ve = (Ventry *) cpc->rnd1;
OPREG var_offset;
int is_y_var = (ve->KindOfVE == PermVar);
var_offset = Var_Ref(ve, is_y_var);
if (is_y_var) {
if (pass_no) {
code_p->opc = emit_op(opcodey);
code_p->u.syl.y = emit_yreg(var_offset);
code_p->u.syl.l = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab]);
code_p->u.syl.s = cpc->rnd2;
}
GONEXT(syl);
}
else {
if (pass_no) {
code_p->opc = emit_op(opcodex);
code_p->u.sxl.x = emit_xreg(var_offset);
code_p->u.sxl.l = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab]);
code_p->u.sxl.s = cpc->rnd2;
}
GONEXT(sxl);
}
return code_p;
}
inline static yamop *
a_fil(op_numbers opcodex, op_numbers opcodey, yamop *code_p, int pass_no, struct PSEUDO *cpc, UInt lab1, UInt lab2, struct intermediates *cip)
{
Ventry *ve = (Ventry *) cpc->rnd1;
OPREG var_offset;
int is_y_var = (ve->KindOfVE == PermVar);
var_offset = Var_Ref(ve, is_y_var);
if (is_y_var) {
if (pass_no) {
code_p->opc = emit_op(opcodey);
code_p->u.syll.s = cpc->rnd2;
code_p->u.syll.y = emit_yreg(var_offset);
if (lab1)
code_p->u.syll.T = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab1]);
else
code_p->u.syll.T = emit_a(Unsigned(NEXTOP(code_p,syll)));
if (lab2)
code_p->u.syll.F = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab2]);
else
code_p->u.syll.F = FAILCODE;
}
GONEXT(syll);
}
else {
if (pass_no) {
code_p->opc = emit_op(opcodex);
code_p->u.sxll.s = cpc->rnd2;
code_p->u.sxll.x = emit_xreg(var_offset);
if (lab1)
code_p->u.sxll.T = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab1]);
else
code_p->u.sxll.T = emit_a(Unsigned(NEXTOP(code_p,sxll)));
if (lab2)
code_p->u.sxll.F = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab2]);
else
code_p->u.sxll.F = FAILCODE;
}
GONEXT(sxll);
}
return code_p;
}
static yamop *
a_sdll(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc, UInt lab1, UInt lab2, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.sdll.s = cpc->rnd2;
code_p->u.sdll.d[0] = (CELL)FunctorDouble;
code_p->u.sdll.d[1] = RepAppl(cpc->rnd1)[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
code_p->u.sdll.d[2] = RepAppl(cpc->rnd1)[2];
#endif
if (lab1)
code_p->u.sdll.T = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab1]);
else
code_p->u.sdll.T = emit_a(Unsigned(NEXTOP(code_p,sdll)));
if (lab2)
code_p->u.sdll.F = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab2]);
else
code_p->u.sdll.F = FAILCODE;
}
GONEXT(sdll);
return code_p;
}
static yamop *
a_snll(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc, UInt lab1, UInt lab2, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.snll.s = cpc->rnd2;
code_p->u.snll.I = IntegerOfTerm(cpc->rnd1);
if (lab1)
code_p->u.snll.T = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab1]);
else
code_p->u.snll.T = emit_a(Unsigned(NEXTOP(code_p,snll)));
if (lab2)
code_p->u.snll.F = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab2]);
else
code_p->u.snll.F = FAILCODE;
}
GONEXT(snll);
return code_p;
}
static yamop *
a_ssll(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc, UInt lab1, UInt lab2, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.ssll.s1 = cpc->rnd1;
code_p->u.ssll.s2 = cpc->rnd2;
if (lab1)
code_p->u.ssll.T = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab1]);
else
code_p->u.ssll.T = emit_a(Unsigned(NEXTOP(code_p,ssll)));
if (lab2)
code_p->u.ssll.F = emit_a(Unsigned(cip->code_addr) + cip->label_offset[lab2]);
else
code_p->u.ssll.F = FAILCODE;
}
GONEXT(ssll);
return code_p;
}
static yamop *
a_ssd(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.ssd.s0 = cpc->rnd1;
code_p->u.ssd.s1 = cpc->rnd2;
code_p->u.ssd.d[0] = (CELL)FunctorDouble;
code_p->u.ssd.d[1] = RepAppl(cpc->rnd1)[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
code_p->u.ssd.d[2] = RepAppl(cpc->rnd1)[2];
#endif
}
GONEXT(ssd);
return code_p;
}
static yamop *
a_ssn(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.ssn.s0 = cpc->rnd1;
code_p->u.ssn.s1 = cpc->rnd2;
code_p->u.ssn.n = IntegerOfTerm(cpc->rnd1);
}
GONEXT(ssn);
return code_p;
}
static yamop *
a_sss(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.sss.s0 = cpc->rnd1;
code_p->u.sss.s1 = cpc->rnd2;
code_p->u.sss.s2 = cpc->rnd3;
}
GONEXT(sss);
return code_p;
}
inline static yamop *
a_vp(op_numbers opcodex, op_numbers opcodey, yamop *code_p, int pass_no, struct PSEUDO *cpc, clause_info *clinfo)
{
@ -927,7 +1106,7 @@ a_ud(op_numbers opcode, op_numbers opcode_w, yamop *code_p, int pass_no, struct
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.oc.opcw = emit_op(opcode_w);
code_p->u.od.opcw = emit_op(opcode_w);
code_p->u.od.d[0] = (CELL)FunctorDouble;
code_p->u.od.d[1] = RepAppl(cpc->rnd1)[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
@ -943,7 +1122,7 @@ a_ui(op_numbers opcode, op_numbers opcode_w, yamop *code_p, int pass_no, struct
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.oc.opcw = emit_op(opcode_w);
code_p->u.oi.opcw = emit_op(opcode_w);
code_p->u.oi.i[0] = (CELL)FunctorLongInt;
code_p->u.oi.i[1] = RepAppl(cpc->rnd1)[1];
}
@ -1274,14 +1453,14 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
longjmp(cip->CompilerBotch, 1);
} else
code_p->opc = emit_op(_call_c_wfail);
code_p->u.sdlp.s =
code_p->u.slp.s =
emit_count(-Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2);
code_p->u.sdlp.l =
code_p->u.slp.l =
emit_a(Unsigned(cip->code_addr) + cip->label_offset[clinfo->commit_lab]);
code_p->u.sdlp.p =
code_p->u.slp.p =
emit_pe(RepPredProp(fe));
}
GONEXT(sdlp);
GONEXT(slp);
clinfo->commit_lab = 0;
} else {
if (pass_no) {
@ -1462,7 +1641,6 @@ a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct inter
if (clinfo->commit_lab) {
code_p->u.plyys.f =
emit_a(Unsigned(cip->code_addr) + cip->label_offset[clinfo->commit_lab]);
clinfo->commit_lab = 0;
} else {
code_p->u.plyys.f = FAILCODE;
}
@ -1470,6 +1648,7 @@ a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct inter
code_p->u.plyys.y2 = emit_yreg(var_offset);
code_p->u.plyys.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
}
clinfo->commit_lab = 0;
GONEXT(plyys);
} else {
if (pass_no) {
@ -1478,7 +1657,6 @@ a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct inter
if (clinfo->commit_lab) {
code_p->u.plxys.f =
emit_a(Unsigned(cip->code_addr) + cip->label_offset[clinfo->commit_lab]);
clinfo->commit_lab = 0;
} else {
code_p->u.plxys.f = FAILCODE;
}
@ -1486,6 +1664,7 @@ a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct inter
code_p->u.plxys.y = v1;
code_p->u.plxys.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
}
clinfo->commit_lab = 0;
GONEXT(plxys);
}
} else {
@ -1503,7 +1682,6 @@ a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct inter
if (clinfo->commit_lab) {
code_p->u.plxys.f =
emit_a(Unsigned(cip->code_addr) + cip->label_offset[clinfo->commit_lab]);
clinfo->commit_lab = 0;
} else {
code_p->u.plxys.f = FAILCODE;
}
@ -1511,6 +1689,7 @@ a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct inter
code_p->u.plxys.y = emit_yreg(var_offset);
code_p->u.plxys.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
}
clinfo->commit_lab = 0;
GONEXT(plxys);
} else {
if (pass_no) {
@ -1519,7 +1698,6 @@ a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct inter
if (clinfo->commit_lab) {
code_p->u.plxxs.f =
emit_a(Unsigned(cip->code_addr) + cip->label_offset[clinfo->commit_lab]);
clinfo->commit_lab = 0;
} else {
code_p->u.plxxs.f = FAILCODE;
}
@ -1527,6 +1705,7 @@ a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct inter
code_p->u.plxxs.x2 = emit_xreg(var_offset);
code_p->u.plxxs.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
}
clinfo->commit_lab = 0;
GONEXT(plxxs);
}
}
@ -2345,11 +2524,11 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
if (cmp_info->cl_info->commit_lab) {
code_p->u.yl.F =
emit_a(Unsigned(cip->code_addr) + cip->label_offset[cmp_info->cl_info->commit_lab]);
cmp_info->cl_info->commit_lab = 0;
} else {
code_p->u.yl.F = FAILCODE;
}
}
cmp_info->cl_info->commit_lab = 0;
GONEXT(yl);
return code_p;
} else {
@ -2393,11 +2572,11 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
if (cmp_info->cl_info->commit_lab) {
code_p->u.xl.F =
emit_a(Unsigned(cip->code_addr) + cip->label_offset[cmp_info->cl_info->commit_lab]);
cmp_info->cl_info->commit_lab = 0;
} else {
code_p->u.xl.F = FAILCODE;
}
}
cmp_info->cl_info->commit_lab = 0;
GONEXT(xl);
return code_p;
}
@ -2743,6 +2922,27 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
return code_p;
}
static yamop *
a_special_label(yamop *code_p, int pass_no, struct intermediates *cip)
{
special_label_id lab_id = cip->cpc->rnd1;
UInt lab_val = cip->cpc->rnd2;
switch (lab_id) {
case SPECIAL_LABEL_EXCEPTION:
cip->exception_handler = lab_val;
break;
case SPECIAL_LABEL_SUCCESS:
cip->success_handler = lab_val;
break;
case SPECIAL_LABEL_FAILURE:
cip->failure_handler = lab_val;
break;
}
return code_p;
}
#ifdef YAPOR
#define TRYCODE(G,P) a_try((G), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], IPredArity, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no, cip)
#define TABLE_TRYCODE(G) a_try((G), (CELL)emit_ilabel(cip->cpc->rnd1, cip), IPredArity, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no, cip)
@ -2778,6 +2978,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
clinfo.commit_lab = 0L;
clinfo.CurrentPred = cip->CurrentPred;
cip->current_try_lab = NULL;
cip->exception_handler = 0;
cip->success_handler = 0;
cip->failure_handler = 0;
cip->try_instructions = NULL;
cmp_info.c_type = TYPE_XX;
cmp_info.cl_info = &clinfo;
@ -2981,6 +3184,168 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
*clause_has_blobsp = TRUE;
code_p = a_rd(_get_float, code_p, pass_no, cip->cpc);
break;
case get_fi_op:
code_p = a_fi(_get_fi_x, _get_fi_y, code_p, pass_no, cip->cpc, cip->exception_handler, cip);
break;
case get_f_op:
code_p = a_fi(_get_f_x, _get_f_y, code_p, pass_no, cip->cpc, cip->exception_handler, cip);
break;
case get_i_op:
code_p = a_fi(_get_i_x, _get_i_y, code_p, pass_no, cip->cpc, cip->exception_handler, cip);
break;
case put_fi_var_op:
code_p = a_fi(_put_fi_var_x, _put_fi_var_y, code_p, pass_no, cip->cpc, cip->success_handler, cip);
break;
case put_f_var_op:
code_p = a_fi(_put_f_var_x, _put_f_var_y, code_p, pass_no, cip->cpc, cip->success_handler, cip);
break;
case put_i_var_op:
code_p = a_fi(_put_i_var_x, _put_i_var_y, code_p, pass_no, cip->cpc, cip->success_handler, cip);
break;
case put_fi_val_op:
code_p = a_fil(_put_fi_val_x, _put_fi_val_y, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case put_f_val_op:
code_p = a_fil(_put_f_val_x, _put_f_val_y, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case put_i_val_op:
code_p = a_fil(_put_i_val_x, _put_i_val_y, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case a_eqc_float_op:
*clause_has_blobsp = TRUE;
code_p = a_sdll(_a_eqc_float, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case a_eqc_int_op:
code_p = a_snll(_a_eqc_int, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case a_eq_op:
code_p = a_ssll(_a_eq, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case ltc_float_op:
*clause_has_blobsp = TRUE;
code_p = a_sdll(_ltc_float, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case ltc_int_op:
code_p = a_snll(_ltc_int, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case lt_op:
code_p = a_ssll(_lt, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case gtc_float_op:
*clause_has_blobsp = TRUE;
code_p = a_sdll(_gtc_float, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case gtc_int_op:
code_p = a_snll(_gtc_int, code_p, pass_no, cip->cpc, cip->success_handler, cip->failure_handler, cip);
break;
case add_float_c_op:
*clause_has_blobsp = TRUE;
code_p = a_ssd(_add_float_c, code_p, pass_no, cip->cpc);
break;
case add_int_c_op:
code_p = a_ssn(_add_int_c, code_p, pass_no, cip->cpc);
break;
case add_op:
code_p = a_sss(_add, code_p, pass_no, cip->cpc);
break;
case sub_float_c_op:
*clause_has_blobsp = TRUE;
code_p = a_ssd(_sub_float_c, code_p, pass_no, cip->cpc);
break;
case sub_int_c_op:
code_p = a_ssn(_sub_int_c, code_p, pass_no, cip->cpc);
break;
case sub_op:
code_p = a_sss(_sub, code_p, pass_no, cip->cpc);
break;
case mul_float_c_op:
*clause_has_blobsp = TRUE;
code_p = a_ssd(_mul_float_c, code_p, pass_no, cip->cpc);
break;
case mul_int_c_op:
code_p = a_ssn(_mul_int_c, code_p, pass_no, cip->cpc);
break;
case mul_op:
code_p = a_sss(_mul, code_p, pass_no, cip->cpc);
break;
case sr_c1_op:
code_p = a_ssn(_sr_c1, code_p, pass_no, cip->cpc);
break;
case sr_c2_op:
code_p = a_ssn(_sr_c2, code_p, pass_no, cip->cpc);
break;
case sr_op:
code_p = a_sss(_sr, code_p, pass_no, cip->cpc);
break;
case sl_c1_op:
code_p = a_ssn(_sl_c1, code_p, pass_no, cip->cpc);
break;
case sl_c2_op:
code_p = a_ssn(_sl_c2, code_p, pass_no, cip->cpc);
break;
case sl_op:
code_p = a_sss(_sl, code_p, pass_no, cip->cpc);
break;
case rem_c1_op:
code_p = a_ssn(_rem_c1, code_p, pass_no, cip->cpc);
break;
case rem_c2_op:
code_p = a_ssn(_rem_c2, code_p, pass_no, cip->cpc);
break;
case rem_op:
code_p = a_sss(_rem, code_p, pass_no, cip->cpc);
break;
case mod_c1_op:
code_p = a_ssn(_mod_c1, code_p, pass_no, cip->cpc);
break;
case mod_c2_op:
code_p = a_ssn(_mod_c2, code_p, pass_no, cip->cpc);
break;
case mod_op:
code_p = a_sss(_mod, code_p, pass_no, cip->cpc);
break;
case idiv_c1_op:
code_p = a_ssn(_idiv_c1, code_p, pass_no, cip->cpc);
break;
case idiv_c2_op:
code_p = a_ssn(_idiv_c2, code_p, pass_no, cip->cpc);
break;
case idiv_op:
code_p = a_sss(_idiv, code_p, pass_no, cip->cpc);
break;
case fdiv_c1_op:
code_p = a_ssd(_fdiv_c1, code_p, pass_no, cip->cpc);
break;
case fdiv_c2_op:
code_p = a_ssd(_fdiv_c2, code_p, pass_no, cip->cpc);
break;
case fdiv_op:
code_p = a_sss(_fdiv, code_p, pass_no, cip->cpc);
break;
case a_and_c_op:
code_p = a_ssn(_a_and_c, code_p, pass_no, cip->cpc);
break;
case a_and_op:
code_p = a_sss(_a_and, code_p, pass_no, cip->cpc);
break;
case a_or_c_op:
code_p = a_ssn(_a_or_c, code_p, pass_no, cip->cpc);
break;
case a_or_op:
code_p = a_sss(_a_or, code_p, pass_no, cip->cpc);
break;
case xor_c_op:
code_p = a_ssn(_xor_c, code_p, pass_no, cip->cpc);
break;
case xor_op:
code_p = a_sss(_xor, code_p, pass_no, cip->cpc);
break;
case uminus_op:
code_p = a_sss(_uminus, code_p, pass_no, cip->cpc);
break;
case label_ctl_op:
code_p = a_special_label(code_p, pass_no, cip);
break;
case get_longint_op:
*clause_has_blobsp = TRUE;
code_p = a_ri(_get_longint, code_p, pass_no, cip->cpc);

6
C/cdmgr.c
View File

@ -4276,11 +4276,11 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
case _write_l_struc:
pc = NEXTOP(pc,fa);
break;
/* instructions type sdlp */
/* instructions type slp */
case _call_c_wfail:
clause_code = TRUE;
pp = pc->u.sdlp.p;
pc = NEXTOP(pc,sdlp);
pp = pc->u.slp.p;
pc = NEXTOP(pc,slp);
break;
/* instructions type OtapFs */
case _try_c:

275
C/compiler.c
View File

@ -312,11 +312,11 @@ adjust_current_commits(compiler_struct *cglobs) {
}
}
static void
c_var(Term t, Int argno, unsigned int arity, unsigned int level, compiler_struct *cglobs)
{
static int
check_var(Term t, unsigned int level, Int argno, compiler_struct *cglobs) {
int flags, new = FALSE;
Ventry *v = (Ventry *) Deref(t);
Ventry *v = (Ventry *)t;
if (IsNewVar(v)) { /* new var */
v = (Ventry *) Yap_AllocCMem(sizeof(*v), &cglobs->cint);
@ -387,36 +387,61 @@ c_var(Term t, Int argno, unsigned int arity, unsigned int level, compiler_struct
}
if (cglobs->onhead)
v->FlagsOfVE |= OnHeadFlag;
return new;
}
static void
tag_var(Term t, int new, compiler_struct *cglobs)
{
Ventry *v = (Ventry *) t;
if (new) {
v->FirstOpForV = cglobs->cint.cpc;
}
v->LastOpForV = cglobs->cint.cpc;
++(v->RCountOfVE);
if (cglobs->onlast)
v->FlagsOfVE |= OnLastGoal;
if (v->AgeOfVE < cglobs->goalno)
v->AgeOfVE = cglobs->goalno;
}
static void
c_var(Term t, Int argno, unsigned int arity, unsigned int level, compiler_struct *cglobs)
{
int new = check_var(Deref(t), level, argno, cglobs);
t = Deref(t);
switch (argno) {
case save_b_flag:
Yap_emit(save_b_op, (CELL) v, Zero, &cglobs->cint);
Yap_emit(save_b_op, t, Zero, &cglobs->cint);
break;
case commit_b_flag:
Yap_emit(commit_b_op, (CELL) v, Zero, &cglobs->cint);
Yap_emit(commit_b_op, t, Zero, &cglobs->cint);
Yap_emit(empty_call_op, Zero, Zero, &cglobs->cint);
Yap_emit(restore_tmps_and_skip_op, Zero, Zero, &cglobs->cint);
break;
case patch_b_flag:
Yap_emit(patch_b_op, (CELL) v, 0, &cglobs->cint);
Yap_emit(patch_b_op, t, 0, &cglobs->cint);
break;
case save_pair_flag:
Yap_emit(save_pair_op, (CELL) v, 0, &cglobs->cint);
Yap_emit(save_pair_op, t, 0, &cglobs->cint);
break;
case save_appl_flag:
Yap_emit(save_appl_op, (CELL) v, 0, &cglobs->cint);
Yap_emit(save_appl_op, t, 0, &cglobs->cint);
break;
case f_flag:
if (new) {
++cglobs->nvars;
Yap_emit(f_var_op, (CELL) v, (CELL)arity, &cglobs->cint);
Yap_emit(f_var_op, t, (CELL)arity, &cglobs->cint);
} else
Yap_emit(f_val_op, (CELL) v, (CELL)arity, &cglobs->cint);
Yap_emit(f_val_op, t, (CELL)arity, &cglobs->cint);
break;
case bt1_flag:
Yap_emit(fetch_args_for_bccall, (CELL)v, 0, &cglobs->cint);
Yap_emit(fetch_args_for_bccall, t, 0, &cglobs->cint);
break;
case bt2_flag:
Yap_emit(bccall_op, (CELL)v, (CELL)cglobs->current_p0, &cglobs->cint);
Yap_emit(bccall_op, t, (CELL)cglobs->current_p0, &cglobs->cint);
break;
default:
#ifdef SFUNC
@ -429,31 +454,23 @@ c_var(Term t, Int argno, unsigned int arity, unsigned int level, compiler_struct
#endif
if (cglobs->onhead) {
if (level == 0)
Yap_emit((new ? (++cglobs->nvars, get_var_op) : get_val_op), (CELL) v, argno, &cglobs->cint);
Yap_emit((new ? (++cglobs->nvars, get_var_op) : get_val_op), t, argno, &cglobs->cint);
else
Yap_emit((new ? (++cglobs->nvars, (argno == (Int)arity ?
unify_last_var_op :
unify_var_op)) :
(argno == (Int)arity ? unify_last_val_op :
unify_val_op)),
(CELL) v, Zero, &cglobs->cint);
t, Zero, &cglobs->cint);
}
else {
if (level == 0)
Yap_emit((new ? (++cglobs->nvars, put_var_op) : put_val_op), (CELL) v, argno, &cglobs->cint);
Yap_emit((new ? (++cglobs->nvars, put_var_op) : put_val_op), t, argno, &cglobs->cint);
else
Yap_emit((new ? (++cglobs->nvars, write_var_op) : write_val_op), (CELL) v, Zero, &cglobs->cint);
Yap_emit((new ? (++cglobs->nvars, write_var_op) : write_val_op), t, Zero, &cglobs->cint);
}
}
if (new) {
v->FirstOpForV = cglobs->cint.cpc;
}
v->LastOpForV = cglobs->cint.cpc;
++(v->RCountOfVE);
if (cglobs->onlast)
v->FlagsOfVE |= OnLastGoal;
if (v->AgeOfVE < cglobs->goalno)
v->AgeOfVE = cglobs->goalno;
tag_var(t, new, cglobs);
}
static void
@ -1349,6 +1366,58 @@ IsTrueGoal(Term t) {
return(t == MkAtomTerm(AtomTrue));
}
static void
c_p_put(Term Goal, op_numbers op_var, op_numbers op_val, compiler_struct * cglobs)
{
Term t = Deref(ArgOfTerm(1, Goal));
int new = check_var(t, 1, 0, cglobs);
t = Deref(t);
Yap_emit((new ?
(++cglobs->nvars,op_var) : op_val), t, IntegerOfTerm(ArgOfTerm(2, Goal)), &cglobs->cint);
tag_var(t, new, cglobs);
}
static void
emit_special_label(Term Goal, compiler_struct *cglobs)
{
special_label_op lab_op = IntOfTerm(ArgOfTerm(1,Goal));
special_label_id lab_id = IntOfTerm(ArgOfTerm(2,Goal));
UInt label_name;
switch (lab_op) {
case SPECIAL_LABEL_INIT:
label_name = ++cglobs->labelno;
switch (lab_id) {
case SPECIAL_LABEL_EXCEPTION:
cglobs->cint.exception_handler = label_name;
break;
case SPECIAL_LABEL_SUCCESS:
cglobs->cint.success_handler = label_name;
break;
case SPECIAL_LABEL_FAILURE:
cglobs->cint.failure_handler = label_name;
break;
}
Yap_emit(label_ctl_op, lab_op, label_name, &cglobs->cint);
break;
case SPECIAL_LABEL_SET:
switch (lab_id) {
case SPECIAL_LABEL_EXCEPTION:
Yap_emit(label_op, cglobs->cint.exception_handler, Zero, &cglobs->cint);
break;
case SPECIAL_LABEL_SUCCESS:
Yap_emit(label_op, cglobs->cint.success_handler, Zero, &cglobs->cint);
break;
case SPECIAL_LABEL_FAILURE:
Yap_emit(label_op, cglobs->cint.failure_handler, Zero, &cglobs->cint);
break;
}
case SPECIAL_LABEL_CLEAR:
return;
}
}
static void
c_goal(Term Goal, int mod, compiler_struct *cglobs)
{
@ -1764,8 +1833,158 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
#endif
}
return;
}
else {
} else if (op >= _p_put_fi && op <= _p_sl) {
switch(op) {
/* one should never get a new variable here */
case _p_get_fi:
c_p_put(Goal, get_fi_op, get_fi_op, cglobs);
break;
case _p_get_i:
c_p_put(Goal, get_i_op, get_i_op, cglobs);
break;
case _p_get_f:
c_p_put(Goal, get_f_op, get_f_op, cglobs);
break;
case _p_put_fi:
c_p_put(Goal, put_fi_var_op, put_fi_val_op, cglobs);
break;
case _p_put_i:
c_p_put(Goal, put_i_var_op, put_i_val_op, cglobs);
break;
case _p_put_f:
c_p_put(Goal, put_f_var_op, put_f_val_op, cglobs);
break;
case _p_a_eq_float:
Yap_emit(a_eqc_float_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
case _p_a_eq_int:
Yap_emit(a_eqc_int_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
case _p_a_eq:
Yap_emit(a_eq_op, IntOfTerm(ArgOfTerm(1, Goal)), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
case _p_ltc_float:
Yap_emit(ltc_float_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
case _p_ltc_int:
Yap_emit(ltc_int_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
case _p_lt:
Yap_emit(lt_op, IntOfTerm(ArgOfTerm(1, Goal)), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
case _p_gtc_float:
Yap_emit(gtc_float_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
case _p_gtc_int:
Yap_emit(gtc_int_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
case _p_add_float_c:
Yap_emit_3ops(add_float_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_add_int_c:
Yap_emit_3ops(add_int_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_add:
Yap_emit_3ops(add_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_sub_float_c:
Yap_emit_3ops(sub_float_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_sub_int_c:
Yap_emit_3ops(sub_int_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_sub:
Yap_emit_3ops(sub_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_mul_float_c:
Yap_emit_3ops(mul_float_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_mul_int_c:
Yap_emit_3ops(mul_int_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_mul:
Yap_emit_3ops(mul_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_fdiv_c1:
Yap_emit_3ops(fdiv_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_fdiv_c2:
Yap_emit_3ops(fdiv_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_fdiv:
Yap_emit_3ops(fdiv_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_idiv_c1:
Yap_emit_3ops(idiv_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_idiv_c2:
Yap_emit_3ops(idiv_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_idiv:
Yap_emit_3ops(idiv_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_mod_c1:
Yap_emit_3ops(mod_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_mod_c2:
Yap_emit_3ops(mod_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_mod:
Yap_emit_3ops(mod_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_rem_c1:
Yap_emit_3ops(rem_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_rem_c2:
Yap_emit_3ops(rem_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_rem:
Yap_emit_3ops(rem_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_land_c:
Yap_emit_3ops(a_and_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_land:
Yap_emit_3ops(a_and_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_lor_c:
Yap_emit_3ops(a_or_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_lor:
Yap_emit_3ops(a_or_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_xor_c:
Yap_emit_3ops(xor_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_xor:
Yap_emit_3ops(xor_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_uminus:
Yap_emit(uminus_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), &cglobs->cint);
break;
case _p_sr_c1:
Yap_emit_3ops(sr_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_sr_c2:
Yap_emit_3ops(sr_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_sr:
Yap_emit_3ops(sr_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_sl_c1:
Yap_emit_3ops(sl_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_sl_c2:
Yap_emit_3ops(sl_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_sl:
Yap_emit_3ops(sl_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
case _p_label_ctl:
emit_special_label(Goal, cglobs);
break;
}
} else {
c_args(Goal, 0, cglobs);
}
}

2
C/dlmalloc.c
View File

@ -1586,6 +1586,8 @@ Void_t* mALLOc(size_t bytes)
victim = av->top;
size = chunksize(victim);
if (size>100000) fprintf(stderr,"victim=%p %d\n",victim, size);
if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb + MINSIZE)) {
remainder_size = size - nb;

59
C/grow.c
View File

@ -938,8 +938,51 @@ fix_compiler_instructions(PInstr *pcpc)
case fetch_args_vv_op:
case fetch_args_cv_op:
case fetch_args_vc_op:
case get_fi_op:
case get_f_op:
case get_i_op:
case put_fi_var_op:
case put_f_var_op:
case put_i_var_op:
case put_fi_val_op:
case put_f_val_op:
case put_i_val_op:
pcpc->rnd1 = GlobalAdjust(pcpc->rnd1);
break;
case a_eqc_float_op:
case a_eqc_int_op:
case ltc_float_op:
case ltc_int_op:
case gtc_float_op:
case gtc_int_op:
case add_float_c_op:
case sub_float_c_op:
case mul_float_c_op:
case fdiv_c1_op:
case fdiv_c2_op:
/* floats might be in the global */
pcpc->rnd1 = AdjustAppl(pcpc->rnd1);
break;
case add_int_c_op:
case sub_int_c_op:
case mul_int_c_op:
case sr_c1_op:
case sr_c2_op:
case sl_c1_op:
case sl_c2_op:
case idiv_c1_op:
case idiv_c2_op:
case rem_c1_op:
case rem_c2_op:
case mod_c1_op:
case mod_c2_op:
case a_and_c_op:
case a_or_c_op:
case xor_c_op:
/* floats might be in the global */
if (!IsIntTerm(pcpc->rnd1))
pcpc->rnd1 = AdjustAppl(pcpc->rnd1);
break;
case get_float_op:
case put_float_op:
case get_longint_op:
@ -1043,6 +1086,22 @@ fix_compiler_instructions(PInstr *pcpc)
case blob_op:
case fetch_args_vi_op:
case fetch_args_iv_op:
case a_eq_op:
case lt_op:
case add_op:
case sub_op:
case mul_op:
case fdiv_op:
case idiv_op:
case mod_op:
case rem_op:
case a_and_op:
case a_or_op:
case xor_op:
case uminus_op:
case sr_op:
case sl_op:
case label_ctl_op:
#ifdef TABLING
case table_new_answer_op:
case table_try_single_op:

110
C/index.c
View File

@ -1310,9 +1310,9 @@ has_cut(yamop *pc)
case _write_l_struc:
pc = NEXTOP(pc,f);
break;
/* instructions type sdlp */
/* instructions type slp */
case _call_c_wfail:
pc = NEXTOP(pc,sdlp);
pc = NEXTOP(pc,slp);
break;
/* instructions type lds */
case _try_c:
@ -2414,6 +2414,112 @@ add_info(ClauseDef *clause, UInt regno)
}
cl = NEXTOP(cl,yxn);
break;
case _a_eqc_float:
case _ltc_float:
case _gtc_float:
cl = NEXTOP(cl,sdll);
break;
case _a_eqc_int:
case _ltc_int:
case _gtc_int:
cl = NEXTOP(cl,snll);
break;
case _a_eq:
case _lt:
cl = NEXTOP(cl,snll);
break;
case _add_float_c:
case _sub_float_c:
case _mul_float_c:
case _fdiv_c1:
case _fdiv_c2:
cl = NEXTOP(cl,ssd);
break;
case _add_int_c:
case _sub_int_c:
case _mul_int_c:
case _idiv_c1:
case _idiv_c2:
case _mod_c1:
case _mod_c2:
case _rem_c1:
case _rem_c2:
case _a_or_c:
case _a_and_c:
case _xor_c:
case _sl_c1:
case _sl_c2:
case _sr_c1:
case _sr_c2:
cl = NEXTOP(cl,ssn);
break;
case _add:
case _sub:
case _mul:
case _fdiv:
case _idiv:
case _mod:
case _rem:
case _a_or:
case _a_and:
case _xor:
case _uminus:
case _sl:
case _sr:
cl = NEXTOP(cl,sss);
break;
case _get_fi_x:
case _get_i_x:
case _get_f_x:
case _put_fi_var_x:
case _put_i_var_x:
case _put_f_var_x:
if (regcopy_in(myregs, nofregs, cl->u.sxl.x) &&
(nofregs = delete_regcopy(myregs, nofregs, cl->u.sxl.x)) == 0 &&
!ycopy) {
clause->Tag = (CELL)NULL;
return;
}
cl = NEXTOP(cl,sxl);
break;
case _get_fi_y:
case _get_i_y:
case _get_f_y:
case _put_fi_var_y:
case _put_i_var_y:
case _put_f_var_y:
if (cl->u.syl.y == ycopy) {
ycopy = 0; /* weird stuff, let's just reset ycopy */
if (nofregs == 0) {
clause->Tag = (CELL)NULL;
return;
}
}
cl = NEXTOP(cl,syl);
break;
case _put_fi_val_x:
case _put_i_val_x:
case _put_f_val_x:
if (regcopy_in(myregs, nofregs, cl->u.sxll.x) &&
(nofregs = delete_regcopy(myregs, nofregs, cl->u.sxll.x)) == 0 &&
!ycopy) {
clause->Tag = (CELL)NULL;
return;
}
cl = NEXTOP(cl,sxll);
break;
case _put_fi_val_y:
case _put_i_val_y:
case _put_f_val_y:
if (cl->u.syll.y == ycopy) {
ycopy = 0; /* weird stuff, let's just reset ycopy */
if (nofregs == 0) {
clause->Tag = (CELL)NULL;
return;
}
}
cl = NEXTOP(cl,syll);
break;
case _lock_lu:
cl = NEXTOP(cl,p);
break;

49
C/inlines.c
View File

@ -925,6 +925,55 @@ Yap_InitInlines(void)
Yap_InitAsmPred("$or", 3, _or, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$sll", 3, _sll, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$slr", 3, _slr, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$put_fi", 2, _p_put_fi, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$put_i", 2, _p_put_i, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$put_f", 2, _p_put_f, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$a_eq_float", 2, _p_a_eq_float, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$a_eq_int", 2, _p_a_eq_int, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$a_eq", 2, _p_a_eq, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$ltc_float", 2, _p_ltc_float, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$ltc_int", 2, _p_ltc_int, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$lt", 2, _p_lt, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$gtc_float", 2, _p_gtc_float, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$gtc_int", 2, _p_gtc_int, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$get_fi", 2, _p_get_fi, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$get_i", 2, _p_get_i, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$get_f", 2, _p_get_f, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$add_float_c", 3, _p_add_float_c, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$add_int_c", 3, _p_add_int_c, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$add", 3, _p_add, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$sub_float_c", 3, _p_sub_float_c, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$sub_int_c", 3, _p_sub_int_c, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$sub", 3, _p_sub, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$mul_float_c", 3, _p_mul_float_c, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$mul_int_c", 3, _p_mul_int_c, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$mul", 3, _p_mul, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$fdiv_c1", 3, _p_fdiv_c1, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$fdiv_c2", 3, _p_fdiv_c2, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$fdiv", 3, _p_fdiv, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$idiv_c1", 3, _p_idiv_c1, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$idiv_c2", 3, _p_idiv_c2, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$idiv", 3, _p_idiv, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$mod_c1", 3, _p_mod_c1, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$mod_c2", 3, _p_mod_c2, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$mod", 3, _p_mod, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$rem_c1", 3, _p_rem_c1, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$rem_c2", 3, _p_rem_c2, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$rem", 3, _p_rem, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$land_c", 3, _p_land_c, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$land", 3, _p_land, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$lor_c", 3, _p_lor_c, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$lor", 3, _p_lor, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$xor_c", 3, _p_xor_c, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$xor", 3, _p_xor, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$uminus", 2, _p_uminus, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$sr_c1", 3, _p_sr_c1, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$sr_c2", 3, _p_sr_c2, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$sr", 3, _p_sr, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$sl_c1", 3, _p_sl_c1, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$sl_c2", 3, _p_sl_c2, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$sl", 3, _p_sl, p_erroneous_call, SafePredFlag);
Yap_InitAsmPred("$label_ctl", 2, _p_label_ctl, p_erroneous_call, SafePredFlag);
CurrentModule = ARG_MODULE;
Yap_InitCPredBack("genarg", 3, 3, init_genarg, cont_genarg,SafePredFlag);
CurrentModule = cm;

9
H/Regs.h
View File

@ -24,6 +24,7 @@
#endif
#define MaxTemps 512
#define MaxArithms 32
#ifdef i386
#define PUSH_REGS 1
@ -144,6 +145,10 @@ typedef struct
#ifdef PUSH_X
Term XTERMS[MaxTemps]; /* 29 */
#endif
yamop *ARITH_EXCEPTION_;
int isint_[MaxArithms];
Int Ints_[MaxArithms];
Float Floats_[MaxArithms];
}
REGSTORE;
@ -717,6 +722,10 @@ EXTERN inline void restore_B(void) {
#define DelayedVars Yap_REGS.DelayedVars_
#endif
#define CurrentModule Yap_REGS.CurrentModule_
#define ARITH_EXCEPTION Yap_REGS.ARITH_EXCEPTION_
#define Yap_isint Yap_REGS.isint_
#define Yap_Floats Yap_REGS.Floats_
#define Yap_Ints Yap_REGS.Ints_
#define REG_SIZE sizeof(REGS)/sizeof(CELL *)

62
H/YapOpcodes.h
View File

@ -182,7 +182,7 @@
OPCODE(call_cpred ,Osbpp),
OPCODE(execute_cpred ,pp),
OPCODE(call_usercpred ,Osbpp),
OPCODE(call_c_wfail ,sdlp),
OPCODE(call_c_wfail ,slp),
OPCODE(try_c ,OtapFs),
OPCODE(retry_c ,OtapFs),
#ifdef CUT_C
@ -295,6 +295,66 @@
OPCODE(call_bfunc_yx ,plxys),
OPCODE(call_bfunc_xy ,plxys),
OPCODE(call_bfunc_yy ,plyys),
OPCODE(get_fi_x ,sxl),
OPCODE(get_fi_y ,syl),
OPCODE(get_i_x ,sxl),
OPCODE(get_i_y ,syl),
OPCODE(get_f_x ,sxl),
OPCODE(get_f_y ,syl),
OPCODE(a_eqc_float ,sdll),
OPCODE(a_eqc_int ,snll),
OPCODE(a_eq ,ssll),
OPCODE(ltc_float ,sdll),
OPCODE(ltc_int ,snll),
OPCODE(lt ,ssll),
OPCODE(gtc_float ,sdll),
OPCODE(gtc_int ,snll),
OPCODE(add_float_c ,ssd),
OPCODE(add_int_c ,ssn),
OPCODE(add ,sss),
OPCODE(sub_float_c ,ssd),
OPCODE(sub_int_c ,ssn),
OPCODE(sub ,sss),
OPCODE(mul_float_c ,ssd),
OPCODE(mul_int_c ,ssn),
OPCODE(mul ,sss),
OPCODE(fdiv_c1 ,ssd),
OPCODE(fdiv_c2 ,ssd),
OPCODE(fdiv ,sss),
OPCODE(idiv_c1 ,ssn),
OPCODE(idiv_c2 ,ssn),
OPCODE(idiv ,sss),
OPCODE(mod_c1 ,ssn),
OPCODE(mod_c2 ,ssn),
OPCODE(mod ,sss),
OPCODE(rem_c1 ,ssn),
OPCODE(rem_c2 ,ssn),
OPCODE(rem ,sss),
OPCODE(a_or_c ,ssn),
OPCODE(a_or ,sss),
OPCODE(a_and_c ,ssn),
OPCODE(a_and ,sss),
OPCODE(xor_c ,ssn),
OPCODE(xor ,sss),
OPCODE(uminus ,ss),
OPCODE(sl_c1 ,ssn),
OPCODE(sl_c2 ,ssn),
OPCODE(sl ,sss),
OPCODE(sr_c1 ,ssn),
OPCODE(sr_c2 ,ssn),
OPCODE(sr ,sss),
OPCODE(put_fi_val_x ,sxll),
OPCODE(put_fi_val_y ,syll),
OPCODE(put_i_val_x ,sxll),
OPCODE(put_i_val_y ,syll),
OPCODE(put_f_val_x ,sxll),
OPCODE(put_f_val_y ,syll),
OPCODE(put_fi_var_x ,sxll),
OPCODE(put_fi_var_y ,syll),
OPCODE(put_i_var_x ,sxll),
OPCODE(put_i_var_y ,syll),
OPCODE(put_f_var_x ,sxll),
OPCODE(put_f_var_y ,syll),
OPCODE(p_equal ,e),
OPCODE(p_dif ,l),
OPCODE(p_eq ,l),

119
H/amidefs.h
View File

@ -136,7 +136,56 @@ typedef enum {
_sll,
_slr,
_arg,
_functor
_functor,
_p_put_fi,
_p_put_i,
_p_put_f,
_p_a_eq_float,
_p_a_eq_int,
_p_a_eq,
_p_ltc_float,
_p_ltc_int,
_p_lt,
_p_gtc_float,
_p_gtc_int,
_p_get_fi,
_p_get_i,
_p_get_f,
_p_add_float_c,
_p_add_int_c,
_p_add,
_p_sub_float_c,
_p_sub_int_c,
_p_sub,
_p_mul_float_c,
_p_mul_int_c,
_p_mul,
_p_fdiv_c1,
_p_fdiv_c2,
_p_fdiv,
_p_idiv_c1,
_p_idiv_c2,
_p_idiv,
_p_mod_c1,
_p_mod_c2,
_p_mod,
_p_rem_c1,
_p_rem_c2,
_p_rem,
_p_land_c,
_p_land,
_p_lor_c,
_p_lor,
_p_xor_c,
_p_xor,
_p_uminus,
_p_sr_c1,
_p_sr_c2,
_p_sr,
_p_sl_c1,
_p_sl_c2,
_p_sl,
_p_label_ctl
} basic_preds;
#if USE_THREADED_CODE
@ -471,11 +520,75 @@ typedef struct yami {
} sc;
struct {
COUNT s;
CPredicate d;
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
struct yami *F;
struct yami *T;
CELL next;
} sdll;
struct {
COUNT s;
struct yami *l;
struct pred_entry *p;
CELL next;
} sdlp;
} slp;
struct {
COUNT s;
Int I;
struct yami *F;
struct yami *T;
CELL next;
} snll;
struct {
COUNT s0;
COUNT s1;
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
CELL next;
} ssd;
struct {
COUNT s0;
COUNT s1;
Int n;
CELL next;
} ssn;
struct {
COUNT s0;
COUNT s1;
COUNT s2;
CELL next;
} sss;
struct {
COUNT s1;
COUNT s2;
struct yami *F;
struct yami *T;
CELL next;
} ssll;
struct {
COUNT s;
wamreg x;
struct yami *l;
CELL next;
} sxl;
struct {
COUNT s;
wamreg x;
struct yami *F;
struct yami *T;
CELL next;
} sxll;
struct {
COUNT s;
yslot y;
struct yami *l;
CELL next;
} syl;
struct {
COUNT s;
yslot y;
struct yami *F;
struct yami *T;
CELL next;
} syll;
/* the next 3 instructions must have same size and have fields in same order! */
/* also check env for yes and trustfail code before making any changes */
/* last, Osblp is known to the buildops script */

44
H/arith2.h
View File

@ -19,6 +19,12 @@
*
*/
inline static int
add_overflow(Int x, Int i, Int j)
{
return (i & j & ~x) | (~i & ~j & x);
}
inline static Term
add_int(Int i, Int j)
{
@ -38,6 +44,12 @@ add_int(Int i, Int j)
#endif
}
inline static int
sub_overflow(Int x, Int i, Int j)
{
return (i & ~j & ~x) | (~i & j & x);
}
inline static Term
sub_int(Int i, Int j)
{
@ -72,6 +84,13 @@ sub_int(Int i, Int j)
#endif
#endif
inline static int
mul_overflow(Int z, Int i1, Int i2)
{
return (i2 && z/i2 != i1);
}
#ifndef OPTIMIZE_MULTIPLI
#define DO_MULTI() z = i1*i2; \
if (i2 && z/i2 != i1) goto overflow
@ -94,12 +113,31 @@ times_int(Int i1, Int i2) {
#if USE_GMP
static inline Int
sll_ovflw(Int x,Int i)
static inline int
sl_overflow(Int x,Int i)
{
CELL t = (1<<x)-1;
return (t & i) != i;
}
static inline int
sr_overflow(Int x,Int i)
{
CELL t = (1>>x)-1;
return (t & i) != i;
}
#else
static inline Int
sl_overflow(Int x,Int i)
{
return FALSE;
}
static inline Int
sr_overflow(Int x,Int i)
{
return FALSE;
}
#endif
inline static Term
@ -109,7 +147,7 @@ do_sll(Int i, Int j)
Int x = (8*sizeof(CELL)-2)-j;
if (x < 0||
sll_ovflw(x,i)) {
sl_overflow(x,i)) {
return(Yap_gmp_sll_ints(i, j));
}
#endif

67
H/compile.h
View File

@ -178,7 +178,59 @@ typedef enum compiler_op {
#endif
fetch_args_for_bccall,
bccall_op,
blob_op
blob_op,
get_fi_op,
get_i_op,
get_f_op,
put_fi_var_op,
put_f_var_op,
put_i_var_op,
put_fi_val_op,
put_f_val_op,
put_i_val_op,
a_eqc_float_op,
a_eqc_int_op,
a_eq_op,
ltc_float_op,
ltc_int_op,
lt_op,
gtc_float_op,
gtc_int_op,
add_float_c_op,
add_int_c_op,
add_op,
sub_float_c_op,
sub_int_c_op,
sub_op,
mul_float_c_op,
mul_int_c_op,
mul_op,
sr_c1_op,
sr_c2_op,
sr_op,
sl_c1_op,
sl_c2_op,
sl_op,
fdiv_c1_op,
fdiv_c2_op,
fdiv_op,
idiv_c1_op,
idiv_c2_op,
idiv_op,
mod_c1_op,
mod_c2_op,
mod_op,
rem_c1_op,
rem_c2_op,
rem_op,
a_and_c_op,
a_and_op,
a_or_c_op,
a_or_op,
xor_c_op,
xor_op,
uminus_op,
label_ctl_op
#ifdef SFUNC
,
get_s_f_op,
@ -260,6 +312,7 @@ typedef struct intermediates {
yamop *code_addr;
yamop *expand_block;
UInt i_labelno;
UInt exception_handler, success_handler, failure_handler;
/* for expanding code */
yamop **current_try_lab, **current_trust_lab;
yamop *try_instructions;
@ -269,6 +322,18 @@ typedef struct intermediates {
} current_cl;
} CIntermediates;
typedef enum special_label_id_enum {
SPECIAL_LABEL_SUCCESS = 0,
SPECIAL_LABEL_FAILURE = 1,
SPECIAL_LABEL_EXCEPTION = 2
} special_label_id;
typedef enum special_label_op_enum {
SPECIAL_LABEL_INIT = 0,
SPECIAL_LABEL_SET = 1,
SPECIAL_LABEL_CLEAR =2
} special_label_op;
#define SafeVar 0x01
#define PermFlag 0x02
#define GlobalVal 0x04

139
H/rclause.h
View File

@ -449,13 +449,15 @@ restore_opcodes(yamop *pc)
pc->u.sc.c = ConstantTermAdjust(pc->u.sc.c);
pc = NEXTOP(pc,sc);
break;
/* instructions type sdlp */
case _call_c_wfail:
pc->u.sdlp.s = ConstantAdjust(pc->u.sdlp.s);
DoubleInCodeAdjust(pc->u.sdlp.d);
pc->u.sdlp.l = PtoOpAdjust(pc->u.sdlp.l);
pc->u.sdlp.p = PtoPredAdjust(pc->u.sdlp.p);
pc = NEXTOP(pc,sdlp);
/* instructions type sdll */
case _a_eqc_float:
case _gtc_float:
case _ltc_float:
pc->u.sdll.s = ConstantAdjust(pc->u.sdll.s);
DoubleInCodeAdjust(pc->u.sdll.d);
pc->u.sdll.F = PtoOpAdjust(pc->u.sdll.F);
pc->u.sdll.T = PtoOpAdjust(pc->u.sdll.T);
pc = NEXTOP(pc,sdll);
break;
/* instructions type sllll */
case _switch_on_sub_arg_type:
@ -466,6 +468,85 @@ restore_opcodes(yamop *pc)
pc->u.sllll.l4 = PtoOpAdjust(pc->u.sllll.l4);
pc = NEXTOP(pc,sllll);
break;
/* instructions type slp */
case _call_c_wfail:
pc->u.slp.s = ConstantAdjust(pc->u.slp.s);
pc->u.slp.l = PtoOpAdjust(pc->u.slp.l);
pc->u.slp.p = PtoPredAdjust(pc->u.slp.p);
pc = NEXTOP(pc,slp);
break;
/* instructions type snll */
case _a_eqc_int:
case _gtc_int:
case _ltc_int:
pc->u.snll.s = ConstantAdjust(pc->u.snll.s);
pc->u.snll.I = IntegerAdjust(pc->u.snll.I);
pc->u.snll.F = PtoOpAdjust(pc->u.snll.F);
pc->u.snll.T = PtoOpAdjust(pc->u.snll.T);
pc = NEXTOP(pc,snll);
break;
/* instructions type ss */
case _uminus:
/* instructions type ssd */
case _add_float_c:
case _fdiv_c1:
case _fdiv_c2:
case _mul_float_c:
case _sub_float_c:
pc->u.ssd.s0 = ConstantAdjust(pc->u.ssd.s0);
pc->u.ssd.s1 = ConstantAdjust(pc->u.ssd.s1);
DoubleInCodeAdjust(pc->u.ssd.d);
pc = NEXTOP(pc,ssd);
break;
/* instructions type ssll */
case _a_eq:
case _lt:
pc->u.ssll.s1 = ConstantAdjust(pc->u.ssll.s1);
pc->u.ssll.s2 = ConstantAdjust(pc->u.ssll.s2);
pc->u.ssll.F = PtoOpAdjust(pc->u.ssll.F);
pc->u.ssll.T = PtoOpAdjust(pc->u.ssll.T);
pc = NEXTOP(pc,ssll);
break;
/* instructions type ssn */
case _a_and_c:
case _a_or_c:
case _add_int_c:
case _idiv_c1:
case _idiv_c2:
case _mod_c1:
case _mod_c2:
case _mul_int_c:
case _rem_c1:
case _rem_c2:
case _sl_c1:
case _sl_c2:
case _sr_c1:
case _sr_c2:
case _sub_int_c:
case _xor_c:
pc->u.ssn.s0 = ConstantAdjust(pc->u.ssn.s0);
pc->u.ssn.s1 = ConstantAdjust(pc->u.ssn.s1);
pc->u.ssn.n = IntegerAdjust(pc->u.ssn.n);
pc = NEXTOP(pc,ssn);
break;
/* instructions type sss */
case _a_and:
case _a_or:
case _add:
case _fdiv:
case _idiv:
case _mod:
case _mul:
case _rem:
case _sl:
case _sr:
case _sub:
case _xor:
pc->u.sss.s0 = ConstantAdjust(pc->u.sss.s0);
pc->u.sss.s1 = ConstantAdjust(pc->u.sss.s1);
pc->u.sss.s2 = ConstantAdjust(pc->u.sss.s2);
pc = NEXTOP(pc,sss);
break;
/* instructions type sssl */
case _go_on_cons:
case _go_on_func:
@ -490,6 +571,50 @@ restore_opcodes(yamop *pc)
pc->u.sssllp.p = PtoPredAdjust(pc->u.sssllp.p);
pc = NEXTOP(pc,sssllp);
break;
/* instructions type sxl */
case _get_f_x:
case _get_fi_x:
case _get_i_x:
pc->u.sxl.s = ConstantAdjust(pc->u.sxl.s);
pc->u.sxl.x = XAdjust(pc->u.sxl.x);
pc->u.sxl.l = PtoOpAdjust(pc->u.sxl.l);
pc = NEXTOP(pc,sxl);
break;
/* instructions type sxll */
case _put_f_val_x:
case _put_f_var_x:
case _put_fi_val_x:
case _put_fi_var_x:
case _put_i_val_x:
case _put_i_var_x:
pc->u.sxll.s = ConstantAdjust(pc->u.sxll.s);
pc->u.sxll.x = XAdjust(pc->u.sxll.x);
pc->u.sxll.F = PtoOpAdjust(pc->u.sxll.F);
pc->u.sxll.T = PtoOpAdjust(pc->u.sxll.T);
pc = NEXTOP(pc,sxll);
break;
/* instructions type syl */
case _get_f_y:
case _get_fi_y:
case _get_i_y:
pc->u.syl.s = ConstantAdjust(pc->u.syl.s);
pc->u.syl.y = YAdjust(pc->u.syl.y);
pc->u.syl.l = PtoOpAdjust(pc->u.syl.l);
pc = NEXTOP(pc,syl);
break;
/* instructions type syll */
case _put_f_val_y:
case _put_f_var_y:
case _put_fi_val_y:
case _put_fi_var_y:
case _put_i_val_y:
case _put_i_var_y:
pc->u.syll.s = ConstantAdjust(pc->u.syll.s);
pc->u.syll.y = YAdjust(pc->u.syll.y);
pc->u.syll.F = PtoOpAdjust(pc->u.syll.F);
pc->u.syll.T = PtoOpAdjust(pc->u.syll.T);
pc = NEXTOP(pc,syll);
break;
/* instructions type x */
case _get_list:
case _put_list:

155
pl/eval.yap
View File

@ -97,7 +97,7 @@ compile_arith(LGs, InputVs, ExtraVs, Gs, ArithComp) :-
FlatExps = [_,_|_],
alloc_regs(NewTypedVs,0,Regs),
Regs < 32,
compile_ops(FlatExps, Gs, ArithComp), !.
compile_ops([init_label(exception_label),init_label(success_label)|FlatExps], Gs, ArithComp), !.
compile_arith(_, _, _, Gs, Gs).
add_type_slots([],[]).
@ -107,8 +107,12 @@ add_type_slots([V|ExpVs],[t(V,_,_)|TypesVs]) :-
visit([], TypedVs, TypedVs, _) --> [].
visit([Exp|Exps], TypedVs, NewTypedVs, ExtraVs) -->
visit_pred(Exp, TypedVs, ITypedVs, ExtraVs),
add_success_label(Exps),
visit(Exps, ITypedVs, NewTypedVs, ExtraVs).
add_success_label([]) --> [].
add_success_label([_|_]) --> [set_label(success_label)].
visit_pred((X is _), _, _, _) -->
{ nonvar(X) }, !,
{ fail }.
@ -126,7 +130,7 @@ visit_pred((X is T), TypedVs, ExtraTypedVs, LeftBodyVars) -->
),
% final code
( { vmember(X, LeftBodyVars) } ->
[export(TMP,X,Type)]
[init_label(success_label), export(TMP,X,Type)]
;
[]
).
@ -136,21 +140,21 @@ visit_pred((X =:= T), TypedVs, NewTypedVs, _) -->
visit_exp(T, ITypedVs, NewTypedVs, TMP2, Type),
% assign the type to X, if any
% final code
[eq(TMP1,TMP2)].
[init_label(success_label), eq(TMP1,TMP2)].
visit_pred((X < T), TypedVs, NewTypedVs, _) -->
% check the expression
visit_exp(X, TypedVs, ITypedVs, TMP1, Type),
visit_exp(T, ITypedVs, NewTypedVs, TMP2, Type),
% assign the type to X, if any
% final code
[lt(TMP1,TMP2)].
[init_label(success_label), lt(TMP1,TMP2)].
visit_pred((X > T), TypedVs, NewTypedVs, _) -->
% check the expression
visit_exp(X, TypedVs, ITypedVs, TMP1, Type),
visit_exp(T, ITypedVs, NewTypedVs, TMP2, Type),
% assign the type to X, if any
% final code
[lt(TMP2,TMP1)].
[init_label(success_label), lt(TMP2,TMP1)].
visit_exp(V, TypedVs, TypedVs, TMP, Type) -->
{
@ -466,72 +470,89 @@ alloc_regs([t(_,_,x(R0))|NewTypedVs], R0, RF) :- !,
alloc_regs([t(_,_,x(_))|NewTypedVs], R0, RF) :-
alloc_regs(NewTypedVs, R0, RF).
compile_ops([], Gs, '$escape'(Gs)).
compile_ops([], Gs, Tail) :-
compile_tail(Gs, Tail).
compile_ops([Op|Exps], Gs, (COp,More)) :-
compile_op(Op , COp),
compile_ops(Exps, Gs, More).
compile_op(export(x(A),V,any), get_opres(A,V)) :- !.
compile_op(export(x(A),V,int), get_opres_int(A,V)).
compile_op(export(x(A),V,float), get_opres_float(A,V)).
compile_op(eq(x(A),F), eqc_float(A,F)) :- float(F), !.
compile_op(eq(x(A),I), eqc_int(A,I)) :- integer(I), !.
compile_op(eq(x(A),x(B)), eq(A,B)).
compile_op(lt(x(A),F), ltc_float(A,F)) :- float(F), !.
compile_op(lt(x(A),I), ltc_int(A,I)) :- integer(I), !.
compile_op(lt(F,x(A)), gtc_float(A,F)) :- float(F), !.
compile_op(lt(I,x(A)), gtc_int(A,I)) :- integer(I), !.
compile_op(lt(x(A),x(B)), lt(A,B)).
compile_op(get(x(A),V,any), get_opinp(A,V)) :- !.
compile_op(get(x(A),V,int), get_opinp_int(A,V)) :- !.
compile_op(get(x(A),V,float), get_opinp_float(A,V)).
compile_op(zerop(x(A),Op), zerop(A,Op)).
compile_op(add(x(A),F,x(B)), add_float_c(A,B,F)) :- float(F), !.
compile_op(add(x(A),I,x(B)), add_int_c(A,B,I)) :- integer(I), !.
compile_op(add(x(A),x(B),F), add_float_c(A,B,F)) :- float(F), !.
compile_op(add(x(A),x(B),I), add_int_c(A,B,I)) :- integer(I), !.
compile_op(add(x(A),x(B),x(C)), add(A,B,C)).
compile_op(sub(x(A),F,x(B)), sub_float_c(A,B,F)) :- float(F), !.
compile_op(sub(x(A),I,x(B)), sub_int_c(A,B,I)) :- integer(I), !.
compile_op(sub(x(A),x(B),F), add_float_c(A,B,F1)) :- float(F), !, F1 is -F.
compile_op(sub(x(A),x(B),I), add_int_c(A,B,I1)) :- integer(I), !, I1 is -I.
compile_op(sub(x(A),x(B),x(C)), sub(A,B,C)).
compile_op(mul(x(A),F,x(B)), mul_float_c(A,B,F)) :- float(F), !.
compile_op(mul(x(A),I,x(B)), mul_int_c(A,B,I)) :- integer(I), !.
compile_op(mul(x(A),x(B),F), mul_float_c(A,B,F)) :- float(F), !.
compile_op(mul(x(A),x(B),I), mul_int_c(A,B,I)) :- integer(I), !.
compile_op(mul(x(A),x(B),x(C)), mul(A,B,C)).
compile_op(fdiv(x(A),F,x(B)), fdiv_c1(A,B,F)) :- float(F), !.
compile_op(fdiv(x(A),I,x(B)), fdiv_c1(A,B,F)) :- integer(I), !, F is truncate(I).
compile_op(fdiv(x(A),x(B),F), fdiv_c2(A,B,F)) :- float(F), !.
compile_op(fdiv(x(A),x(B),I), fdiv_c2(A,B,F)) :- integer(I), !, F is truncate(I).
compile_op(fdiv(x(A),x(B),x(C)), fdiv(A,B,C)).
compile_op(idiv(x(A),I,x(B)), idiv_c1(A,B,I)) :- integer(I), !.
compile_op(idiv(x(A),x(B),I), idiv_c2(A,B,I)) :- integer(I), !.
compile_op(idiv(x(A),x(B),x(C)), idiv(A,B,C)).
compile_op(mod(x(A),I,x(B)), mod_c1(A,B,I)) :- integer(I), !.
compile_op(mod(x(A),x(B),I), mod_c2(A,B,I)) :- integer(I), !.
compile_op(mod(x(A),x(B),x(C)), mod(A,B,C)).
compile_op(rem(x(A),I,x(B)), rem_c1(A,B,I)) :- integer(I), !.
compile_op(rem(x(A),x(B),I), rem_c2(A,B,I)) :- integer(I), !.
compile_op(rem(x(A),x(B),x(C)), rem(A,B,C)).
compile_op(and(x(A),I,x(B)), and_c(A,B,I)) :- integer(I), !.
compile_op(and(x(A),x(B),I), and_c(A,B,I)) :- integer(I), !.
compile_op(and(x(A),x(B),x(C)), and(A,B,C)).
compile_op(or(x(A),I,x(B)), or_c(A,B,I)) :- integer(I), !.
compile_op(or(x(A),x(B),I), or_c(A,B,I)) :- integer(I), !.
compile_op(or(x(A),x(B),x(C)), or(A,B,C)).
compile_op(xor(x(A),I,x(B)), xor_c(A,B,I)) :- integer(I), !.
compile_op(xor(x(A),x(B),I), xor_c(A,B,I)) :- integer(I), !.
compile_op(xor(x(A),x(B),x(C)), xor(A,B,C)).
compile_op(uminus(x(A),x(B)), uminus(A,B)).
compile_op(sr(x(A),I,x(B)), sr_c1(A,B,I)) :- integer(I), !.
compile_op(sr(x(A),x(B),I), sr_c2(A,B,I)) :- integer(I), !.
compile_op(sr(x(A),x(B),x(C)), sr(A,B,C)).
compile_op(sl(x(A),I,x(B)), sl_c1(A,B,I)) :- integer(I), !.
compile_op(sl(x(A),x(B),I), sl_c2(A,B,I)) :- integer(I), !.
compile_op(sl(x(A),x(B),x(C)), sl(A,B,C)).
compile_tail(Gs,(E1,Gs,E2,E3,E4)) :-
compile_op(set_label(exception_label),E1),
compile_op(set_label(success_label),E2),
compile_op(clear_label(exception_label),E3),
compile_op(clear_label(success_label),E4).
compile_op(init_label(exception_label), '$label_ctl'(0,2)).
compile_op(init_label(fail_label), '$label_ctl'(0,1)).
compile_op(init_label(success_label), '$label_ctl'(0,0)).
compile_op(set_label(exception_label), '$label_ctl'(1,2)).
compile_op(set_label(fail_label), '$label_ctl'(1,1)).
compile_op(set_label(success_label), '$label_ctl'(1,0)).
compile_op(clear_label(exception_label), '$label_ctl'(2,2)).
compile_op(clear_label(fail_label), '$label_ctl'(2,1)).
compile_op(clear_label(success_label), '$label_ctl'(2,0)).
compile_op(export(x(A),V,any), '$put_fi'(A,V)) :- !.
compile_op(export(x(A),V,int), '$put_i'(A,V)).
compile_op(export(x(A),V,float), '$put_f'(A,V)).
compile_op(eq(x(A),F), '$a_eq_float'(A,F)) :- float(F), !.
compile_op(eq(x(A),I), '$a_eq_int'(A,I)) :- integer(I), !.
compile_op(eq(x(A),x(B)), '$a_eq'(A,B)).
compile_op(lt(x(A),F), '$ltc_float'(A,F)) :- float(F), !.
compile_op(lt(x(A),I), '$ltc_int'(A,I)) :- integer(I), !.
compile_op(lt(F,x(A)), '$gtc_float'(A,F)) :- float(F), !.
compile_op(lt(I,x(A)), '$gtc_int'(A,I)) :- integer(I), !.
compile_op(lt(x(A),x(B)), '$lt'(A,B)).
compile_op(get(x(A),V,any), '$get_fi'(A,V)) :- !.
compile_op(get(x(A),V,int), '$get_i'(A,V)) :- !.
compile_op(get(x(A),V,float), '$get_f'(A,V)).
compile_op(add(x(A),F,x(B)), '$add_float_c'(A,B,F)) :- float(F), !.
compile_op(add(x(A),I,x(B)), '$add_int_c'(A,B,I)) :- integer(I), !.
compile_op(add(x(A),x(B),F), '$add_float_c'(A,B,F)) :- float(F), !.
compile_op(add(x(A),x(B),I), '$add_int_c'(A,B,I)) :- integer(I), !.
compile_op(add(x(A),x(B),x(C)), '$add'(A,B,C)).
compile_op(sub(x(A),F,x(B)), '$sub_float_c'(A,B,F)) :- float(F), !.
compile_op(sub(x(A),I,x(B)), '$sub_int_c'(A,B,I)) :- integer(I), !.
compile_op(sub(x(A),x(B),F), '$add_float_c'(A,B,F1)) :- float(F), !, F1 is -F.
compile_op(sub(x(A),x(B),I), '$add_int_c'(A,B,I1)) :- integer(I), !, I1 is -I.
compile_op(sub(x(A),x(B),x(C)), '$sub'(A,B,C)).
compile_op(mul(x(A),F,x(B)), '$mul_float_c'(A,B,F)) :- float(F), !.
compile_op(mul(x(A),I,x(B)), '$mul_int_c'(A,B,I)) :- integer(I), !.
compile_op(mul(x(A),x(B),F), '$mul_float_c'(A,B,F)) :- float(F), !.
compile_op(mul(x(A),x(B),I), '$mul_int_c'(A,B,I)) :- integer(I), !.
compile_op(mul(x(A),x(B),x(C)), '$mul'(A,B,C)).
compile_op(fdiv(x(A),F,x(B)), '$fdiv_c1'(A,B,F)) :- float(F), !.
compile_op(fdiv(x(A),I,x(B)), '$fdiv_c1'(A,B,F)) :- integer(I), !, F is truncate(I).
compile_op(fdiv(x(A),x(B),F), '$fdiv_c2'(A,B,F)) :- float(F), !.
compile_op(fdiv(x(A),x(B),I), '$fdiv_c2'(A,B,F)) :- integer(I), !, F is truncate(I).
compile_op(fdiv(x(A),x(B),x(C)), '$fdiv'(A,B,C)).
compile_op(idiv(x(A),I,x(B)), '$idiv_c1'(A,B,I)) :- integer(I), !.
compile_op(idiv(x(A),x(B),I), '$idiv_c2'(A,B,I)) :- integer(I), !.
compile_op(idiv(x(A),x(B),x(C)), '$idiv'(A,B,C)).
compile_op(mod(x(A),I,x(B)), '$mod_c1'(A,B,I)) :- integer(I), !.
compile_op(mod(x(A),x(B),I), '$mod_c2'(A,B,I)) :- integer(I), !.
compile_op(mod(x(A),x(B),x(C)), '$mod'(A,B,C)).
compile_op(rem(x(A),I,x(B)), '$rem_c1'(A,B,I)) :- integer(I), !.
compile_op(rem(x(A),x(B),I), '$rem_c2'(A,B,I)) :- integer(I), !.
compile_op(rem(x(A),x(B),x(C)), '$rem'(A,B,C)).
compile_op(and(x(A),I,x(B)), '$land_c'(A,B,I)) :- integer(I), !.
compile_op(and(x(A),x(B),I), '$land_c'(A,B,I)) :- integer(I), !.
compile_op(and(x(A),x(B),x(C)), '$land'(A,B,C)).
compile_op(or(x(A),I,x(B)), '$lor_c'(A,B,I)) :- integer(I), !.
compile_op(or(x(A),x(B),I), '$lor_c'(A,B,I)) :- integer(I), !.
compile_op(or(x(A),x(B),x(C)), '$lor'(A,B,C)).
compile_op(xor(x(A),I,x(B)), '$xor_c'(A,B,I)) :- integer(I), !.
compile_op(xor(x(A),x(B),I), '$xor_c'(A,B,I)) :- integer(I), !.
compile_op(xor(x(A),x(B),x(C)), '$xor'(A,B,C)).
compile_op(uminus(x(A),x(B)), '$uminus'(A,B)).
compile_op(sr(x(A),I,x(B)), '$sr_c1'(A,B,I)) :- integer(I), !.
compile_op(sr(x(A),x(B),I), '$sr_c2'(A,B,I)) :- integer(I), !.
compile_op(sr(x(A),x(B),x(C)), '$sr'(A,B,C)).
compile_op(sl(x(A),I,x(B)), '$sl_c1'(A,B,I)) :- integer(I), !.
compile_op(sl(x(A),x(B),I), '$sl_c2'(A,B,I)) :- integer(I), !.
compile_op(sl(x(A),x(B),x(C)), '$sl'(A,B,C)).
/*
compile_op(zerop(x(A),Op), '$zerop'(A,Op)).
compile_op(exp(x(A),F,x(B)), exp_c(A,B,F)) :- float(F), !.
compile_op(exp(x(A),I,x(B)), exp_c(A,B,F)) :- integer(I), !, F is truncate(I).
compile_op(exp(x(A),x(B),F), exp_c(A,B,F)) :- float(F), !.