18static char SccsId[] =
"%W% %G%";
142p_mod(Term t1, Term t2 USES_REGS) {
143 switch (ETypeOfTerm(t1)) {
144 case (CELL)long_int_e:
145 switch (ETypeOfTerm(t2)) {
146 case (CELL)long_int_e:
149 Int i1 = IntegerOfTerm(t1);
150 Int i2 = IntegerOfTerm(t2);
154 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2,
"X is " Int_FORMAT
" mod 0", i1);
155 if (i1 == Int_MIN && i2 == -1) {
159 if (mod && (mod ^ i2) < 0)
164 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"mod/2");
165 case (CELL)big_int_e:
167 return Yap_gmp_mod_int_big(IntegerOfTerm(t1), t2);
174 Yap_ArithError(TYPE_ERROR_INTEGER, t1,
"mod/2");
175 case (CELL)big_int_e:
177 switch (ETypeOfTerm(t2)) {
181 Int i2 = IntegerOfTerm(t2);
184 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2,
"X is ... mod 0");
185 return Yap_gmp_mod_big_int(t1, i2);
187 case (CELL)big_int_e:
189 return Yap_gmp_mod_big_big(t1, t2);
191 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"mod/2");
202p_div2(Term t1, Term t2 USES_REGS) {
203 switch (ETypeOfTerm(t1)) {
204 case (CELL)long_int_e:
205 switch (ETypeOfTerm(t2)) {
206 case (CELL)long_int_e:
209 Int i1 = IntegerOfTerm(t1);
210 Int i2 = IntegerOfTerm(t2);
214 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2,
"X is " Int_FORMAT
" div 0", i1);
215 if (i1 == Int_MIN && i2 == -1) {
217 return Yap_gmp_add_ints(Int_MAX, 1);
219 Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
220 "// /2 with %d and %d", i1, i2);
224 if (mod && (mod ^ i2) < 0)
226 res = (i1 - mod) / i2;
230 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"div/2");
231 case (CELL)big_int_e:
233 return Yap_gmp_div_int_big(IntegerOfTerm(t1), t2);
240 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"div/2");
241 case (CELL)big_int_e:
243 switch (ETypeOfTerm(t2)) {
247 Int i2 = IntegerOfTerm(t2);
250 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2,
"X is ... div 0");
251 return Yap_gmp_div2_big_int(t1, i2);
253 case (CELL)big_int_e:
255 return Yap_gmp_div2_big_big(t1, t2);
257 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"div/2");
268p_rem(Term t1, Term t2 USES_REGS) {
269 switch (ETypeOfTerm(t1)) {
270 case (CELL)long_int_e:
271 switch (ETypeOfTerm(t2)) {
272 case (CELL)long_int_e:
275 Int i1 = IntegerOfTerm(t1);
276 Int i2 = IntegerOfTerm(t2);
279 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2,
"X is " Int_FORMAT
" rem 0", i1);
280 if (i1 == Int_MIN && i2 == -1) {
286 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"rem/2");
287 case (CELL)big_int_e:
289 return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2);
296 Yap_ArithError(TYPE_ERROR_INTEGER, t1,
"rem/2");
297 case (CELL)big_int_e:
299 switch (ETypeOfTerm(t2)) {
301 if (IntegerOfTerm(t2) == 0)
302 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2,
"X is ... rem 0");
303 return Yap_gmp_rem_big_int(t1, IntegerOfTerm(t2));
304 case (CELL)big_int_e:
306 return Yap_gmp_rem_big_big(t1, t2);
308 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"rem/2");
320p_rdiv(Term t1, Term t2 USES_REGS) {
322 switch (ETypeOfTerm(t1)) {
324 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"rdiv/2");
325 case (CELL)long_int_e:
326 switch (ETypeOfTerm(t2)) {
327 case (CELL)long_int_e:
330 Int i1 = IntegerOfTerm(t1);
331 Int i2 = IntegerOfTerm(t2);
334 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2,
"X is " Int_FORMAT
" rdiv 0", i1);
335 return Yap_gmq_rdiv_int_int(i1, i2);
337 case (CELL)big_int_e:
339 return Yap_gmq_rdiv_int_big(IntegerOfTerm(t1), t2);
344 case (CELL)big_int_e:
345 switch (ETypeOfTerm(t2)) {
347 if (IntegerOfTerm(t2) == 0)
348 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2,
"X is ... rdiv 0");
350 return Yap_gmq_rdiv_big_int(t1, IntegerOfTerm(t2));
351 case (CELL)big_int_e:
352 return Yap_gmq_rdiv_big_big(t1, t2);
354 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"rdiv/2");
371p_fdiv(Term t1, Term t2 USES_REGS)
373 switch (ETypeOfTerm(t1)) {
375 switch (ETypeOfTerm(t2)) {
378 Int i2 = IntegerOfTerm(t2);
381 RFLOAT((((Float)IntegerOfTerm(t1))/(Float)i2));
386 Float fl1 = (Float)IntegerOfTerm(t1);
387 Float fl2 = FloatOfTerm(t2);
390 case (CELL)big_int_e:
392 return Yap_gmp_fdiv_int_big(IntegerOfTerm(t1), t2);
399 switch (ETypeOfTerm(t2)) {
403 Int i2 = IntegerOfTerm(t2);
404 RFLOAT(FloatOfTerm(t1)/(Float)i2);
408 Float f2 = FloatOfTerm(t2);
409 RFLOAT(FloatOfTerm(t1)/f2);
413 return Yap_gmp_fdiv_float_big(FloatOfTerm(t1), t2);
421 switch (ETypeOfTerm(t2)) {
423 return Yap_gmp_fdiv_big_int(t1, IntegerOfTerm(t2));
426 return Yap_gmp_fdiv_big_big(t1, t2);
428 return Yap_gmp_fdiv_big_float(t1, FloatOfTerm(t2));
443p_xor(Term t1, Term t2 USES_REGS)
445 switch (ETypeOfTerm(t1)) {
448 switch (ETypeOfTerm(t2)) {
451 RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2));
453 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"#/2");
456 return Yap_gmp_xor_int_big(IntegerOfTerm(t1), t2);
463 Yap_ArithError(TYPE_ERROR_INTEGER, t1,
"#/2");
466 switch (ETypeOfTerm(t2)) {
468 return Yap_gmp_xor_int_big(IntegerOfTerm(t2), t1);
470 return Yap_gmp_xor_big_big(t1, t2);
472 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"#/2");
487p_atan2(Term t1, Term t2 USES_REGS)
489 switch (ETypeOfTerm(t1)) {
491 switch (ETypeOfTerm(t2)) {
494 RFLOAT(atan2(IntegerOfTerm(t1),IntegerOfTerm(t2)));
496 RFLOAT(atan2(IntegerOfTerm(t1),FloatOfTerm(t2)));
500 Int i1 = IntegerOfTerm(t1);
501 Float f2 = Yap_gmp_to_float(t2);
502 RFLOAT(atan2(i1,f2));
510 switch (ETypeOfTerm(t2)) {
514 Int i2 = IntegerOfTerm(t2);
515 RFLOAT(atan2(FloatOfTerm(t1),i2));
519 Float f2 = FloatOfTerm(t2);
520 RFLOAT(atan2(FloatOfTerm(t1),f2));
525 RFLOAT(atan2(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
535 Float dbl1 = Yap_gmp_to_float(t1);
536 switch (ETypeOfTerm(t2)) {
539 Int i = IntegerOfTerm(t2);
540 RFLOAT(atan2(dbl1,i));
544 RFLOAT(atan2(dbl1,Yap_gmp_to_float(t2)));
547 Float dbl = FloatOfTerm(t2);
548 RFLOAT(atan2(dbl1,dbl));
566p_power(Term t1, Term t2 USES_REGS)
568 switch (ETypeOfTerm(t1)) {
570 switch (ETypeOfTerm(t2)) {
573 Int i2 = IntegerOfTerm(t2);
576 RFLOAT(pow(IntegerOfTerm(t1),i2));
581 Float fl1 = (Float)IntegerOfTerm(t1);
582 Float fl2 = FloatOfTerm(t2);
583 RFLOAT(pow(fl1,fl2));
588 Int i1 = IntegerOfTerm(t1);
589 Float f2 = Yap_gmp_to_float(t2);
598 switch (ETypeOfTerm(t2)) {
602 Int i2 = IntegerOfTerm(t2);
603 RFLOAT(pow(FloatOfTerm(t1),i2));
607 Float f2 = FloatOfTerm(t2);
608 RFLOAT(pow(FloatOfTerm(t1),f2));
613 RFLOAT(pow(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
622 switch (ETypeOfTerm(t2)) {
625 Int i = IntegerOfTerm(t2);
626 RFLOAT(pow(Yap_gmp_to_float(t1),i));
630 RFLOAT(pow(Yap_gmp_to_float(t1),Yap_gmp_to_float(t2)));
633 Float dbl = FloatOfTerm(t2);
634 RFLOAT(pow(Yap_gmp_to_float(t1),dbl));
656 if (p == 0)
return ((CELL)1);
657 if (x == 0 && p > 0)
return 0L;
659 return (-p % 2) ? x : ((CELL)1);
664 if (mul_overflow((r*x), r, x)) {
669 if((p >>= 1) == 0)
return r;
670 if (mul_overflow((x*x), x, x)) {
682p_exp(Term t1, Term t2 USES_REGS)
684 switch (ETypeOfTerm(t1)) {
686 switch (ETypeOfTerm(t2)) {
689 Int i1 = IntegerOfTerm(t1);
690 Int i2 = IntegerOfTerm(t2);
694 Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2,
702 return Yap_gmp_exp_int_int(i1, i2);
710 Float fl1 = (Float)IntegerOfTerm(t1);
711 Float fl2 = FloatOfTerm(t2);
712 RFLOAT(pow(fl1,fl2));
717 Int i = IntegerOfTerm(t1);
718 return Yap_gmp_exp_int_big(i,t2);
726 switch (ETypeOfTerm(t2)) {
730 Int i2 = IntegerOfTerm(t2);
731 RFLOAT(pow(FloatOfTerm(t1),i2));
735 Float f2 = FloatOfTerm(t2);
736 RFLOAT(pow(FloatOfTerm(t1),f2));
741 RFLOAT(pow(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
750 switch (ETypeOfTerm(t2)) {
753 Int i = IntegerOfTerm(t2);
754 return Yap_gmp_exp_big_int(t1,i);
758 return Yap_gmp_exp_big_big(t1,t2);
761 Float dbl = FloatOfTerm(t2);
762 RFLOAT(pow(Yap_gmp_to_float(t1),dbl));
775gcd(Int m11,Int m21 USES_REGS)
780 while (m11>0 && m21>0)
782 k = m21/m11; m21 -= k*m11; m22 -= k*m12;
784 k=m11/m21; m11 -= k*m21; m12 -= k*m22;
786 if (m11<0 || m21<0) {
788 Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
789 "gcd/2 with %d and %d", m11, m21);
792 if (m11)
return(m11);
797Int gcdmult(Int m11,Int m21,Int *pm11)
803 k = m21/m11; m21 -= k*m11; m22 -= k*m12;
805 k=m11/m21; m11 -= k*m21; m12 -= k*m22;
807 if (m11<0 || m21<0) {
809 Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
810 "gcdmult/2 with %d and %d", m11, m21);
814 *pm11 = m12;
return(m11);
825p_gcd(Term t1, Term t2 USES_REGS)
827 switch (ETypeOfTerm(t1)) {
829 switch (ETypeOfTerm(t2)) {
833 Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2);
834 i1 = (i1 >= 0 ? i1 : -i1);
835 i2 = (i2 >= 0 ? i2 : -i2);
837 RINT(gcd(i1,i2 PASS_REGS));
840 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"gcd/2");
843 return Yap_gmp_gcd_int_big(IntegerOfTerm(t1), t2);
850 Yap_ArithError(TYPE_ERROR_INTEGER, t1,
"gcd/2");
853 switch (ETypeOfTerm(t2)) {
855 return Yap_gmp_gcd_int_big(IntegerOfTerm(t2), t1);
857 return Yap_gmp_gcd_big_big(t1, t2);
859 Yap_ArithError(TYPE_ERROR_INTEGER, t2,
"gcd/2");
874p_min(Term t1, Term t2)
876 switch (ETypeOfTerm(t1)) {
878 switch (ETypeOfTerm(t2)) {
881 Int i1 = IntegerOfTerm(t1);
882 Int i2 = IntegerOfTerm(t2);
883 return((i1 < i2 ? t1 : t2));
888 Int i = IntegerOfTerm(t1);
889 Float fl = FloatOfTerm(t2);
897 if (Yap_gmp_cmp_int_big(IntegerOfTerm(t1), t2) < 0) {
907 switch (ETypeOfTerm(t2)) {
911 Int i = IntegerOfTerm(t2);
912 Float fl = FloatOfTerm(t1);
920 Float fl1 = FloatOfTerm(t1);
921 Float fl2 = FloatOfTerm(t2);
929 if (Yap_gmp_cmp_float_big(FloatOfTerm(t1), t2) < 0) {
940 switch (ETypeOfTerm(t2)) {
942 if (Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2)) < 0) {
947 if (Yap_gmp_cmp_big_big(t1, t2) < 0) {
952 if (Yap_gmp_cmp_big_float(t1, FloatOfTerm(t2)) < 0) {
970p_max(Term t1, Term t2)
972 switch (ETypeOfTerm(t1)) {
974 switch (ETypeOfTerm(t2)) {
977 Int i1 = IntegerOfTerm(t1);
978 Int i2 = IntegerOfTerm(t2);
979 return((i1 > i2 ? t1 : t2));
984 Int i = IntegerOfTerm(t1);
985 Float fl = FloatOfTerm(t2);
993 if (Yap_gmp_cmp_int_big(IntegerOfTerm(t1), t2) > 0) {
1003 switch (ETypeOfTerm(t2)) {
1007 Int i = IntegerOfTerm(t2);
1008 Float fl = FloatOfTerm(t1);
1016 Float fl1 = FloatOfTerm(t1);
1017 Float fl2 = FloatOfTerm(t2);
1025 if (Yap_gmp_cmp_float_big(FloatOfTerm(t1), t2) > 0) {
1036 switch (ETypeOfTerm(t2)) {
1038 if (Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2)) > 0) {
1043 if (Yap_gmp_cmp_big_big(t1, t2) > 0) {
1048 if (Yap_gmp_cmp_big_float(t1, FloatOfTerm(t2)) > 0) {
1063eval2(Int fi, Term t1, Term t2 USES_REGS) {
1067 return p_plus(t1, t2 PASS_REGS);
1069 return p_minus(t1, t2 PASS_REGS);
1071 return p_times(t1, t2 PASS_REGS);
1073 return p_div(t1, t2 PASS_REGS);
1075 return p_div2(t1, t2 PASS_REGS);
1077 return p_and(t1, t2 PASS_REGS);
1079 return p_or(t1, t2 PASS_REGS);
1081 return p_sll(t1, t2 PASS_REGS);
1083 return p_slr(t1, t2 PASS_REGS);
1085 return p_mod(t1, t2 PASS_REGS);
1087 return p_rem(t1, t2 PASS_REGS);
1089 return p_fdiv(t1, t2 PASS_REGS);
1091 return p_xor(t1, t2 PASS_REGS);
1093 return p_atan2(t1, t2 PASS_REGS);
1095 return p_exp(t1, t2 PASS_REGS);
1097 return p_power(t1, t2 PASS_REGS);
1099 return p_gcd(t1, t2 PASS_REGS);
1101 return p_min(t1, t2);
1103 return p_max(t1, t2);
1105 return p_rdiv(t1, t2 PASS_REGS);
1110Term Yap_eval_binary(Int f, Term t1, Term t2)
1113 return eval2(f,t1,t2 PASS_REGS);
1133 {
"atan2", op_atan2},
1147p_binary_is( USES_REGS1 )
1149 Term t = Deref(ARG2);
1151 yap_error_number err;
1154 Yap_ArithError(INSTANTIATION_ERROR,t,
"VAR(X , Y)");
1158 t1 = Yap_Eval(Deref(ARG3));
1159 if ((err = Yap_FoundArithError())) {
1162 Int i = IntOfTerm(t);
1163 name = Yap_NameOfBinaryOp(i);
1165 name = AtomOfTerm(Deref(ARG2));
1167 Yap_EvalError(err,ARG3,
"X is ~s/2: error in first argument ", RepAtom(name)->StrOfAE);
1170 t2 = Yap_Eval(Deref(ARG4));
1171 if ((err=Yap_FoundArithError())) {
1174 Int i = IntOfTerm(t);
1175 name = Yap_NameOfBinaryOp(i);
1177 name = AtomOfTerm(Deref(ARG2));
1179 Yap_EvalError(err,ARG3,
"X is ~s/2: error in first argument ", RepAtom(name)->StrOfAE);
1183 Int i = IntOfTerm(t);
1184 Term tout = eval2(i, t1, t2 PASS_REGS);
1185 if ((err = Yap_FoundArithError()) != YAP_NO_ERROR) {
1187 Atom name = Yap_NameOfBinaryOp( i );
1188 Functor f = Yap_MkFunctor( name, 2 );
1191 terr = Yap_MkApplTerm( f, 2, ts );
1192 Yap_EvalError(err, terr ,
"error in %s/2 ", RepAtom(name)->StrOfAE);
1195 return Yap_unify_constant(ARG1,tout);
1197 if (IsAtomTerm(t)) {
1198 Atom name = AtomOfTerm(t);
1202 if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
1203 Yap_EvalError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
1204 "functor %s/2 for arithmetic expression",
1205 RepAtom(name)->StrOfAE);
1209 out= eval2(p->FOfEE, t1, t2 PASS_REGS);
1210 if ((err = Yap_FoundArithError()) != YAP_NO_ERROR) {
1212 Functor f = Yap_MkFunctor( name, 2 );
1215 terr = Yap_MkApplTerm( f, 2, ts );
1216 Yap_EvalError(err, terr ,
"error in ~s/2 ", RepAtom(name)->StrOfAE);
1219 return Yap_unify_constant(ARG1,out);
1229 Term t = Deref(ARG1);
1232 yap_error_number err;
1236 Yap_EvalError(INSTANTIATION_ERROR,t,
"X is Y");
1242 t2 = Yap_Eval(Deref(ARG2));
1245 out= eval2(op, t1, t2 PASS_REGS);
1246 if ((err=Yap_FoundArithError())) {
1248 Functor f = Yap_MkFunctor( Yap_NameOfBinaryOp(op), 2 );
1251 t = Yap_MkApplTerm( f, 2, ts );
1252 Yap_EvalError(err, t ,
"error in ~s(Y,Z) ",Yap_NameOfBinaryOp(op));
1255 return Yap_unify_constant(ARG3,out);
1259export_p_plus( USES_REGS1 )
1261 return do_arith23(op_plus PASS_REGS);
1265export_p_minus( USES_REGS1 )
1267 return do_arith23(op_minus PASS_REGS);
1271export_p_times( USES_REGS1 )
1273 return do_arith23(op_times PASS_REGS);
1277export_p_div( USES_REGS1 )
1279 return do_arith23(op_div PASS_REGS);
1283export_p_and( USES_REGS1 )
1285 return do_arith23(op_and PASS_REGS);
1289export_p_or( USES_REGS1 )
1291 return do_arith23(op_or PASS_REGS);
1295export_p_slr( USES_REGS1 )
1297 return do_arith23(op_slr PASS_REGS);
1301export_p_sll( USES_REGS1 )
1303 return do_arith23(op_sll PASS_REGS);
1307p_binary_op_as_integer( USES_REGS1 )
1309 Term t = Deref(ARG1);
1312 Yap_EvalError(INSTANTIATION_ERROR,t,
"X is Y");
1316 return Yap_unify_constant(ARG2,t);
1318 if (IsAtomTerm(t)) {
1319 Atom name = AtomOfTerm(t);
1322 if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
1323 return Yap_unify(ARG1,ARG2);
1325 return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE));
1331Yap_NameOfBinaryOp(
int i)
1333 return Yap_LookupAtom(InitBinTab[i].OpName);
1338Yap_InitBinaryExps(
void)
1343 for (i = 0; i <
sizeof(InitBinTab)/
sizeof(
InitBinEntry); ++i) {
1344 AtomEntry *ae = RepAtom(Yap_LookupAtom(InitBinTab[i].OpName));
1346 Yap_EvalError(RESOURCE_ERROR_HEAP,TermNil,
"at InitBinaryExps");
1349 WRITE_LOCK(ae->ARWLock);
1350 if (Yap_GetExpPropHavingLock(ae, 2)) {
1351 WRITE_UNLOCK(ae->ARWLock);
1355 p->KindOfPE = ExpProperty;
1358 p->FOfEE = InitBinTab[i].f;
1360 WRITE_UNLOCK(ae->ARWLock);
1362 Yap_InitCPred(
"is", 4, p_binary_is, TestPredFlag | SafePredFlag);
1363 Yap_InitCPred(
"$binary_op_as_integer", 2, p_binary_op_as_integer, TestPredFlag|SafePredFlag);
1364 Yap_InitAsmPred(
"$plus", 3, _plus, export_p_plus, SafePredFlag);
1365 Yap_InitAsmPred(
"$minus", 3, _minus, export_p_minus, SafePredFlag);
1366 Yap_InitAsmPred(
"$times", 3, _times, export_p_times, SafePredFlag);
1367 Yap_InitAsmPred(
"$div", 3, _div, export_p_div, SafePredFlag);
1368 Yap_InitAsmPred(
"$and", 3, _and, export_p_and, SafePredFlag);
1369 Yap_InitAsmPred(
"$or", 3, _or, export_p_or, SafePredFlag);
1370 Yap_InitAsmPred(
"$sll", 3, _sll, export_p_sll, SafePredFlag);
1371 Yap_InitAsmPred(
"$slr", 3, _slr, export_p_slr, SafePredFlag);
1376Yap_ReInitBinaryExps(
void)
arith2_op
binary operators