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

Inline arg

Browse Source 
IO fixes


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@12 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2001-04-20 15:48:04 +00:00
parent f80b0b1d32
commit 3f5f0c6d4b
12 changed files with 447 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

308
C/absmi.c
View File

@ -9731,13 +9731,17 @@ absmi(int inp)
ENDD(d0);
ENDOp();
Op(p_arg, e);
Op(p_arg_vv, xxx);
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace)
low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("arg"),3)),XREGS+1);
if (do_low_level_trace) {
H[0] = XREG(PREG->u.xxx.x1);
H[1] = XREG(PREG->u.xxx.x2);
RESET_VARIABLE(H+2);
low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("arg"),3)),H);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
d0 = ARG1;
d0 = XREG(PREG->u.xxx.x1);
deref_head(d0, arg_arg1_unk);
arg_arg1_nvar:
/* ARG1 is ok! */
@ -9752,7 +9756,7 @@ absmi(int inp)
/* d0 now got the argument we want */
BEGD(d1);
d1 = ARG2;
d1 = XREG(PREG->u.xxx.x2);
deref_head(d1, arg_arg2_unk);
arg_arg2_nvar:
/* d1 now got the structure we want to fetch the argument
@ -9764,10 +9768,8 @@ absmi(int inp)
if (IsExtensionFunctor((Functor) d1)) {
FAIL();
}
save_hb();
if ((Int)d0 <= 0 ||
d0 > ArityOfFunctor((Functor) d1) ||
IUnify((CELL)(pt0+d0), ARG3) == FALSE) {
d0 > ArityOfFunctor((Functor) d1)) {
/* don't complain here for Prolog compatibility
if ((Int)d0 <= 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
@ -9776,35 +9778,24 @@ absmi(int inp)
*/
FAIL();
}
PREG = NEXTOP(PREG, e);
XREG(PREG->u.xxx.x) = pt0[d0];
PREG = NEXTOP(PREG, xxx);
GONext();
ENDP(pt0);
}
else if (IsPairTerm(d1)) {
BEGP(pt0);
pt0 = RepPair(d1);
if (d0 == 1) {
save_hb();
if (IUnify((CELL)pt0, ARG3) == FALSE) {
FAIL();
}
PREG = NEXTOP(PREG, e);
GONext();
}
else if (d0 == 2) {
save_hb();
if (IUnify((CELL)(pt0+1), ARG3) == FALSE) {
FAIL();
}
PREG = NEXTOP(PREG, e);
GONext();
}
else {
if ((Int)d0 < 0)
if (d0 != 1 && d0 != 2) {
if ((Int)d0 < 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
MkIntegerTerm(d0),"arg 1 of arg/3");
MkIntegerTerm(d0),"arg 1 of arg/3");
}
FAIL();
}
XREG(PREG->u.xxx.x) = pt0[d0-1];
PREG = NEXTOP(PREG, xxx);
GONext();
ENDP(pt0);
}
else {
@ -9827,6 +9818,267 @@ absmi(int inp)
ENDD(d0);
ENDOp();
Op(p_arg_cv, xxc);
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace) {
CELL *Ho = H;
Term t = MkIntegerTerm(PREG->u.xxc.c);
H[0] = t;
H[1] = XREG(PREG->u.xxc.xi);
RESET_VARIABLE(H+2);
low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("arg"),3)),H);
H = Ho;
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
d0 = PREG->u.xxc.c;
/* d0 now got the argument we want */
BEGD(d1);
d1 = XREG(PREG->u.xxc.xi);
deref_head(d1, arg_arg2_vc_unk);
arg_arg2_vc_nvar:
/* d1 now got the structure we want to fetch the argument
* from */
if (IsApplTerm(d1)) {
BEGP(pt0);
pt0 = RepAppl(d1);
d1 = *pt0;
if (IsExtensionFunctor((Functor) d1)) {
FAIL();
}
if ((Int)d0 <= 0 ||
d0 > ArityOfFunctor((Functor) d1)) {
/* don't complain here for Prolog compatibility
if ((Int)d0 <= 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
MkIntegerTerm(d0),"arg 1 of arg/3");
}
*/
FAIL();
}
XREG(PREG->u.xxc.x) = pt0[d0];
PREG = NEXTOP(PREG, xxc);
GONext();
ENDP(pt0);
}
else if (IsPairTerm(d1)) {
BEGP(pt0);
pt0 = RepPair(d1);
if (d0 != 1 && d0 != 2) {
if ((Int)d0 < 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
MkIntegerTerm(d0),"arg 1 of arg/3");
}
FAIL();
}
XREG(PREG->u.xxc.x) = pt0[d0-1];
PREG = NEXTOP(PREG, xxc);
GONext();
ENDP(pt0);
}
else {
Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
FAIL();
}
BEGP(pt0);
deref_body(d1, pt0, arg_arg2_vc_unk, arg_arg2_vc_nvar);
Error(INSTANTIATION_ERROR, d1,"arg 2 of arg/3");;
ENDP(pt0);
FAIL();
ENDD(d1);
ENDD(d0);
ENDOp();
Op(p_arg_y_vv, yxx);
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace) {
H[0] = XREG(PREG->u.yxx.x1);
H[1] = XREG(PREG->u.yxx.x2);
RESET_VARIABLE(H+2);
low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("arg"),3)),H);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
d0 = XREG(PREG->u.yxx.x1);
deref_head(d0, arg_y_arg1_unk);
arg_y_arg1_nvar:
/* ARG1 is ok! */
if (IsIntTerm(d0))
d0 = IntOfTerm(d0);
else if (IsLongIntTerm(d0)) {
d0 = LongIntOfTerm(d0);
} else {
Error(TYPE_ERROR_INTEGER,d0,"arg 1 of arg/3");
FAIL();
}
/* d0 now got the argument we want */
BEGD(d1);
d1 = XREG(PREG->u.yxx.x2);
deref_head(d1, arg_y_arg2_unk);
arg_y_arg2_nvar:
/* d1 now got the structure we want to fetch the argument
* from */
if (IsApplTerm(d1)) {
BEGP(pt0);
pt0 = RepAppl(d1);
d1 = *pt0;
if (IsExtensionFunctor((Functor) d1)) {
FAIL();
}
if ((Int)d0 <= 0 ||
d0 > ArityOfFunctor((Functor) d1)) {
/* don't complain here for Prolog compatibility
if ((Int)d0 <= 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
MkIntegerTerm(d0),"arg 1 of arg/3");
}
*/
FAIL();
}
BEGP(pt1);
pt1 = Y + PREG->u.yxx.y;
PREG = NEXTOP(PREG, yxx);
#if defined(SBA) && defined(FROZEN_REGS)
Bind_Local(pt1,pt0[d0]);
#else
*pt1 = pt0[d0];
#endif
ENDP(pt1);
GONext();
ENDP(pt0);
}
else if (IsPairTerm(d1)) {
BEGP(pt0);
pt0 = RepPair(d1);
if (d0 != 1 && d0 != 2) {
if ((Int)d0 < 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
MkIntegerTerm(d0),"arg 1 of arg/3");
}
FAIL();
}
BEGP(pt1);
pt1 = Y + PREG->u.yxx.y;
PREG = NEXTOP(PREG, yxx);
#if defined(SBA) && defined(FROZEN_REGS)
Bind_Local(pt1,pt0[d0-1]);
#else
*pt1 = pt0[d0-1];
#endif
GONext();
ENDP(pt1);
ENDP(pt0);
}
else {
Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
FAIL();
}
BEGP(pt0);
deref_body(d1, pt0, arg_y_arg2_unk, arg_y_arg2_nvar);
Error(INSTANTIATION_ERROR, d1,"arg 2 of arg/3");;
ENDP(pt0);
FAIL();
ENDD(d1);
BEGP(pt0);
deref_body(d0, pt0, arg_y_arg1_unk, arg_y_arg1_nvar);
Error(INSTANTIATION_ERROR, d0, "arg 1 of arg/3");;
ENDP(pt0);
FAIL();
ENDD(d0);
ENDOp();
Op(p_arg_y_cv, xxc);
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace) {
CELL *Ho = H;
Term t = MkIntegerTerm(PREG->u.yxc.c);
H[0] = t;
H[1] = XREG(PREG->u.yxc.xi);
RESET_VARIABLE(H+2);
low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("arg"),3)),H);
H = Ho;
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
d0 = PREG->u.yxc.c;
/* d0 now got the argument we want */
BEGD(d1);
d1 = XREG(PREG->u.yxc.xi);
deref_head(d1, arg_y_arg2_vc_unk);
arg_y_arg2_vc_nvar:
/* d1 now got the structure we want to fetch the argument
* from */
if (IsApplTerm(d1)) {
BEGP(pt0);
pt0 = RepAppl(d1);
d1 = *pt0;
if (IsExtensionFunctor((Functor) d1)) {
FAIL();
}
if ((Int)d0 <= 0 ||
d0 > ArityOfFunctor((Functor) d1)) {
/* don't complain here for Prolog compatibility
if ((Int)d0 <= 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
MkIntegerTerm(d0),"arg 1 of arg/3");
}
*/
FAIL();
}
BEGP(pt1);
pt1 = Y + PREG->u.yxc.y;
PREG = NEXTOP(PREG, yxc);
#if defined(SBA) && defined(FROZEN_REGS)
Bind_Local(pt1,pt0[d0]);
#else
*pt1 = pt0[d0];
#endif
ENDP(pt1);
GONext();
ENDP(pt0);
}
else if (IsPairTerm(d1)) {
BEGP(pt0);
pt0 = RepPair(d1);
if (d0 != 1 && d0 != 2) {
if ((Int)d0 < 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
MkIntegerTerm(d0),"arg 1 of arg/3");
}
FAIL();
}
BEGP(pt1);
pt1 = Y + PREG->u.yxc.y;
PREG = NEXTOP(PREG, yxc);
#if defined(SBA) && defined(FROZEN_REGS)
Bind_Local(pt1,pt0[d0-1]);
#else
*pt1 = pt0[d0-1];
#endif
ENDP(pt1);
GONext();
ENDP(pt0);
}
else {
Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
FAIL();
}
BEGP(pt0);
deref_body(d1, pt0, arg_y_arg2_vc_unk, arg_y_arg2_vc_nvar);
Error(INSTANTIATION_ERROR, d1,"arg 2 of arg/3");;
ENDP(pt0);
FAIL();
ENDD(d1);
ENDD(d0);
ENDOp();
Op(p_functor, e);
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace)

25
C/amasm.c
View File

@ -722,9 +722,6 @@ a_p(op_numbers opcode)
case _eq:
op = _p_eq;
break;
case _arg:
op = _p_arg;
break;
case _functor:
op = _p_functor;
break;
@ -1641,6 +1638,9 @@ a_f2(int var)
case _slr:
code_p->opc = emit_op(_p_slr_y_vv);
break;
case _arg:
code_p->opc = emit_op(_p_arg_y_vv);
break;
}
code_p->u.yxx.y = emit_y(ve);
code_p->u.yxx.x1 = x1_arg;
@ -1687,6 +1687,9 @@ a_f2(int var)
save_machine_regs();
longjmp(CompilerBotch, 1);
break;
case _arg:
code_p->opc = emit_op(_p_arg_y_cv);
break;
}
code_p->u.ycx.y = emit_y(ve);
code_p->u.ycx.c = c_arg;
@ -1723,6 +1726,11 @@ a_f2(int var)
case _slr:
code_p->opc = emit_op(_p_slr_y_vc);
break;
case _arg:
Error(SYSTEM_ERROR, x2_arg, "internal assembler error for arg/3");
save_machine_regs();
longjmp(CompilerBotch, 1);
break;
}
code_p->u.yxc.y = emit_y(ve);
code_p->u.yxc.c = c_arg;
@ -1760,6 +1768,9 @@ a_f2(int var)
case _slr:
code_p->opc = emit_op(_p_slr_vv);
break;
case _arg:
code_p->opc = emit_op(_p_arg_vv);
break;
}
code_p->u.xxx.x = emit_x(ve->NoOfVE & MaskVarAdrs);
code_p->u.xxx.x1 = x1_arg;
@ -1802,6 +1813,9 @@ a_f2(int var)
case _slr:
code_p->opc = emit_op(_p_slr_cv);
break;
case _arg:
code_p->opc = emit_op(_p_arg_cv);
break;
}
code_p->u.xxc.x = emit_x(ve->NoOfVE & MaskVarAdrs);
code_p->u.xxc.c = c_arg;
@ -1838,6 +1852,11 @@ a_f2(int var)
case _slr:
code_p->opc = emit_op(_p_slr_vc);
break;
case _arg:
Error(SYSTEM_ERROR, x2_arg, "internal assembler error for arg/3");
save_machine_regs();
longjmp(CompilerBotch, 1);
break;
}
code_p->u.xcx.x = emit_x(ve->NoOfVE & MaskVarAdrs);
code_p->u.xcx.c = c_arg;

116
C/compiler.c
View File

@ -741,7 +741,16 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
}
} else {
/* it has to be either an integer or a floating point */
if (IsIntTerm(t2)) {
if (Op == _arg) {
Term tn = MkVarTerm();
Int v1 = --tmpreg;
Int v2 = --tmpreg;
c_arg(t2, v2, 0);
emit(fetch_args_vv_op, Zero, Zero);
/* these should be the arguments */
c_var(t1, v1, 0);
c_var(tn, v2, 0);
} else if (IsIntTerm(t2)) {
/* first temp */
Int v1 = --tmpreg;
emit(fetch_args_vc_op, (CELL)IntOfTerm(t2), Zero);
@ -758,7 +767,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
} else {
char s[32];
Error_TYPE = TYPE_ERROR_VARIABLE;
Error_TYPE = TYPE_ERROR_NUMBER;
Error_Term = t2;
ErrorMessage = ErrorSay;
bip_name(Op, s);
@ -782,15 +791,64 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
longjmp(CompilerBotch,1);
}
} else {
char s[32];
if (Op == _arg) {
Int i1;
if (IsIntegerTerm(t1))
i1 = IntegerOfTerm(t1);
else {
char s[32];
Error_TYPE = TYPE_ERROR_INTEGER;
Error_Term = t2;
ErrorMessage = ErrorSay;
bip_name(Op, s);
sprintf(ErrorMessage, "compiling %s/2", s);
save_machine_regs();
longjmp(CompilerBotch,1);
Error_TYPE = TYPE_ERROR_INTEGER;
Error_Term = t2;
ErrorMessage = ErrorSay;
bip_name(Op, s);
sprintf(ErrorMessage, "compiling %s/2", s);
save_machine_regs();
longjmp(CompilerBotch,1);
}
if (IsAtomicTerm(t2) ||
(IsApplTerm(t2) && IsExtensionFunctor(FunctorOfTerm(t2)))) {
char s[32];
Error_TYPE = TYPE_ERROR_COMPOUND;
Error_Term = t2;
ErrorMessage = ErrorSay;
bip_name(Op, s);
sprintf(ErrorMessage, "compiling %s/2", s);
save_machine_regs();
longjmp(CompilerBotch,1);
} else if (IsApplTerm(t2)) {
Functor f = FunctorOfTerm(t2);
if (i1 < 1 || i1 > ArityOfFunctor(f)) {
c_goal(MkAtomTerm(AtomFalse));
} else {
c_eq(ArgOfTerm(i1, t2), t3);
}
return;
} else if (IsPairTerm(t2)) {
switch (i1) {
case 1:
c_eq(HeadOfTerm(t2), t3);
return;
case 2:
c_eq(TailOfTerm(t2), t3);
return;
default:
c_goal(MkAtomTerm(AtomFalse));
return;
}
}
} else {
char s[32];
Error_TYPE = TYPE_ERROR_INTEGER;
Error_Term = t2;
ErrorMessage = ErrorSay;
bip_name(Op, s);
sprintf(ErrorMessage, "compiling %s/2", s);
save_machine_regs();
longjmp(CompilerBotch,1);
}
}
if (IsIntTerm(t1)) {
/* first temp */
@ -819,8 +877,17 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
}
}
/* then we compile the opcode/result */
{
if (!IsVarTerm(t3)) {
if (!IsVarTerm(t3)) {
if (Op == _arg) {
Term tmpvar = MkVarTerm();
if (H == (CELL *)freep0) {
/* oops, too many new variables */
save_machine_regs();
longjmp(CompilerBotch,4);
}
c_var(tmpvar,f_flag,(unsigned int)Op);
c_eq(tmpvar,t3);
} else {
char s[32];
Error_TYPE = TYPE_ERROR_VARIABLE;
@ -831,19 +898,18 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
save_machine_regs();
longjmp(CompilerBotch,1);
}
if (IsNewVar(t3) && cur_branch == 0) {
c_var(t3,f_flag,(unsigned int)Op);
} else {
/* generate code for a temp and then unify temp with previous variable */
Term tmpvar = MkVarTerm();
if (H == (CELL *)freep0) {
/* oops, too many new variables */
save_machine_regs();
longjmp(CompilerBotch,4);
}
c_var(tmpvar,f_flag,(unsigned int)Op);
c_eq(tmpvar,t3);
} else if (IsNewVar(t3) && cur_branch == 0) {
c_var(t3,f_flag,(unsigned int)Op);
} else {
/* generate code for a temp and then unify temp with previous variable */
Term tmpvar = MkVarTerm();
if (H == (CELL *)freep0) {
/* oops, too many new variables */
save_machine_regs();
longjmp(CompilerBotch,4);
}
c_var(tmpvar,f_flag,(unsigned int)Op);
c_eq(tmpvar,t3);
}
}
@ -1217,7 +1283,7 @@ c_goal(Term Goal)
}
CurrentModule = save_CurrentModule;
return;
} else if (op >= _plus && op <= _slr) {
} else if (op >= _plus && op <= _arg) {
c_bifun(op,
ArgOfTerm(1, Goal),
ArgOfTerm(2, Goal),

6
C/computils.c
View File

@ -193,9 +193,6 @@ bip_name(Int op, char *s)
case _eq:
strcpy(s,"eq");
break;
case _arg:
strcpy(s,"arg");
break;
case _functor:
strcpy(s,"functor");
break;
@ -223,6 +220,9 @@ bip_name(Int op, char *s)
case _slr:
strcpy(s,"slr");
break;
case _arg:
strcpy(s,"arg");
break;
default:
strcpy(s,"");
break;

35
C/iopreds.c
View File

@ -1399,34 +1399,25 @@ static Int p_check_if_valid_new_alias (void)
static Int
p_fetch_stream_alias (void)
{ /* '$check_stream'(Stream) */
{ /* '$fetch_stream_alias'(Stream) */
int sno;
Term t2 = Deref(ARG2);
if ((sno = CheckStream (ARG1, Input_Stream_f | Output_Stream_f,
"check_stream/1")) == -1)
"fetch_stream_alias/2")) == -1)
return(FALSE);
switch (sno) {
case StdInStream:
return(unify_constant(t2, MkAtomTerm(AtomUsrIn)));
case StdOutStream:
return(unify_constant(t2, MkAtomTerm(AtomUsrOut)));
case StdErrStream:
return(unify_constant(t2, MkAtomTerm(AtomUsrErr)));
default:
if (IsVarTerm(t2)) {
Atom at = FetchAlias(sno);
if (at == AtomFoundVar)
return(FALSE);
else
return(unify_constant(t2, MkAtomTerm(at)));
} else if (IsAtomTerm(t2)) {
Atom at = AtomOfTerm(t2);
return((Int)FindAliasForStream(sno,at));
} else {
Error(TYPE_ERROR_ATOM, t2, "predicate_property/2");
if (IsVarTerm(t2)) {
Atom at = FetchAlias(sno);
if (at == AtomFoundVar)
return(FALSE);
}
else
return(unify_constant(t2, MkAtomTerm(at)));
} else if (IsAtomTerm(t2)) {
Atom at = AtomOfTerm(t2);
return((Int)FindAliasForStream(sno,at));
} else {
Error(TYPE_ERROR_ATOM, t2, "fetch_stream_alias/2");
return(FALSE);
}
}

5
C/save.c
View File

@ -1622,7 +1622,6 @@ RestoreClause(Clause *Cl)
case _p_equal:
case _p_dif:
case _p_eq:
case _p_arg:
case _p_functor:
#ifdef YAPOR
case _getwork_first_time:
@ -2103,6 +2102,7 @@ RestoreClause(Clause *Cl)
case _p_or_vv:
case _p_sll_vv:
case _p_slr_vv:
case _p_arg_vv:
pc->u.xxx.x = XAdjust(pc->u.xxx.x);
pc->u.xxx.x1 = XAdjust(pc->u.xxx.x1);
pc->u.xxx.x2 = XAdjust(pc->u.xxx.x2);
@ -2126,6 +2126,7 @@ RestoreClause(Clause *Cl)
case _p_div_vc:
case _p_sll_cv:
case _p_slr_cv:
case _p_arg_cv:
pc->u.xcx.x = XAdjust(pc->u.xcx.x);
if (IsAtomTerm(pc->u.xcx.c))
pc->u.xcx.c = AtomTermAdjust(pc->u.xcx.c);
@ -2141,6 +2142,7 @@ RestoreClause(Clause *Cl)
case _p_or_y_vv:
case _p_sll_y_vv:
case _p_slr_y_vv:
case _p_arg_y_vv:
pc->u.yxx.y = YAdjust(pc->u.yxx.y);
pc->u.yxx.x1 = XAdjust(pc->u.yxx.x1);
pc->u.yxx.x2 = XAdjust(pc->u.yxx.x2);
@ -2165,6 +2167,7 @@ RestoreClause(Clause *Cl)
/* instructions type ycx */
case _p_sll_y_cv:
case _p_slr_y_cv:
case _p_arg_y_cv:
pc->u.ycx.y = YAdjust(pc->u.ycx.y);
if (IsAtomTerm(pc->u.ycx.c))
pc->u.ycx.c = AtomTermAdjust(pc->u.ycx.c);

7
H/YapOpcodes.h
View File

@ -301,7 +301,6 @@
OPCODE(p_equal ,e),
OPCODE(p_dif ,e),
OPCODE(p_eq ,e),
OPCODE(p_arg ,e),
OPCODE(p_functor ,e),
OPCODE(p_plus_vv ,xxx),
OPCODE(p_plus_vc ,xxc),
@ -340,5 +339,9 @@
OPCODE(p_slr_cv ,xcx),
OPCODE(p_slr_y_vv ,yxx),
OPCODE(p_slr_y_vc ,yxc),
OPCODE(p_slr_y_cv ,ycx)
OPCODE(p_slr_y_cv ,ycx),
OPCODE(p_arg_vv ,xxx),
OPCODE(p_arg_cv ,xxc),
OPCODE(p_arg_y_vv ,yxx),
OPCODE(p_arg_y_cv ,yxc)

4
H/amidefs.h
View File

@ -71,7 +71,6 @@ typedef enum {
_equal,
_dif,
_eq,
_arg,
_functor,
_plus,
_minus,
@ -80,7 +79,8 @@ typedef enum {
_and,
_or,
_sll,
_slr
_slr,
_arg
} basic_preds;
#if USE_THREADED_CODE

5
changes4.3.html
View File

@ -6,6 +6,11 @@
<H2 ALIGN=CENTER>Yap-4.3.19:</H2>
<UL>
<LI> FIXED: allow yap_flag(user_{},V)..
<LI> FIXED: allow second argument unbound to stream_property/2..
<LI> FIXED: alias change had broke stream_property/2..
<LI> FIXED: alias change had broke tell(user) and see(user).
<LI> SPEEDUP: inline arg/3.
<LI> FIXED: extra clause for module/1.
<LI> NEW: module/3: SICStus options plus ciao options.
<LI> FIXED: mode/1 should not be defined if we do not know what

2
docs/yap.tex
View File

@ -3167,7 +3167,6 @@ stream where we have previously found an @code{end-of-file}. The possible
actions are @code{error}, that raises an error, @code{reset}, that tries to
reset the stream and is used for @code{tty} type files, and @code{eof_code},
which generates a new @code{end-of-file} (default for non-tty files).
@end table
@item alias(+@var{Name})
Specify an alias to the file. The alias @t{Name} must be an atom. The
@ -3179,6 +3178,7 @@ concerning the file. YAP only supports the predefined aliases
The operation will fail and give an error if the alias name is already
in use. YAP allows several aliases for the same file, but only
one is returned by @code{stream_property/2}
@end table
@item close(+@var{S}) [ISO]
@findex close/1

6
pl/directives.yap
View File

@ -462,21 +462,21 @@ yap_flag(write_strings,X) :-
yap_flag(user_input,OUT) :-
var(OUT), !,
current_stream(user_input,_,OUT).
stream_property(OUT,[alias(user_input)]).
yap_flag(user_input,Stream) :-
'$change_alias_to_stream'(user_input,Stream).
yap_flag(user_output,OUT) :-
var(OUT), !,
current_stream(user_output,_,OUT).
stream_property(OUT,[alias(user_output)]).
yap_flag(user_output,Stream) :-
'$change_alias_to_stream'(user_output,Stream).
yap_flag(user_error,OUT) :-
var(OUT), !,
current_stream(user_error,_,OUT).
stream_property(OUT,[alias(user_error)]).
yap_flag(user_error,Stream) :-
'$change_alias_to_stream'(user_error,Stream).

22
pl/yio.yap
View File

@ -241,7 +241,7 @@ nofileerrors :- '$set_value'(fileerrors,0).
exists(F) :- '$exists'(F,read).
see(user) :- !, see(user_input).
see(user) :- !, set_input(user_input).
see(F) :- var(F), !,
throw(error(instantiation_error,see(F))).
see(F) :- current_input(Stream),
@ -258,7 +258,7 @@ seeing(File) :- current_input(Stream),
seen :- current_input(Stream), close(Stream), set_input(user).
tell(user) :- !, tell(user_output).
tell(user) :- !, set_output(user_output).
tell(F) :- var(F), !,
throw(error(instantiation_error,tell(F))).
tell(F) :- current_output(Stream),
@ -719,16 +719,30 @@ set_stream_position(A,N) :-
set_stream_position(S,N) :-
'$set_stream_position'(S,N).
stream_property(Stream, Prop) :- var(Prop), !,
(var(Stream) -> current_stream(_,_,Stream) ; true),
'$generate_prop'(Prop),
'$stream_property'(Stream, Prop).
stream_property(Stream, Props) :- var(Stream), !,
current_stream(_,_,Stream),
'$stream_property'(Stream, Props).
stream_property(Stream, Props) :-
Stream = '$stream'(_), !,
'$check_stream'(Stream),
'$check_stream'(Stream), !,
'$stream_property'(Stream, Props).
stream_property(Stream, Props) :-
throw(error(domain_error(stream,Stream),stream_property(Stream, Props))).
'$generate_prop'(file_name(_F)).
'$generate_prop'(mode(_M)).
'$generate_prop'(input).
'$generate_prop'(output).
'$generate_prop'(position(_P)).
%'$generate_prop'(end_of_stream(_E)).
'$generate_prop'(eof_action(_E)).
%'$generate_prop'(reposition(_R)).
'$generate_prop'(type(_T)).
'$generate_prop'(alias(_A)).
'$stream_property'(Stream, Props) :-
var(Props), !,
throw(error(instantiation_error, stream_properties(Stream, Props))).