From: David S. W. <dw...@us...> - 2008-01-22 17:44:39
|
Update of /cvsroot/xsb/XSB/cmplib In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv31168 Modified Files: tp_cond.H tp_cond.P tp_cond.xwam tp_eval.H tp_eval.P tp_eval.xwam tpinline.H tpinline.P tpinline.xwam tprog.H tprog.P tprog.xwam Log Message: Simplify some arguments in some compilation predicates. Just a minor cleanup Index: tp_cond.H =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tp_cond.H,v retrieving revision 1.5 retrieving revision 1.6 diff -u -r1.5 -r1.6 --- tp_cond.H 28 Sep 2007 18:20:10 -0000 1.5 +++ tp_cond.H 22 Jan 2008 17:44:34 -0000 1.6 @@ -24,12 +24,12 @@ */ -:- export tcond/10, tvar_hold/3, force_tp_cond_loaded/0. +:- export tcond/9, tvar_hold/3, force_tp_cond_loaded/0. :- import gennum/1 from gensym. :- import vprag_type/2 from varproc. -:- import eval_relop/11, arithrelop/1 from tp_eval. -:- import geninl_load_lhs/7, geninline/10 from tpinline. +:- import eval_relop/10, arithrelop/1 from tp_eval. +:- import geninl_load_lhs/7, geninline/9 from tpinline. :- import term_comp_op/1, term_comp_tab/4 from tp_comp. :- import release_if_done0/5, getreg/2 from tp_var. :- import inline_jumpcof_cond/3 from builtin. Index: tp_cond.P =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tp_cond.P,v retrieving revision 1.8 retrieving revision 1.9 diff -u -r1.8 -r1.9 --- tp_cond.P 28 Sep 2007 18:20:10 -0000 1.8 +++ tp_cond.P 22 Jan 2008 17:44:34 -0000 1.9 @@ -57,32 +57,32 @@ /*======================================================================*/ /* tcond(+TestGoal, +SuccessLabel, +FailLabel, */ -/* -Pil-Pilr, +Tin, -Tout, +HoldRegs, +PredSym, +NC) */ +/* -Pil-Pilr, +Tin, -Tout, +HoldRegs, e(+PredSym,+NC)) */ /* Generates code for the test part of an 'if_then_else'. */ /*======================================================================*/ -tcond(and(Goal,Goals),SuccLab,FailLab,Pil,Pilr,Tin,Tout,Hold,PredSym,NC) :- +tcond(and(Goal,Goals),SuccLab,FailLab,Pil,Pilr,Tin,Tout,Hold,EPN) :- gennum(LabId), IntSuccLab = label(_,(disj,LabId)), tcond(Goal,IntSuccLab,FailLab,Pil,[IntSuccLab|Pilm], - Tin,Tmid,Hold,PredSym,NC), - tcond(Goals,SuccLab,FailLab,Pilm,Pilr,Tmid,Tout,Hold,PredSym,NC). -tcond(or(Goal,Goals),SuccLab,FailLab,Pil,Pilr,Tin,Tout,Hold,PredSym,NC) :- + Tin,Tmid,Hold,EPN), + tcond(Goals,SuccLab,FailLab,Pilm,Pilr,Tmid,Tout,Hold,EPN). +tcond(or(Goal,Goals),SuccLab,FailLab,Pil,Pilr,Tin,Tout,Hold,EPN) :- gennum(LabId), IntFailLab = label(_,(disj,LabId)), tcond(Goal,SuccLab,IntFailLab,Pil,[IntFailLab|Pilm], - Tin,Tmid,Hold,PredSym,NC), - tcond(Goals,SuccLab,FailLab,Pilm,Pilr,Tmid,Tout,Hold,PredSym,NC). + Tin,Tmid,Hold,EPN), + tcond(Goals,SuccLab,FailLab,Pilm,Pilr,Tmid,Tout,Hold,EPN). tcond(inlinegoal(Op,_,Args),SuccLab,FailLab, - Pil,Pilr,Tin,Tout,Hold,PredSym,NC) :- + Pil,Pilr,Tin,Tout,Hold,EPN) :- ( Args = [Arg1,Arg2], ( arithrelop(Op) -> tcond_relop(Op,Arg1,Arg2,SuccLab,FailLab, - Pil,Pilr,Tin,Tout,Hold,PredSym,NC) + Pil,Pilr,Tin,Tout,Hold,EPN) ; term_comp_op(Op) -> tcond_compop(Op,Arg1,Arg2,SuccLab,FailLab,Pil,Pilr,Tin,Tout,Hold) ; Op == '=' -> % these inlines are introduced by flattening - geninline(Op, Args, Hold, 0, Pil, Pilr, Tin, Tout, PredSym, NC) + geninline(Op, Args, Hold, 0, Pil, Pilr, Tin, Tout, EPN) ; Op == 'is' -> % these inlines are introduced by flattening - geninline(Op, Args, Hold, 0, Pil, Pilr, Tin, Tout, PredSym, NC) + geninline(Op, Args, Hold, 0, Pil, Pilr, Tin, Tout, EPN) ; Op == '@=' -> tcond_componfun(Op,Arg1,Arg2,SuccLab,FailLab,Pil,Pilr,Tin,Tout,Hold) ) @@ -93,10 +93,10 @@ ). tcond_relop(Op, Arg1, Arg2, SuccLab, FailLab, - Pil, Pilr, Tin, Tout, Hold, PredSym, NC) :- + Pil, Pilr, Tin, Tout, Hold, EPN) :- SuccLab = label(_,SL0), FailLab = label(_,FL0), eval_relop(Op, Arg1, Arg2, Hold, FL0, - Pil, [jump(SL0)|Pilr], Tin, Tout, PredSym, NC). + Pil, [jump(SL0)|Pilr], Tin, Tout, EPN). tcond_cof(BIT_Code,Arg,SuccLab,FailLab,Pil,Pilr,Tin,Tout,Hold) :- SuccLab = label(_,SL0), FailLab = label(_,FL0), Index: tp_cond.xwam =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tp_cond.xwam,v retrieving revision 1.17 retrieving revision 1.18 diff -u -r1.17 -r1.18 Binary files /tmp/cvsKR5fHI and /tmp/cvsQWxGA7 differ Index: tp_eval.H =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tp_eval.H,v retrieving revision 1.4 retrieving revision 1.5 diff -u -r1.4 -r1.5 --- tp_eval.H 14 Jan 2005 18:30:47 -0000 1.4 +++ tp_eval.H 22 Jan 2008 17:44:34 -0000 1.5 @@ -25,7 +25,7 @@ :- export force_tp_eval_loaded/0. -:- export eval_relop/11, eval_exp/9, arithrelop/1. +:- export eval_relop/10, eval_exp/8, arithrelop/1. :- import sym_name/3 from symtab. :- import error/1, message/1 from auxlry. Index: tp_eval.P =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tp_eval.P,v retrieving revision 1.8 retrieving revision 1.9 diff -u -r1.8 -r1.9 --- tp_eval.P 28 Oct 2007 23:29:06 -0000 1.8 +++ tp_eval.P 22 Jan 2008 17:44:35 -0000 1.9 @@ -25,24 +25,24 @@ -eval_relop(Op, Arg1, Arg2, HoldR, Label, Pil, Pilr, Tin, Tout, PredSym, NC) :- +eval_relop(Op, Arg1, Arg2, HoldR, Label, Pil, Pilr, Tin, Tout, EPN) :- ( int_eq(Op, Arg2, N) -> test_with_int(Op, Arg1, N, HoldR, Label, - Pil, Pilr, Tin, Tout, PredSym, NC) + Pil, Pilr, Tin, Tout, EPN) ; 'eval relop'(Op, Arg1, Arg2, HoldR, Label, - Pil, Pilr, Tin, Tout, PredSym, NC) + Pil, Pilr, Tin, Tout, EPN) ). -'eval relop'(Op, Arg1, Arg2, HoldR, Label, Pil, Pilr, Tin, Tout, PredSym, NC) :- - eval_exp(Arg1, R1, Pil, Pilm, HoldR, Tin, Tmid, PredSym, NC), +'eval relop'(Op, Arg1, Arg2, HoldR, Label, Pil, Pilr, Tin, Tout, EPN) :- + eval_exp(Arg1, R1, Pil, Pilm, HoldR, Tin, Tmid, EPN), eval_exp(Arg2, R2, Pilm,[subreg(R2,R1),JumpInst|Pilr], - HoldR, Tmid, Tout1, PredSym, NC), + HoldR, Tmid, Tout1, EPN), eval_arithreloptab(Op, R1, Label, JumpInst), release_if_done0(Arg1, R1, HoldR, Tout1, Tout2), release_if_done0(Arg2, R2, HoldR, Tout2, Tout). -test_with_int(Op, Arg1, N, HoldR, Label, Pil, Pilr, Tin, Tout, PredSym, NC) :- - eval_exp(Arg1, R1, Pil, [JumpInst|Pilr], HoldR, Tin, Tmid, PredSym, NC), +test_with_int(Op, Arg1, N, HoldR, Label, Pil, Pilr, Tin, Tout, EPN) :- + eval_exp(Arg1, R1, Pil, [JumpInst|Pilr], HoldR, Tin, Tmid, EPN), % ( N =:= 0 -> eval_arithreloptab(Op, R1, Label, JumpInst) eval_arithreloptab(Op, R1, N, Label, JumpInst), % ), @@ -53,7 +53,7 @@ /*======================================================================*/ /* eval_exp(+Term, -R, -Inst, -InstTail, #HoldRegs, +Tin,-Tout, */ -/* +PredSym, +NC) */ +/* e(+PredSym,+NC)) */ /* R is the register allocated for the result */ /* Generate code for an evaluable term. */ /* The code generated for different terms are listed below. */ @@ -75,54 +75,55 @@ /* ... ... */ /*======================================================================*/ -eval_exp(varocc(_,Prag),R,Pil,Pilr,_,Tin,Tout,PredSym,NC) :- - eval_var(Prag,R,Pil,Pilr,Tin,Tout,PredSym,NC). -eval_exp(integer(N),R,[Inst|Pil],Pil,_,Tin,Tout,_,_) :- +eval_exp(varocc(_,Prag),R,Pil,Pilr,_,Tin,Tout,EPN) :- + eval_var(Prag,R,Pil,Pilr,Tin,Tout,EPN). +eval_exp(integer(N),R,[Inst|Pil],Pil,_,Tin,Tout,_) :- getreg(Tin,R), hold(R,Tin,Tout), Inst = putnumcon(R,N). -eval_exp(real(N),R,[Inst|Pil],Pil,_,Tin,Tout,_,_) :- +eval_exp(real(N),R,[Inst|Pil],Pil,_,Tin,Tout,_) :- getreg(Tin,R), hold(R,Tin,Tout), Inst = putfloat(R,N). -eval_exp(structure(Sym,Args),R,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC) :- +eval_exp(structure(Sym,Args),R,Pil,Pilr,HoldR,Tin,Tout,EPN) :- sym_name(Sym, Op, Arity), ( Arity =:= 2 -> Args = [E1,E2], - eval_binop(Op,E1,E2,R,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC) + eval_binop(Op,E1,E2,R,Pil,Pilr,HoldR,Tin,Tout,EPN) ; Arity =:= 1 -> Args = [E], - eval_uniop(Op, E,R,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC) - ; sym_name(PredSym, P, A), + eval_uniop(Op, E,R,Pil,Pilr,HoldR,Tin,Tout,EPN) + ; EPN = e(PredSym,NC), + sym_name(PredSym, P, A), error(('Unknown function ', Op, '/', Arity, ' in an arithmetic expression')), message((' involving is/2 or =:=/2 in clause #', NC, ' of predicate ', P, '/', A)) ). -eval_exp(constant(Sym),R,[Inst|Pil],Pil,_,Tin,Tout,PredSym,NC) :- +eval_exp(constant(Sym),R,[Inst|Pil],Pil,_,Tin,Tout,e(PredSym,NC)) :- sym_name(PredSym, P, A), sym_name(Sym, Const, _), error(('non-numeric constant ', Const, ' in a numeric expression')), message((' in clause #', NC, ' of predicate ', P,'/',A)), Inst = fail, Tin = Tout, R = 0. -eval_exp(string(Sym),R,[Inst|Pil],Pil,_,Tin,Tout,PredSym,NC) :- +eval_exp(string(Sym),R,[Inst|Pil],Pil,_,Tin,Tout,e(PredSym,NC)) :- sym_name(PredSym, P, A), error(('non-numeric string ', Sym, ' in a numeric expression')), message((' in clause #', NC, ' of predicate ', P,'/',A)), Inst = fail, Tin = Tout, R = 0. -eval_uniop('+',E,R,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC) :- !, /* unary plus */ - eval_exp(E,R,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC). -eval_uniop('-',E,R,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC) :- !, /* unary minus */ +eval_uniop('+',E,R,Pil,Pilr,HoldR,Tin,Tout,EPN) :- !, /* unary plus */ + eval_exp(E,R,Pil,Pilr,HoldR,Tin,Tout,EPN). +eval_uniop('-',E,R,Pil,Pilr,HoldR,Tin,Tout,EPN) :- !, /* unary minus */ getreg(Tin,R), hold(R,Tin,Tmid1), Pil = [putnumcon(R,0)|Pilm], - eval_exp(E,R1,Pilm,[subreg(R1,R)|Pilr],HoldR,Tmid1,Tmid2,PredSym,NC), + eval_exp(E,R1,Pilm,[subreg(R1,R)|Pilr],HoldR,Tmid1,Tmid2,EPN), release(R,Tmid2,Tmid3), release_if_done0(E,R1,HoldR,Tmid3,Tout). -eval_uniop('\',E,R,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC) :- !, /* negation */ - eval_exp(E,R,Pil,[negate(R)|Pilr],HoldR,Tin,Tout,PredSym,NC). -eval_uniop(Op,E,R,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC) :- /* others */ +eval_uniop('\',E,R,Pil,Pilr,HoldR,Tin,Tout,EPN) :- !, /* negation */ + eval_exp(E,R,Pil,[negate(R)|Pilr],HoldR,Tin,Tout,EPN). +eval_uniop(Op,E,R,Pil,Pilr,HoldR,Tin,Tout,EPN) :- /* others */ builtin_function(Op, 1, Num), !, - eval_exp(E,R,Pil,[unifunc(Num,R)|Pilr],HoldR,Tin,Tout,PredSym,NC). -eval_uniop(Op,_,_,Pil,Pil,_,Tin,Tin,PredSym,NC) :- + eval_exp(E,R,Pil,[unifunc(Num,R)|Pilr],HoldR,Tin,Tout,EPN). +eval_uniop(Op,_,_,Pil,Pil,_,Tin,Tin,e(PredSym,NC)) :- sym_name(PredSym, P, A), error(('Unknown function ', Op, '/1 in an arithmetic expression')), message((' using is/2 in clause #', NC, ' of predicate ', P,'/',A)). @@ -172,38 +173,39 @@ eval_arithreloptab(=:=, R, N, Label, int_test_nz(R,N,Label)). eval_arithreloptab(=\=, R, N, Label, int_test_z(R,N,Label)). -eval_var(Prag,R,Pil,Pilr,Tin,Tout,PredSym,NC) :- +eval_var(Prag,R,Pil,Pilr,Tin,Tout,EPN) :- alloc_reg(Prag,Tin,Tmid), vprag_occ(Prag,Occ), ( ( Occ == s ; Occ == l) -> eval_numgetinst(Prag,R,Pil,Pilr,Tmid,Tout) - ; sym_name(PredSym, P, A), + ; EPN = e(PredSym,NC), + sym_name(PredSym, P, A), error('Unbound variable in an arithmetic expression'), message((' (in clause #', NC, ' of predicate ', P, '/', A, ')')), Pil = [fail|Pilr], R = 0, Tmid = Tout ). -eval_binop(Op,E1,E2,R1,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC) :- +eval_binop(Op,E1,E2,R1,Pil,Pilr,HoldR,Tin,Tout,EPN) :- eval_binop(Op), - eval_exp(E1,R1,Pil,Pilm,HoldR,Tin,Tmid1,PredSym,NC), - eval_exp(E2,R2,Pilm,[Inst|Pilr],HoldR,Tmid1,Tmid2,PredSym,NC), + eval_exp(E1,R1,Pil,Pilm,HoldR,Tin,Tmid1,EPN), + eval_exp(E2,R2,Pilm,[Inst|Pilr],HoldR,Tmid1,Tmid2,EPN), eval_binoptab(Op,R1,R2,Inst), release_if_done0(E2,R2,HoldR,Tmid2,Tout). -eval_binop(rem,E1,E2,R,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC) :- - eval_exp(E1,R0,Pil,Pilm0,HoldR,Tin,Tmid,PredSym,NC), - eval_exp(E2,R1,Pilm0,Pilm1,HoldR,Tmid,Tmid1,PredSym,NC), +eval_binop(rem,E1,E2,R,Pil,Pilr,HoldR,Tin,Tout,EPN) :- + eval_exp(E1,R0,Pil,Pilm0,HoldR,Tin,Tmid,EPN), + eval_exp(E2,R1,Pilm0,Pilm1,HoldR,Tmid,Tmid1,EPN), getreg(Tmid1,R), Pilm1 = [movreg(R0,R),idivreg(R1,R0),mulreg(R1,R0),subreg(R0,R)|Pilr], release_if_done0(E1,R0,HoldR,Tmid1,Tmid2), release_if_done0(E2,R1,HoldR,Tmid2,Tout). -eval_binop(mod,E1,E2,R,Pil,Pilr,HoldR,Tin,Tout,PredSym,NC) :- - eval_exp(E1,R0,Pil,Pilm0,HoldR,Tin,Tmid,PredSym,NC), - eval_exp(E2,R1,Pilm0,Pilm1,HoldR,Tmid,Tmid1,PredSym,NC), +eval_binop(mod,E1,E2,R,Pil,Pilr,HoldR,Tin,Tout,EPN) :- + eval_exp(E1,R0,Pil,Pilm0,HoldR,Tin,Tmid,EPN), + eval_exp(E2,R1,Pilm0,Pilm1,HoldR,Tmid,Tmid1,EPN), getreg(Tmid1,R), Pilm1 = [movreg(R0,R),divreg(R1,R0),unifunc(14,R0), mulreg(R1,R0),subreg(R0,R)|Pilr], release_if_done0(E1,R0,HoldR,Tmid1,Tmid2), release_if_done0(E2,R1,HoldR,Tmid2,Tout). -eval_binop(Op,_,_,_,Pil,Pil,_,Tin,Tin,PredSym,NC) :- +eval_binop(Op,_,_,_,Pil,Pil,_,Tin,Tin,e(PredSym,NC)) :- sym_name(PredSym, P, A), error(('Unknown function ', Op, '/2 in an arithmetic expression')), message((' using is/2 in clause #', NC, ' of predicate ', P,'/',A)). Index: tp_eval.xwam =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tp_eval.xwam,v retrieving revision 1.19 retrieving revision 1.20 diff -u -r1.19 -r1.20 Binary files /tmp/cvsX0OVGY and /tmp/cvsNZVpYn differ Index: tpinline.H =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tpinline.H,v retrieving revision 1.5 retrieving revision 1.6 diff -u -r1.5 -r1.6 --- tpinline.H 28 Sep 2007 18:20:10 -0000 1.5 +++ tpinline.H 22 Jan 2008 17:44:35 -0000 1.6 @@ -26,7 +26,7 @@ :- export force_tp_geninline_loaded/0. -:- export geninline/10, geninl_load_lhs/7. +:- export geninline/9, geninl_load_lhs/7. :- import sym_name/3 from symtab. :- import error/1, message/1 from auxlry. @@ -34,7 +34,7 @@ :- import tgetpar/6, tputpar/7 from tp_goal. :- import term_comp_op/1, term_comp_tab/4 from tp_comp. :- import vprag_occ/2, vprag_loc/2, vprag_type/2 from varproc. -:- import arithrelop/1, eval_exp/9, eval_relop/11 from tp_eval. +:- import arithrelop/1, eval_exp/8, eval_relop/10 from tp_eval. :- import release/3, alloc_reg/3, release_if_done/6, hold/3, getreg/2, putvarinst/5 from tp_var. Index: tpinline.P =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tpinline.P,v retrieving revision 1.11 retrieving revision 1.12 diff -u -r1.11 -r1.12 --- tpinline.P 28 Sep 2007 18:20:11 -0000 1.11 +++ tpinline.P 22 Jan 2008 17:44:35 -0000 1.12 @@ -26,30 +26,30 @@ /*======================================================================*/ /* geninline(+Pname, +Args, +HoldRegs, +ARSize, -Pil, -PilRest, +Tin, */ -/* -Tout, +PredSym, +NC) */ +/* -Tout, e(+PredSym,+NC)) */ /* Generate code for inline predicates. */ /* + Args: in intermediate program format. */ /* - Pil-PilRest: pil code generated, as a differential */ /* list. */ /*======================================================================*/ -geninline(true, [], _, _, Pil, Pil, T, T, _, _). -geninline(fail, [], _, _, [fail|Pil], Pil, T, T, _, _). -geninline(halt, [], _, _, [halt|Pilr], Pilr, T, T, _, _). +geninline(true, [], _, _, Pil, Pil, T, T, _). +geninline(fail, [], _, _, [fail|Pil], Pil, T, T, _). +geninline(halt, [], _, _, [halt|Pilr], Pilr, T, T, _). -geninline('_$builtin', [integer(N)], _, _, [builtin(N)|Pilr], Pilr, T, T, _, _). -geninline('_$savecp', [Arg], _, _, Pil, Pilr, Tin, Tout, _, _) :- +geninline('_$builtin', [integer(N)], _, _, [builtin(N)|Pilr], Pilr, T, T, _). +geninline('_$savecp', [Arg], _, _, Pil, Pilr, Tin, Tout, _) :- geninline_savecp(Arg, Pil, Pilr, Tin, Tout). -geninline('_$cutto', [Arg], HoldR, ARSize, Pil, Pilr, Tin, Tout, _, _) :- +geninline('_$cutto', [Arg], HoldR, ARSize, Pil, Pilr, Tin, Tout, _) :- geninline_cutto(Arg, HoldR, ARSize, Pil, Pilr, Tin, Tout). -geninline(is, [Arg1,Arg2], HoldR, _, Pil, Pilr, Tin, Tout, PredSym, NC) :- - geninline_is(Arg1, Arg2, HoldR, Pil, Pilr, Tin, Tout, PredSym, NC). -geninline(@=, [Arg1,Arg2], _HoldR, _, Pil, Pilr, Tin, Tout, _PredSym, _NC) :- +geninline(is, [Arg1,Arg2], HoldR, _, Pil, Pilr, Tin, Tout, EPN) :- + geninline_is(Arg1, Arg2, HoldR, Pil, Pilr, Tin, Tout, EPN). +geninline(@=, [Arg1,Arg2], _HoldR, _, Pil, Pilr, Tin, Tout, _EPN) :- geninl_load_lhs(Arg1, R1, Pil, Pilm, Tin, Tmid, _), geninl_load_lhs(Arg2, R2, Pilm, [fun_test_ne(R1,R2,abs(-1))|Pilr], Tmid, Tout, _). -geninline(=, [Lhs,Rhs], HoldR, _, Pil, Pilr, Tin, Tout, _, _) :- +geninline(=, [Lhs,Rhs], HoldR, _, Pil, Pilr, Tin, Tout, _) :- (if_void_var(Lhs),if_void_var(Rhs) -> Pilr = Pil, Tout = Tin ; geninl_load_lhs(Lhs, R, Pil, Pil1, Tin, Tmid0, SaveReg), @@ -61,12 +61,12 @@ ), geninl_unload_lhs(Lhs, R, HoldR, Tmid3, Tout) ). -geninline(Op, [Arg1,Arg2], HoldR, _, Pil, Pilr, Tin, Tout, PredSym, NC) :- +geninline(Op, [Arg1,Arg2], HoldR, _, Pil, Pilr, Tin, Tout, EPN) :- arithrelop(Op), !, eval_relop(Op, Arg1, Arg2, HoldR, abs(-1), - Pil, Pilr, Tin, Tout, PredSym, NC). -geninline(TermCompOp, [Arg1,Arg2], HoldR, _, Pil, Pilr, Tin, Tout, _, _) :- + Pil, Pilr, Tin, Tout, EPN). +geninline(TermCompOp, [Arg1,Arg2], HoldR, _, Pil, Pilr, Tin, Tout, _) :- term_comp_op(TermCompOp), !, geninl_load_lhs(Arg1, R1, Pil, Pilm, Tin, Tmid, _), geninl_load_lhs(Arg2, R2, Pilm, @@ -76,7 +76,7 @@ geninl_unload_lhs(Arg1, R1, HoldR, Tout1, Tout2), geninl_unload_lhs(Arg2, R2, HoldR, Tout2, Tout). :- import inline_jumpcof_cond/3 from builtin. -geninline(Cof, [Arg], HoldR, _, Pil, Pilr, Tin, Tout, _PredSym, _NC) :- +geninline(Cof, [Arg], HoldR, _, Pil, Pilr, Tin, Tout, _EPN) :- inline_jumpcof_cond(Cof,1,CofNum), !, geninl_load_lhs(Arg, R, Pil, [jumpcof(CofNum,R,abs(-1))|Pilr], Tin, Tmid, _), @@ -121,24 +121,25 @@ /*======================================================================*/ /*======================================================================*/ -geninline_is(LHS,Exp,HoldR,Pil,Pilr,Tin,Tout,PredSym,NC) :- +geninline_is(LHS,Exp,HoldR,Pil,Pilr,Tin,Tout,EPN) :- ( LHS = varocc(_Vid,_Prag) -> - eval_exp(Exp,R,Pil,Pilm,HoldR,Tin,Tout1,PredSym,NC), + eval_exp(Exp,R,Pil,Pilm,HoldR,Tin,Tout1,EPN), release_if_tvar_if_done(LHS,R,HoldR,Tout1,Tout2), tgetpar(LHS,R,Pilm,Pilr,Tout2,Tout) ; LHS = integer(Int) -> getreg(Tin, R1), hold(R1, Tin, Tmid), Pil = [putnumcon(R1,Int)|Pil1], eval_exp(Exp,R,Pil1,[subreg(R,R1),jumpnz(R1,abs(-1))|Pilr], - HoldR,Tmid,Tout1,PredSym,NC), + HoldR,Tmid,Tout1,EPN), release(R1,Tout1,Tout2), release(R,Tout2,Tout) ; LHS = real(Real) -> getreg(Tin, R1), hold(R1, Tin, Tmid), Pil = [putfloat(R1,Real)|Pil1], eval_exp(Exp,R,Pil1,[subreg(R,R1),jumpnz(R1,abs(-1))|Pilr], - HoldR,Tmid,Tout1,PredSym,NC), + HoldR,Tmid,Tout1,EPN), release(R1,Tout1,Tout2), release(R,Tout2,Tout) - ; sym_name(PredSym, P, A), + ; EPN = e(PredSym,NC), + sym_name(PredSym, P, A), error('variable or numerical constant expected as 1st arg of is/2'), message((' in clause #', NC, ' of predicate ', P,'/',A)), Pil = [fail | Pilr], Tin = Tout Index: tpinline.xwam =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tpinline.xwam,v retrieving revision 1.22 retrieving revision 1.23 diff -u -r1.22 -r1.23 Binary files /tmp/cvscjYVjd and /tmp/cvst3RrZC differ Index: tprog.H =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tprog.H,v retrieving revision 1.8 retrieving revision 1.9 diff -u -r1.8 -r1.9 --- tprog.H 28 Sep 2007 18:20:11 -0000 1.8 +++ tprog.H 22 Jan 2008 17:44:35 -0000 1.9 @@ -32,10 +32,10 @@ :- import merge/3 from listutil. :- import flatten/2 from flatten. :- import gennum/1 from gensym. -:- import geninline/10 from tpinline. +:- import geninline/9 from tpinline. :- import inline_builtin/3 from builtin. :- import release/3, reserve/3 from tp_var. -:- import tcond/10, tvar_hold/3 from tp_cond. +:- import tcond/9, tvar_hold/3 from tp_cond. :- import sym_name/3, sym_type/2 from symtab. :- import tgetpar/6, tgoalargs/7 from tp_goal. Index: tprog.P =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tprog.P,v retrieving revision 1.21 retrieving revision 1.22 diff -u -r1.21 -r1.22 --- tprog.P 28 Sep 2007 18:20:11 -0000 1.21 +++ tprog.P 22 Jan 2008 17:44:35 -0000 1.22 @@ -61,7 +61,7 @@ ), theadpars(Args,1,Pil1,Pil3,Tin,TRegs), tbody(Body,ARSize1,Pil3,Pilr,TRegs,_,lastgoal,no, - [],Tabled,Tabar,Sym,NC). + [],Tabled,Tabar,e(Sym,NC)). %:- import telling/1, tell/1, write/1, nl/0, told/0 from standard. @@ -123,7 +123,7 @@ /*======================================================================*/ /* tbody(+Goal, +ARSize, Pil-Pilr, +Tin, -Tout, */ -/* +Meet, +Nested, +HoldRegs, +Sym, +NC) */ +/* +Meet, +Nested, +HoldRegs, e(+Sym,+NC)) */ /* Tin, Tout: the registers in use at the entry and at the exit. */ /* Meet: When processing the nested or-branches, this is the label */ /* to meet. It can be also "lastgoal", in which case all */ @@ -134,12 +134,12 @@ /* if "yes", this would be a nested or-branch. */ /*======================================================================*/ -tbody(and(Goal,Goals),A,Pil,Pilr,Tin,Tout,Meet,_,HoldRegs,Tabled,Tabar,Sym,NC) :- - tbody(Goal,A,Pil,Pil1,Tin,Tmid,midgoal,no,HoldRegs,Tabled,Tabar,Sym,NC), +tbody(and(Goal,Goals),A,Pil,Pilr,Tin,Tout,Meet,_,HoldRegs,Tabled,Tabar,EPN) :- + tbody(Goal,A,Pil,Pil1,Tin,Tmid,midgoal,no,HoldRegs,Tabled,Tabar,EPN), !, - tbody(Goals,A,Pil1,Pilr,Tmid,Tout,Meet,no,HoldRegs,Tabled,Tabar,Sym,NC), + tbody(Goals,A,Pil1,Pilr,Tmid,Tout,Meet,no,HoldRegs,Tabled,Tabar,EPN), !. -tbody(or(Goal,Goals),A,Pil,Pilr,Tin,[],Meet,Nested,HoldRegs,Tabled,Tabar,Sym,NC) :- +tbody(or(Goal,Goals),A,Pil,Pilr,Tin,[],Meet,Nested,HoldRegs,Tabled,Tabar,EPN) :- ( Nested == no -> Pil = [trymeorelse(A,Label2)|Pil1], ( Meet == lastgoal -> ThisMeet = Meet, Pil5 = Pilr @@ -149,24 +149,24 @@ ; Pil = [retrymeorelse(A,Label2)|Pil1], Pil5 = Pilr, ThisMeet = Meet ), - tbody(Goal,A, Pil1,Pil2,Tin,_,Meet,no,HoldRegs,Tabled,Tabar,Sym,NC), + tbody(Goal,A, Pil1,Pil2,Tin,_,Meet,no,HoldRegs,Tabled,Tabar,EPN), gennum(LabId2), Label2 = (disj,LabId2), ( Meet == lastgoal -> Pil2 = [label(disj,Label2)|Pil3] ; Pil2 = [jump(ThisMeet),label(disj,Label2)|Pil3] ), ( more_branches(Goals) -> Pil3=Pil4 ; Pil3 = [trustmeorelsefail(A)|Pil4] ), - tbody(Goals,A,Pil4,Pil5,Tin,_,ThisMeet,yes,HoldRegs,Tabled,Tabar,Sym,NC). + tbody(Goals,A,Pil4,Pil5,Tin,_,ThisMeet,yes,HoldRegs,Tabled,Tabar,EPN). tbody(if_then_else(inlinegoal(fail,0,[]),_,FGoal),A,Pil,Pilr,Tin,Tout,M,N, - HoldRegs,Tabled,Tabar,Sym,NC) :- !, % to handle test of fail - tbody(FGoal,A,Pil,Pilr,Tin,Tout,M,N,HoldRegs,Tabled,Tabar,Sym,NC). + HoldRegs,Tabled,Tabar,EPN) :- !, % to handle test of fail + tbody(FGoal,A,Pil,Pilr,Tin,Tout,M,N,HoldRegs,Tabled,Tabar,EPN). tbody(if_then_else(Test,TGoal,FGoal),A,Pil,Pilr,Tin,Tout,M,_, - HoldRegs0,Tabled,Tabar,Sym,NC) :- + HoldRegs0,Tabled,Tabar,EPN) :- gennum(TLabId), TLabel = label(then,(disj,TLabId)), gennum(FLabId), FLabel = label(else,(disj,FLabId)), tvar_hold(Test, HoldRegs0, HoldRegs1), - tcond(Test,TLabel,FLabel,Pil,[TLabel|Pil1],Tin,Tmid,HoldRegs1,Sym,NC), - tbody(TGoal,A,Pil1,Pil2,Tmid,Tout0,M,no,HoldRegs1,Tabled,Tabar,Sym,NC), + tcond(Test,TLabel,FLabel,Pil,[TLabel|Pil1],Tin,Tmid,HoldRegs1,EPN), + tbody(TGoal,A,Pil1,Pil2,Tmid,Tout0,M,no,HoldRegs1,Tabled,Tabar,EPN), ( M == lastgoal -> Pil2 = [FLabel|Pil3], Pil4 = Pilr ; Pil2 = [jump(ThisMeet),FLabel|Pil3], @@ -174,14 +174,14 @@ Pil4 = [label(meet, ThisMeet)|Pilr] ), merge(Tmid,Tout0,Tout1), - tbody(FGoal,A,Pil3,Pil4,Tout1,Tout2,M,no,HoldRegs0,Tabled,Tabar,Sym,NC), + tbody(FGoal,A,Pil3,Pil4,Tout1,Tout2,M,no,HoldRegs0,Tabled,Tabar,EPN), /* tvar may be in */ merge(Tout1,Tout2,Tout), !. /* branches of an i-t-e */ -tbody(nil,_,Pil,Pilr,T,T,_,_,_,Tabled,Tabar,Sym,_) :- +tbody(nil,_,Pil,Pilr,T,T,_,_,_,Tabled,Tabar,EPN) :- ( Tabled =:= 0 -> Pil = [proceed|Pilr] - ; Pil = [check_interrupt(Sym,3), new_answer_dealloc(Tabar,2)|Pilr] + ; EPN=e(Sym,_),Pil = [check_interrupt(Sym,3), new_answer_dealloc(Tabar,2)|Pilr] ). -tbody(goal(Sym,Args),A,Pil,Pilr,Tin,Tout,Meet,_,_HoldRegs,Tabled,Tabar,_,_) :- +tbody(goal(Sym,Args),A,Pil,Pilr,Tin,Tout,Meet,_,_HoldRegs,Tabled,Tabar,_) :- sym_name(Sym, Pred, Arity), reserve(Arity,Tin,T1), Tout = [], tgoalargs(Args,1,Pil,Pil1,T1,_,Tabled), @@ -206,11 +206,12 @@ !. tbody(inlinegoal(Pred,_Ar,Args),A,Pil,Pilr,Tin,Tout,Meet,_,HoldRegs, - Tabled,Tabar,Sym,NC) :- - geninline(Pred,Args,HoldRegs,A,Pil,Pil1,Tin,Tout,Sym,NC), + Tabled,Tabar,EPN) :- + geninline(Pred,Args,HoldRegs,A,Pil,Pil1,Tin,Tout,EPN), ( Meet == lastgoal -> ( Tabled =:= 1 -> /* if tabled = 1, A>0 */ A1 is A-1, + EPN = e(Sym,_), Pil1 = [check_interrupt(Sym,A), new_answer_dealloc(Tabar,A1)|Pilr] ; ( A > 0 -> Pil1 = [deallocate,proceed_gc|Pilr] Index: tprog.xwam =================================================================== RCS file: /cvsroot/xsb/XSB/cmplib/tprog.xwam,v retrieving revision 1.19 retrieving revision 1.20 diff -u -r1.19 -r1.20 Binary files /tmp/cvsEnyGPp and /tmp/cvs7zPdUP differ |