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

rename BinaryTestPredFlag to BinaryPredFlag 

get rid of small annoying arithmetic bugs
This commit is contained in:
Vitor Santos Costa 2009-02-09 21:56:40 +00:00
parent 30e946cc30
commit 8a3978e3e1
44 changed files with 767 additions and 311 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
BEAM/toeam.c
View File

@ -162,7 +162,7 @@ void verifica_predicados(struct Clauses *clause)
PredEntry *p=RepPredProp((Prop) inter_code->new4);
inter_code->op=safe_call_op;
inter_code->new4= (unsigned long) p->cs.f_code;
if (Flags & BinaryTestPredFlag) inter_code->new1=2;
if (Flags & BinaryPredFlag) inter_code->new1=2;
else inter_code->new1=0;
}
}
@ -204,7 +204,7 @@ void verifica_predicados(struct Clauses *clause)
} else {/* safe_call */
inter_code->op=safe_call_op;
inter_code->new4= (unsigned long) p->cs.f_code;
if (Flags & BinaryTestPredFlag) inter_code->new1=2;
if (Flags & BinaryPredFlag) inter_code->new1=2;
else inter_code->new1=0;
}
}

186
C/absmi.c
View File

@ -8854,6 +8854,12 @@ Yap_absmi(int inp)
GONext();
ENDOp();
Op(index_long, e);
PREG = NEXTOP(PREG, e);
I_R = MkIntTerm(SREG[0] & (MAX_ABS_INT-1));
GONext();
ENDOp();
/************************************************************************\
@ -10969,7 +10975,7 @@ Yap_absmi(int inp)
if (i2 < 0)
d0 = do_sll(d1, -i2);
else
d0 = MkIntTerm(d1 >> i2);
d0 = MkIntegerTerm(d1 >> i2);
}
else {
saveregs();
@ -11101,7 +11107,7 @@ Yap_absmi(int inp)
if (i2 < 0)
d0 = do_sll(d1, -i2);
else
d0 = MkIntTerm(d1 >> i2);
d0 = MkIntegerTerm(d1 >> i2);
}
else {
saveregs();
@ -11650,7 +11656,7 @@ Yap_absmi(int inp)
Float d0;
if (Yap_isint[PREG->u.sdll.s])
d0 = Yap_Ints[PREG->u.sdll.s];
else
else
d0 = Yap_Floats[PREG->u.sdll.s];
if ( d0 > CpFloatUnaligned(PREG->u.sdll.d)) {
PREG = PREG->u.sdll.T;
@ -11680,29 +11686,31 @@ Yap_absmi(int inp)
Op(lt, ssll);
if (Yap_isint[PREG->u.ssll.s1]) {
if (Yap_isint[PREG->u.ssll.s2]) {
if (Yap_Ints[PREG->u.ssll.s2] < Yap_Ints[PREG->u.ssll.s2]) {
PREG = PREG->u.snll.T;
if (Yap_Ints[PREG->u.ssll.s1] < Yap_Ints[PREG->u.ssll.s2]) {
PREG = PREG->u.ssll.T;
GONext();
}
} else {
if (Yap_Ints[PREG->u.ssll.s2] < Yap_Floats[PREG->u.ssll.s2]) {
PREG = PREG->u.snll.T;
if (Yap_Ints[PREG->u.ssll.s1] < Yap_Floats[PREG->u.ssll.s2]) {
PREG = PREG->u.ssll.T;
GONext();
}
}
} else {
if (Yap_isint[PREG->u.ssll.s2]) {
if (Yap_Floats[PREG->u.ssll.s2] < Yap_Ints[PREG->u.ssll.s2]) {
PREG = PREG->u.snll.T;
if (Yap_Floats[PREG->u.ssll.s1] < Yap_Ints[PREG->u.ssll.s2]) {
PREG = PREG->u.ssll.T;
GONext();
}
} else {
if (Yap_Floats[PREG->u.ssll.s2] < Yap_Floats[PREG->u.ssll.s2]) {
PREG = PREG->u.snll.T;
if (Yap_Floats[PREG->u.ssll.s1] < Yap_Floats[PREG->u.ssll.s2]) {
PREG = PREG->u.ssll.T;
GONext();
}
}
}
PREG = PREG->u.ssll.F;
GONext();
ENDOp();
Op(gtc_float, sdll);
@ -11756,7 +11764,7 @@ Yap_absmi(int inp)
{
int off = PREG->u.ssn.s0;
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_Floats[off] = Yap_Ints[PREG->u.ssn.s1]+PREG->u.ssn.n;
Yap_Ints[off] = Yap_Ints[PREG->u.ssn.s1]+PREG->u.ssn.n;
Yap_isint[off] = TRUE;
if (add_overflow(Yap_Ints[off],Yap_Ints[PREG->u.ssn.s1],PREG->u.ssn.n)) {
PREG = ARITH_EXCEPTION;
@ -11778,21 +11786,21 @@ Yap_absmi(int inp)
if (Yap_isint[PREG->u.sss.s2]) {
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]+Yap_Ints[PREG->u.sss.s2];
Yap_isint[off] = TRUE;
if (add_overflow(Yap_Ints[off],Yap_Ints[PREG->u.sss.s1],PREG->u.sss.s2)) {
if (add_overflow(Yap_Ints[off],Yap_Ints[PREG->u.sss.s1],Yap_Ints[PREG->u.sss.s2])) {
PREG = ARITH_EXCEPTION;
GONext();
} else {
Yap_Floats[off] = Yap_Ints[PREG->u.sss.s1]+Yap_Floats[PREG->u.sss.s2];
Yap_isint[off] = FALSE;
}
}
} else {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_Floats[off] = Yap_Floats[PREG->u.sss.s1]+Yap_Ints[PREG->u.sss.s2];
} else {
Yap_Floats[off] = Yap_Floats[PREG->u.sss.s1]+Yap_Floats[PREG->u.sss.s2];
}
Yap_Floats[off] = Yap_Ints[PREG->u.sss.s1]+Yap_Floats[PREG->u.sss.s2];
Yap_isint[off] = FALSE;
}
} else {
Yap_isint[off] = FALSE;
if (Yap_isint[PREG->u.sss.s2]) {
Yap_Floats[off] = Yap_Floats[PREG->u.sss.s1]+Yap_Ints[PREG->u.sss.s2];
} else {
Yap_Floats[off] = Yap_Floats[PREG->u.sss.s1]+Yap_Floats[PREG->u.sss.s2];
}
}
}
PREG = NEXTOP(PREG, sss);
@ -11817,7 +11825,7 @@ Yap_absmi(int inp)
{
int off = PREG->u.ssn.s0;
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_Floats[off] = PREG->u.ssn.n-Yap_Ints[PREG->u.ssn.s1];
Yap_Ints[off] = PREG->u.ssn.n-Yap_Ints[PREG->u.ssn.s1];
Yap_isint[off] = TRUE;
if (sub_overflow(Yap_Ints[off],PREG->u.ssn.n,Yap_Ints[PREG->u.ssn.s1])) {
PREG = ARITH_EXCEPTION;
@ -11874,7 +11882,7 @@ Yap_absmi(int inp)
{
int off = PREG->u.ssn.s0;
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_Floats[off] = Yap_Ints[PREG->u.ssn.s1]*PREG->u.ssn.n;
Yap_Ints[off] = Yap_Ints[PREG->u.ssn.s1]*PREG->u.ssn.n;
Yap_isint[off] = TRUE;
if (mul_overflow(Yap_Ints[off],Yap_Ints[PREG->u.ssn.s1],PREG->u.ssn.n)) {
PREG = ARITH_EXCEPTION;
@ -11896,9 +11904,10 @@ Yap_absmi(int inp)
if (Yap_isint[PREG->u.sss.s2]) {
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]*Yap_Ints[PREG->u.sss.s2];
Yap_isint[off] = TRUE;
if (mul_overflow(Yap_Ints[off],Yap_Ints[PREG->u.sss.s1],PREG->u.sss.s2)) {
PREG = ARITH_EXCEPTION;
GONext();
if (mul_overflow(Yap_Ints[off],Yap_Ints[PREG->u.sss.s1],Yap_Ints[PREG->u.sss.s2])) {
PREG = ARITH_EXCEPTION;
GONext();
}
} else {
Yap_Floats[off] = Yap_Ints[PREG->u.sss.s1]*Yap_Floats[PREG->u.sss.s2];
Yap_isint[off] = FALSE;
@ -11910,7 +11919,6 @@ Yap_absmi(int inp)
Yap_Floats[off] = Yap_Floats[PREG->u.sss.s1]*Yap_Floats[PREG->u.sss.s2];
}
Yap_isint[off] = FALSE;
}
}
}
PREG = NEXTOP(PREG, sss);
@ -11961,7 +11969,12 @@ Yap_absmi(int inp)
Op(idiv_c1, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (Yap_Ints[PREG->u.ssn.s1] == 0) {
Int qu0 = Yap_Ints[PREG->u.ssn.s1];
if (qu0 == 0) {
PREG = ARITH_EXCEPTION;
GONext();
}
if (Int_MIN == PREG->u.ssn.n && qu0 == -1) {
PREG = ARITH_EXCEPTION;
GONext();
}
@ -11977,7 +11990,12 @@ Yap_absmi(int inp)
Op(idiv_c2, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_Ints[PREG->u.ssn.s0] = Yap_Ints[PREG->u.ssn.s1]/PREG->u.ssn.n;
Int div = PREG->u.ssn.n;
if (Int_MIN == Yap_Ints[PREG->u.ssn.s1] && div == -1) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[PREG->u.ssn.s0] = Yap_Ints[PREG->u.ssn.s1]/div;
} else {
PREG = ARITH_EXCEPTION;
GONext();
@ -11993,7 +12011,13 @@ Yap_absmi(int inp)
if (Yap_isint[PREG->u.sss.s1] &&
Yap_isint[PREG->u.sss.s2] &&
Yap_Ints[PREG->u.sss.s2] != 0) {
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]/Yap_Ints[PREG->u.sss.s2];
Int i1 = Yap_Ints[PREG->u.sss.s1];
Int i2 = Yap_Ints[PREG->u.sss.s2];
if (i1 == Int_MIN && i2 == -1) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[off] = i1/i2;
Yap_isint[off] = TRUE;
} else {
PREG = ARITH_EXCEPTION;
@ -12006,11 +12030,19 @@ Yap_absmi(int inp)
Op(mod_c1, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (Yap_Ints[PREG->u.ssn.s1] == 0) {
Int mod, div = Yap_Ints[PREG->u.ssn.s1];
if (div == 0) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[PREG->u.ssn.s0] = PREG->u.ssn.n % Yap_Ints[PREG->u.ssn.s1];
if (div == -1 && PREG->u.ssn.n == Int_MIN) {
PREG = ARITH_EXCEPTION;
GONext();
}
mod = PREG->u.ssn.n % div;
if (mod && (mod ^ div) < 0)
mod += div;
Yap_Ints[PREG->u.ssn.s0] = mod;
} else {
PREG = ARITH_EXCEPTION;
GONext();
@ -12022,7 +12054,15 @@ Yap_absmi(int inp)
Op(mod_c2, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_Ints[PREG->u.ssn.s0] = Yap_Ints[PREG->u.ssn.s1]%PREG->u.ssn.n;
Int mod, div = PREG->u.ssn.n;
if (div == -1 && Yap_Ints[PREG->u.ssn.s1] == Int_MIN) {
PREG = ARITH_EXCEPTION;
GONext();
}
mod = Yap_Ints[PREG->u.ssn.s1]%div;
if (mod && (mod ^ div) < 0)
mod += div;
Yap_Ints[PREG->u.ssn.s0] = mod;
} else {
PREG = ARITH_EXCEPTION;
GONext();
@ -12035,10 +12075,19 @@ Yap_absmi(int inp)
Op(mod, sss);
{
int off = PREG->u.sss.s0;
Int mod, div = Yap_Ints[PREG->u.sss.s2];
if (Yap_isint[PREG->u.sss.s1] &&
Yap_isint[PREG->u.sss.s2] &&
Yap_Ints[PREG->u.sss.s2] != 0) {
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]%Yap_Ints[PREG->u.sss.s2];
div != 0) {
Int i1 = Yap_Ints[PREG->u.sss.s1];
if (i1 == Int_MIN && div == -1) {
PREG = ARITH_EXCEPTION;
GONext();
}
mod = i1%div;
if (mod && (mod ^ div) < 0)
mod += div;
Yap_Ints[off] = mod;
} else {
PREG = ARITH_EXCEPTION;
GONext();
@ -12051,11 +12100,16 @@ Yap_absmi(int inp)
Op(rem_c1, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (Yap_Ints[PREG->u.ssn.s1] == 0) {
Int div = Yap_Ints[PREG->u.ssn.s1];
if (div == 0) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[PREG->u.ssn.s0] = PREG->u.ssn.n%Yap_Ints[PREG->u.ssn.s1];
if (PREG->u.ssn.n == Int_MIN && div == -1) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[PREG->u.ssn.s0] = PREG->u.ssn.n%div;
} else {
PREG = ARITH_EXCEPTION;
GONext();
@ -12067,7 +12121,12 @@ Yap_absmi(int inp)
Op(rem_c2, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_Ints[PREG->u.ssn.s0] = Yap_Ints[PREG->u.ssn.s1]%PREG->u.ssn.n;
Int div = PREG->u.ssn.n;
if (Yap_Ints[PREG->u.ssn.s1] == Int_MIN && div == -1) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[PREG->u.ssn.s0] = Yap_Ints[PREG->u.ssn.s1]%div;
} else {
PREG = ARITH_EXCEPTION;
GONext();
@ -12086,7 +12145,13 @@ Yap_absmi(int inp)
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]%Yap_Ints[PREG->u.sss.s2];
Int i1 = Yap_Ints[PREG->u.sss.s1];
Int div = Yap_Ints[PREG->u.sss.s2];
if (i1 == Int_MIN && div == -1) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[off] = i1%div;
} else {
PREG = ARITH_EXCEPTION;
GONext();
@ -12201,6 +12266,11 @@ Yap_absmi(int inp)
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
Int operand = Yap_Ints[PREG->u.sss.s1];
if (operand == Int_MIN) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[off] = -Yap_Ints[PREG->u.sss.s1];
Yap_isint[off] = TRUE;
} else {
@ -12214,11 +12284,15 @@ Yap_absmi(int inp)
Op(sl_c1, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (sl_overflow(PREG->u.ssn.n,Yap_Ints[PREG->u.ssn.s1])) {
Int sc = Yap_Ints[PREG->u.ssn.s1];
if (sl_overflow(PREG->u.ssn.n,sc)) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[PREG->u.ssn.s0] = PREG->u.ssn.n<<Yap_Ints[PREG->u.ssn.s1];
if (sc < 0)
Yap_Ints[PREG->u.ssn.s0] = PREG->u.ssn.n>>-sc;
else
Yap_Ints[PREG->u.ssn.s0] = PREG->u.ssn.n<<sc;
} else {
PREG = ARITH_EXCEPTION;
GONext();
@ -12249,11 +12323,15 @@ Yap_absmi(int inp)
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
if (sl_overflow(Yap_Ints[PREG->u.sss.s1],Yap_Ints[PREG->u.sss.s2])) {
Int sc = Yap_Ints[PREG->u.sss.s2];
if (sl_overflow(Yap_Ints[PREG->u.sss.s1],sc)) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]<<Yap_Ints[PREG->u.sss.s2];
if (sc < 0)
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]>>-sc;
else
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]<<sc;
} else {
PREG = ARITH_EXCEPTION;
GONext();
@ -12270,11 +12348,15 @@ Yap_absmi(int inp)
Op(sr_c1, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (sr_overflow(PREG->u.ssn.n,Yap_Ints[PREG->u.ssn.s1])) {
Int sc = Yap_Ints[PREG->u.ssn.s1];
if (sl_overflow(PREG->u.ssn.n,-sc)) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[PREG->u.ssn.s0] = PREG->u.ssn.n>>Yap_Ints[PREG->u.ssn.s1];
if (sc < 0)
Yap_Ints[PREG->u.ssn.s0] = PREG->u.ssn.n<<-sc;
else
Yap_Ints[PREG->u.ssn.s0] = PREG->u.ssn.n>>sc;
} else {
PREG = ARITH_EXCEPTION;
GONext();
@ -12286,7 +12368,7 @@ Yap_absmi(int inp)
Op(sr_c2, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (sr_overflow(Yap_Ints[PREG->u.ssn.s1],PREG->u.ssn.n)) {
if (sl_overflow(Yap_Ints[PREG->u.ssn.s1],-PREG->u.ssn.n)) {
PREG = ARITH_EXCEPTION;
GONext();
}
@ -12302,14 +12384,18 @@ Yap_absmi(int inp)
Op(sr, sss);
{
int off = PREG->u.sss.s0;
Int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
if (sr_overflow(Yap_Ints[PREG->u.sss.s1],Yap_Ints[PREG->u.sss.s2])) {
Int sc = Yap_Ints[PREG->u.sss.s2];
if (sl_overflow(Yap_Ints[PREG->u.sss.s1],-sc)) {
PREG = ARITH_EXCEPTION;
GONext();
}
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]>>Yap_Ints[PREG->u.sss.s2];
if (sc < 0)
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]<<-sc;
else
Yap_Ints[off] = Yap_Ints[PREG->u.sss.s1]>>sc;
} else {
PREG = ARITH_EXCEPTION;
GONext();

12
C/alloc.c
View File

@ -249,7 +249,7 @@ InitExStacks(int Trail, int Stack)
ScratchPad.ptr = NULL;
ScratchPad.sz = ScratchPad.msz = SCRATCH_START_SIZE;
AuxSp = NULL;
AuxSp = NULL;
#ifdef DEBUG
if (Yap_output_msg) {
@ -682,7 +682,9 @@ Yap_AllocCodeSpace(unsigned int size)
/* int Yap_FreeWorkSpace() - release workspace */
/************************************************************************/
#if defined(_WIN32)
#if defined(_WIN32) || defined(__CYGWIN__)
#undef DEBUG_WIN32_ALLOC
#include "windows.h"
@ -1413,7 +1415,7 @@ Yap_InitExStacks(int Trail, int Stack)
#endif
}
#if defined(_WIN32)
#if defined(_WIN32) || defined(__CYGWIN__)
#define WorkSpaceTop brk
#define MAP_FIXED 1
#endif
@ -1433,7 +1435,7 @@ Yap_ExtendWorkSpace(Int s)
UInt
Yap_ExtendWorkSpaceThroughHole(UInt s)
{
#if USE_MMAP || defined(_WIN32)
#if USE_MMAP || defined(_WIN32) || defined(__CYGWIN__)
MALLOC_T WorkSpaceTop0 = WorkSpaceTop;
#if SIZEOF_INT_P==4
while (WorkSpaceTop < (MALLOC_T)0xc0000000L) {
@ -1466,7 +1468,7 @@ Yap_ExtendWorkSpaceThroughHole(UInt s)
void
Yap_AllocHole(UInt actual_request, UInt total_size)
{
#if (USE_MMAP || defined(_WIN32)) && !USE_DL_MALLOC
#if (USE_MMAP || defined(_WIN32) || defined(__CYGWIN__)) && !USE_DL_MALLOC
/* where we were when the hole was created,
also where is the hole store */
ADDR WorkSpaceTop0 = WorkSpaceTop-total_size;

41
C/amasm.c
View File

@ -483,8 +483,11 @@ a_lucl(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip,
LogUpdIndex *lcl = (LogUpdIndex *)cip->code_addr;
code_p->opc = emit_op(opcode);
code_p->u.Ills.I = lcl;
cip->cpc->rnd4 = (CELL)code_p;
cip->current_try_lab = &code_p->u.Ills.l1;
cip->current_trust_lab = &code_p->u.Ills.l2;
code_p->u.Ills.l1 = NULL;
code_p->u.Ills.l2 = NULL;
code_p->u.Ills.s = cip->cpc->rnd3;
}
GONEXT(Ills);
@ -714,12 +717,12 @@ 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.s0 = IntegerOfTerm(cpc->rnd1);
code_p->u.ssd.s1 = IntegerOfTerm(cpc->rnd2);
code_p->u.ssd.d[0] = (CELL)FunctorDouble;
code_p->u.ssd.d[1] = RepAppl(cpc->rnd1)[1];
code_p->u.ssd.d[1] = RepAppl(cpc->rnd3)[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
code_p->u.ssd.d[2] = RepAppl(cpc->rnd1)[2];
code_p->u.ssd.d[2] = RepAppl(cpc->rnd3)[2];
#endif
}
GONEXT(ssd);
@ -731,9 +734,9 @@ 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);
code_p->u.ssn.s0 = IntegerOfTerm(cpc->rnd1);
code_p->u.ssn.s1 = IntegerOfTerm(cpc->rnd2);
code_p->u.ssn.n = IntegerOfTerm(cpc->rnd3);
}
GONEXT(ssn);
return code_p;
@ -744,9 +747,9 @@ 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;
code_p->u.sss.s0 = IntegerOfTerm(cpc->rnd1);
code_p->u.sss.s1 = IntegerOfTerm(cpc->rnd2);
code_p->u.sss.s2 = IntegerOfTerm(cpc->rnd3);
}
GONEXT(sss);
return code_p;
@ -1999,18 +2002,8 @@ a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut, yamop *cod
Yap_NewCps++;
Yap_LiveCps++;
#endif
if (opcode == try_op) {
/*
use the last n field to keep a chain with all
try-retry-trust
instructions allocated in this run
*/
newcp->u.OtaLl.n = cip->try_instructions;
cip->try_instructions = newcp;
} else {
newcp->u.OtaLl.n = *cip->current_try_lab;
*cip->current_try_lab = newcp;
}
newcp->u.OtaLl.n = NULL;
*cip->current_try_lab = newcp;
if (opcode == _try_clause) {
newcp->opc = emit_op(_try_logical);
newcp->u.OtaLl.s = emit_count(opr);
@ -2023,6 +2016,7 @@ a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut, yamop *cod
newcp->opc = emit_op(_retry_logical);
newcp->u.OtaLl.s = emit_count(opr);
} else {
/* trust */
if (ap->PredFlags & CountPredFlag)
newcp->opc = emit_op(_count_trust_logical);
else if (ap->PredFlags & ProfiledPredFlag)
@ -3754,6 +3748,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case index_blob_op:
code_p = a_e(_index_blob, code_p, pass_no);
break;
case index_long_op:
code_p = a_e(_index_long, code_p, pass_no);
break;
case mark_initialised_pvars_op:
if (!ystop_found) {
code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);

12
C/arith1.c
View File

@ -441,6 +441,7 @@ eval1(Int fi, Term t) {
} else {
dbl = mpz_get_d(Yap_BigIntOfTerm(t));
}
break;
#endif
case db_ref_e:
RERROR();
@ -474,6 +475,7 @@ eval1(Int fi, Term t) {
} else {
dbl = mpz_get_d(Yap_BigIntOfTerm(t));
}
break;
#endif
case db_ref_e:
RERROR();
@ -508,6 +510,7 @@ eval1(Int fi, Term t) {
} else {
dbl = mpz_get_d(Yap_BigIntOfTerm(t));
}
break;
#endif
case db_ref_e:
RERROR();
@ -543,6 +546,7 @@ eval1(Int fi, Term t) {
} else {
dbl = mpz_get_d(Yap_BigIntOfTerm(t));
}
break;
#endif
case db_ref_e:
RERROR();
@ -629,7 +633,7 @@ eval1(Int fi, Term t) {
RERROR();
}
case op_msb:
switch (ETypeOfTerm(f)) {
switch (ETypeOfTerm(t)) {
case long_int_e:
RINT(msb(IntegerOfTerm(t)));
case double_e:
@ -644,7 +648,7 @@ eval1(Int fi, Term t) {
RERROR();
}
case op_ffracp:
switch (ETypeOfTerm(f)) {
switch (ETypeOfTerm(t)) {
case long_int_e:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", IntegerOfTerm(t));
@ -673,7 +677,7 @@ eval1(Int fi, Term t) {
RERROR();
}
case op_fintp:
switch (ETypeOfTerm(f)) {
switch (ETypeOfTerm(t)) {
case long_int_e:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t));
@ -698,7 +702,7 @@ eval1(Int fi, Term t) {
RERROR();
}
case op_sign:
switch (ETypeOfTerm(f)) {
switch (ETypeOfTerm(t)) {
case long_int_e:
{
Int x = IntegerOfTerm(t);

10
C/arith2.c
View File

@ -74,6 +74,9 @@ p_mod(Term t1, Term t2) {
Int mod;
if (i2 == 0) goto zero_divisor;
if (i1 == Int_MIN && i2 == -1) {
return Yap_gmp_add_ints(Int_MAX, 1);
}
mod = i1%i2;
if (mod && (mod ^ i2) < 0)
mod += i2;
@ -163,6 +166,9 @@ p_rem(Term t1, Term t2) {
Int mod;
if (i2 == 0) goto zero_divisor;
if (i1 == Int_MIN && i2 == -1) {
return Yap_gmp_add_ints(Int_MAX, 1);
}
mod = i1%i2;
RINT(i1%i2);
}
@ -358,7 +364,7 @@ p_xor(Term t1, Term t2)
{
MP_INT new;
mpz_init_set_si(&new,IntOfTerm(t1));
mpz_init_set_si(&new,IntegerOfTerm(t1));
mpz_xor(&new, &new, Yap_BigIntOfTerm(t2));
RBIG(&new);
}
@ -1072,7 +1078,7 @@ p_binary_is(void)
if (t2 == 0L)
return FALSE;
if (IsIntTerm(t)) {
return Yap_unify_constant(ARG1,eval2(IntOfTerm(t), t1, t2));
return Yap_unify_constant(ARG1,eval2(IntegerOfTerm(t), t1, t2));
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);

9
C/cdmgr.c
View File

@ -1094,6 +1094,7 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
return;
case _index_dbref:
case _index_blob:
case _index_long:
ipc = NEXTOP(ipc,e);
break;
case _lock_lu:
@ -2050,7 +2051,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
LOCK(p->PELock);
pflags = p->PredFlags;
/* we are redefining a prolog module predicate */
if ((pflags & (UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryTestPredFlag)) ||
if ((pflags & (UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) ||
(p->ModuleOfPred == PROLOG_MODULE &&
mod != TermProlog && mod) ) {
addcl_permission_error(RepAtom(at), Arity, FALSE);
@ -4191,7 +4192,7 @@ p_system_pred(void)
return FALSE;
return(!pe->ModuleOfPred || /* any predicate in prolog module */
/* any C-pred */
pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|AsmPredFlag|TestPredFlag) ||
pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryPredFlag|AsmPredFlag|TestPredFlag) ||
/* any weird user built-in */
pe->OpcodeOfPred == Yap_opcode(_try_userc));
}
@ -4243,7 +4244,7 @@ p_all_system_pred(void)
}
return(!pe->ModuleOfPred || /* any predicate in prolog module */
/* any C-pred */
pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|AsmPredFlag|TestPredFlag) ||
pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryPredFlag|AsmPredFlag|TestPredFlag) ||
/* any weird user built-in */
pe->OpcodeOfPred == Yap_opcode(_try_userc));
}
@ -5271,7 +5272,7 @@ p_static_pred_statistics(void)
if (pe == NIL)
return (FALSE);
LOCK(pe->PELock);
if (pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|UserCPredFlag|AsmPredFlag|CPredFlag|BinaryTestPredFlag)) {
if (pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|UserCPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) {
/* should use '$recordedp' in this case */
UNLOCK(pe->PELock);
return FALSE;

50
C/cmppreds.c
View File

@ -585,21 +585,21 @@ a_cmp(Term t1, Term t2)
} else if (IsBigIntTerm(t1)) {
#ifdef USE_GMP
{
t2 = Yap_Eval(t2);
MP_INT *b1 = Yap_BigIntOfTerm(t1);
MP_INT *b1 = Yap_BigIntOfTerm(t1);
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return int_cmp(mpz_cmp_si(b1,i2));
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(2);
return flt_cmp(mpz_get_d(b1)-f2);
} else if (IsBigIntTerm(t2)) {
MP_INT *b2 = Yap_BigIntOfTerm(2);
return int_cmp(mpz_cmp(b1,b2));
} else {
return FALSE;
}
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return int_cmp(mpz_cmp_si(b1,i2));
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
return flt_cmp(mpz_get_d(b1)-f2);
} else if (IsBigIntTerm(t2)) {
MP_INT *b2 = Yap_BigIntOfTerm(2);
return int_cmp(mpz_cmp(b1,b2));
} else {
return FALSE;
}
}
#endif
} else {
@ -737,17 +737,17 @@ a_gen_ge(Term t1, Term t2)
void
Yap_InitCmpPreds(void)
{
Yap_InitCmpPred("=:=", 2, a_eq, SafePredFlag | BinaryTestPredFlag);
Yap_InitCmpPred("=\\=", 2, a_dif, SafePredFlag | BinaryTestPredFlag);
Yap_InitCmpPred(">", 2, a_gt, SafePredFlag | BinaryTestPredFlag);
Yap_InitCmpPred("=<", 2, a_le, SafePredFlag | BinaryTestPredFlag);
Yap_InitCmpPred("<", 2, a_lt, SafePredFlag | BinaryTestPredFlag);
Yap_InitCmpPred(">=", 2, a_ge, SafePredFlag | BinaryTestPredFlag);
Yap_InitCmpPred("=:=", 2, a_eq, SafePredFlag | BinaryPredFlag);
Yap_InitCmpPred("=\\=", 2, a_dif, SafePredFlag | BinaryPredFlag);
Yap_InitCmpPred(">", 2, a_gt, SafePredFlag | BinaryPredFlag);
Yap_InitCmpPred("=<", 2, a_le, SafePredFlag | BinaryPredFlag);
Yap_InitCmpPred("<", 2, a_lt, SafePredFlag | BinaryPredFlag);
Yap_InitCmpPred(">=", 2, a_ge, SafePredFlag | BinaryPredFlag);
Yap_InitCPred("$a_compare", 3, p_acomp, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCmpPred("\\==", 2, a_noteq, BinaryTestPredFlag | SafePredFlag);
Yap_InitCmpPred("@<", 2, a_gen_lt, BinaryTestPredFlag | SafePredFlag);
Yap_InitCmpPred("@=<", 2, a_gen_le, BinaryTestPredFlag | SafePredFlag);
Yap_InitCmpPred("@>", 2, a_gen_gt, BinaryTestPredFlag | SafePredFlag);
Yap_InitCmpPred("@>=", 2, a_gen_ge, BinaryTestPredFlag | SafePredFlag);
Yap_InitCmpPred("\\==", 2, a_noteq, BinaryPredFlag | SafePredFlag);
Yap_InitCmpPred("@<", 2, a_gen_lt, BinaryPredFlag | SafePredFlag);
Yap_InitCmpPred("@=<", 2, a_gen_le, BinaryPredFlag | SafePredFlag);
Yap_InitCmpPred("@>", 2, a_gen_gt, BinaryPredFlag | SafePredFlag);
Yap_InitCmpPred("@>=", 2, a_gen_ge, BinaryPredFlag | SafePredFlag);
Yap_InitCPred("compare", 3, p_compare, TestPredFlag | SafePredFlag);
}

149
C/compiler.c
View File

@ -678,9 +678,9 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
CELL l1 = ++cglobs->labelno;
CELL *src = RepAppl(t);
PInstr *ocpc = cglobs->cint.cpc, *OCodeStart = cglobs->cint.CodeStart;
Int sz = sizeof(CELL)+
Int sz = 2*sizeof(CELL)+
sizeof(MP_INT)+
((((MP_INT *)(RepAppl(t)+1))->_mp_alloc)*sizeof(mp_limb_t));
((((MP_INT *)(RepAppl(t)+2))->_mp_alloc)*sizeof(mp_limb_t));
CELL *dest;
/* use a special list to store the blobs */
@ -1381,11 +1381,11 @@ IsTrueGoal(Term t) {
static void
c_p_put(Term Goal, op_numbers op_var, op_numbers op_val, compiler_struct * cglobs)
{
Term t = Deref(ArgOfTerm(1, Goal));
Term t = Deref(ArgOfTerm(2, 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);
(++cglobs->nvars,op_var) : op_val), t, IntegerOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
tag_var(t, new, cglobs);
}
@ -1426,7 +1426,17 @@ emit_special_label(Term Goal, compiler_struct *cglobs)
break;
}
case SPECIAL_LABEL_CLEAR:
return;
switch (lab_id) {
case SPECIAL_LABEL_EXCEPTION:
cglobs->cint.exception_handler = 0L;
break;
case SPECIAL_LABEL_SUCCESS:
cglobs->cint.success_handler = 0L;
break;
case SPECIAL_LABEL_FAILURE:
cglobs->cint.failure_handler = 0L;
break;
}
}
}
@ -1850,165 +1860,165 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
#endif
}
return;
} else if (op >= _p_put_fi && op <= _p_sl) {
} else if (op >= _p_put_fi && op <= _p_label_ctl) {
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;
return;
case _p_get_i:
c_p_put(Goal, get_i_op, get_i_op, cglobs);
break;
return;
case _p_get_f:
c_p_put(Goal, get_f_op, get_f_op, cglobs);
break;
return;
case _p_put_fi:
c_p_put(Goal, put_fi_var_op, put_fi_val_op, cglobs);
break;
return;
case _p_put_i:
c_p_put(Goal, put_i_var_op, put_i_val_op, cglobs);
break;
return;
case _p_put_f:
c_p_put(Goal, put_f_var_op, put_f_val_op, cglobs);
break;
return;
case _p_a_eq_float:
Yap_emit(a_eqc_float_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
return;
case _p_a_eq_int:
Yap_emit(a_eqc_int_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
return;
case _p_a_eq:
Yap_emit(a_eq_op, IntOfTerm(ArgOfTerm(1, Goal)), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
return;
case _p_ltc_float:
Yap_emit(ltc_float_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
return;
case _p_ltc_int:
Yap_emit(ltc_int_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
return;
case _p_lt:
Yap_emit(lt_op, IntOfTerm(ArgOfTerm(1, Goal)), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
Yap_emit(lt_op, IntOfTerm(ArgOfTerm(1, Goal)), IntOfTerm(ArgOfTerm(2, Goal)), &cglobs->cint);
return;
case _p_gtc_float:
Yap_emit(gtc_float_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
return;
case _p_gtc_int:
Yap_emit(gtc_int_op, ArgOfTerm(2, Goal), IntOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
break;
return;
case _p_add_float_c:
Yap_emit_3ops(add_float_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_add_int_c:
Yap_emit_3ops(add_int_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_add:
Yap_emit_3ops(add_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_sub_float_c:
Yap_emit_3ops(sub_float_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_sub_int_c:
Yap_emit_3ops(sub_int_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_sub:
Yap_emit_3ops(sub_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_mul_float_c:
Yap_emit_3ops(mul_float_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_mul_int_c:
Yap_emit_3ops(mul_int_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_mul:
Yap_emit_3ops(mul_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_fdiv_c1:
Yap_emit_3ops(fdiv_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_fdiv_c2:
Yap_emit_3ops(fdiv_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_fdiv:
Yap_emit_3ops(fdiv_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_idiv_c1:
Yap_emit_3ops(idiv_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_idiv_c2:
Yap_emit_3ops(idiv_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_idiv:
Yap_emit_3ops(idiv_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_mod_c1:
Yap_emit_3ops(mod_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_mod_c2:
Yap_emit_3ops(mod_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_mod:
Yap_emit_3ops(mod_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_rem_c1:
Yap_emit_3ops(rem_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_rem_c2:
Yap_emit_3ops(rem_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_rem:
Yap_emit_3ops(rem_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_land_c:
Yap_emit_3ops(a_and_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_land:
Yap_emit_3ops(a_and_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_lor_c:
Yap_emit_3ops(a_or_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_lor:
Yap_emit_3ops(a_or_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_xor_c:
Yap_emit_3ops(xor_c_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_xor:
Yap_emit_3ops(xor_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_uminus:
Yap_emit(uminus_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), &cglobs->cint);
break;
return;
case _p_sr_c1:
Yap_emit_3ops(sr_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_sr_c2:
Yap_emit_3ops(sr_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_sr:
Yap_emit_3ops(sr_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_sl_c1:
Yap_emit_3ops(sl_c1_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_sl_c2:
Yap_emit_3ops(sl_c2_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_sl:
Yap_emit_3ops(sl_op, ArgOfTerm(1,Goal), ArgOfTerm(2,Goal), ArgOfTerm(3,Goal), &cglobs->cint);
break;
return;
case _p_label_ctl:
emit_special_label(Goal, cglobs);
break;
return;
}
} else {
c_args(Goal, 0, cglobs);
}
}
#ifdef BEAM
else if (p->PredFlags & BinaryTestPredFlag && !EAM) {
else if (p->PredFlags & BinaryPredFlag && !EAM) {
#else
else if (p->PredFlags & BinaryTestPredFlag) {
else if (p->PredFlags & BinaryPredFlag) {
#endif
Term a1 = ArgOfTerm(1,Goal);
@ -2184,7 +2194,7 @@ c_body(Term Body, int mod, compiler_struct *cglobs)
while (IsNonVarTerm(Body) && IsApplTerm(Body)
&& FunctorOfTerm(Body) == FunctorComma) {
Term t2 = ArgOfTerm(2, Body);
if (IsTrueGoal(t2)) {
if (!cglobs->cint.success_handler && IsTrueGoal(t2)) {
/* optimise the case where some idiot left trues at the end
of the clause.
*/
@ -2262,6 +2272,15 @@ usesvar(compiler_vm_op ic)
case f_var_op:
case fetch_args_for_bccall:
case bccall_op:
case get_fi_op:
case get_i_op:
case get_f_op:
case put_fi_var_op:
case put_i_var_op:
case put_f_var_op:
case put_fi_val_op:
case put_i_val_op:
case put_f_val_op:
return TRUE;
default:
break;
@ -2556,6 +2575,9 @@ CheckUnsafe(PInstr *pc, compiler_struct *cglobs)
case save_appl_op:
case save_pair_op:
case f_var_op:
case put_fi_var_op:
case put_i_var_op:
case put_f_var_op:
{
Ventry *v = (Ventry *) (pc->rnd1);
@ -2995,6 +3017,15 @@ c_layout(compiler_struct *cglobs)
#endif
case fetch_args_for_bccall:
case bccall_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:
checktemp(arg, rn, ic, cglobs);
break;
case get_atom_op:

57
C/computils.c
View File

@ -144,7 +144,7 @@ is_a_test(Term arg, Term mod)
}
return FALSE;
}
return pe->PredFlags & (TestPredFlag|BinaryTestPredFlag);
return pe->PredFlags & (TestPredFlag|BinaryPredFlag);
}
}
return FALSE;
@ -664,6 +664,7 @@ static char *opformat[] =
"if_not_then\t%i\t%h\t%h\t%h",
"index_on_dbref",
"index_on_blob",
"index_on_long",
"check_var\t %r",
"save_pair\t%v",
"save_appl\t%v",
@ -735,7 +736,59 @@ static char *opformat[] =
#endif
"fetch_args_for_bccall\t%v",
"binary_cfunc\t\t%v,%P",
"blob\t%O"
"blob\t%O",
"get_number\t",
"get_integer\t",
"get_float\t",
"put_number_on_var\t",
"put_float_on_var\t",
"put_integer_on_var\t",
"put_number_on_val\t",
"put_float_on_val\t",
"put_integer_on_val\t",
"equal_floats\n",
"equal_ints\n",
"equal_numbers\n",
"lt_floats\n",
"lt_ints\n",
"lt_numbers\n",
"gt_floats\n",
"gt_ints\n",
"add_float\n",
"add_int\n",
"add\n",
"sub_float\n",
"sub_int\n",
"sub\n",
"mul_float\n",
"mul_int\n",
"mul\n",
"shift_right_constant\n",
"shift_right_by_constant\n",
"shift_right\n",
"shift_left_constant\n",
"shift_left_by_constant\n",
"shift_left\n",
"divide_constant\n",
"divide_by_constant\n",
"divide\n",
"integer_divide_constant\n",
"integer_divide_by_constant\n",
"integer_divide\n",
"mod_constant\n",
"mod_by_constant\n",
"mod\n",
"rem_constant\n",
"rem_by_constant\n",
"rem\n",
"and_constant\n",
"and\n",
"or_constant\n",
"or\n",
"xor_constant\n",
"xor\n",
"uminus\n",
"label_control\n"
#ifdef SFUNC
,
"get_s_f_op\t%f,%r",

2
C/dbase.c
View File

@ -5395,7 +5395,7 @@ p_install_thread_local(void)
return FALSE;
}
LOCK(pe->PELock);
if (pe->PredFlags & (UserCPredFlag|HiddenPredFlag|CArgsPredFlag|SyncPredFlag|TestPredFlag|AsmPredFlag|StandardPredFlag|CPredFlag|SafePredFlag|IndexedPredFlag|BinaryTestPredFlag) ||
if (pe->PredFlags & (UserCPredFlag|HiddenPredFlag|CArgsPredFlag|SyncPredFlag|TestPredFlag|AsmPredFlag|StandardPredFlag|CPredFlag|SafePredFlag|IndexedPredFlag|BinaryPredFlag) ||
pe->cs.p_code.NOfClauses) {
return FALSE;
}

2
C/eval.c
View File

@ -35,7 +35,7 @@ Eval(Term t)
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic");
P = (yamop *)FAILCODE;
return 0L;;
return 0L;
} else if (IsAtomTerm(t)) {
ExpEntry *p;
Atom name = AtomOfTerm(t);

2
C/exec.c
View File

@ -2034,7 +2034,7 @@ Yap_InitYaamRegs(void)
WPP = NULL;
PREG_ADDR = NULL;
#endif
Yap_AllocateDefaultArena(1024, 2);
Yap_AllocateDefaultArena(1024*1024, 2);
Yap_PreAllocCodeSpace();
#ifdef CUT_C
cut_c_initialize();

42
C/gmp_support.c
View File

@ -134,17 +134,6 @@ Yap_gmp_div_big_int(MP_INT *b, Int i)
mpz_init_set(&new, b);
if (yap_flags[INTEGER_ROUNDING_FLAG] == 0) {
if (i > 0) {
mpz_fdiv_q_ui(&new, &new, i);
} else if (i == 0) {
Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
return 0L;
} else {
/* we do not handle MIN_INT */
mpz_fdiv_q_ui(&new, &new, -i);
mpz_neg(&new, &new);
}
} else {
if (i > 0) {
mpz_tdiv_q_ui(&new, &new, i);
} else if (i == 0) {
@ -155,6 +144,17 @@ Yap_gmp_div_big_int(MP_INT *b, Int i)
mpz_tdiv_q_ui(&new, &new, -i);
mpz_neg(&new, &new);
}
} else {
if (i > 0) {
mpz_fdiv_q_ui(&new, &new, i);
} else if (i == 0) {
Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
return 0L;
} else {
/* we do not handle MIN_INT */
mpz_fdiv_q_ui(&new, &new, -i);
mpz_neg(&new, &new);
}
}
return Yap_MkBigIntTerm(&new);
}
@ -241,9 +241,9 @@ Yap_gmp_div_big_big(MP_INT *b1, MP_INT *b2)
mpz_init_set(&new, b1);
if (yap_flags[INTEGER_ROUNDING_FLAG] == 0) {
mpz_fdiv_q(&new, &new, b2);
} else {
mpz_tdiv_q(&new, &new, b2);
} else {
mpz_fdiv_q(&new, &new, b2);
}
return Yap_MkBigIntTerm(&new);
}
@ -268,28 +268,28 @@ Yap_gmp_ior_big_big(MP_INT *b1, MP_INT *b2)
return Yap_MkBigIntTerm(&new);
}
Float
Term
Yap_gmp_add_float_big(Float d, MP_INT *b)
{
return d+mpz_get_d(b);
return MkFloatTerm(d+mpz_get_d(b));
}
Float
Term
Yap_gmp_sub_float_big(Float d, MP_INT *b)
{
return d-mpz_get_d(b);
return MkFloatTerm(d-mpz_get_d(b));
}
Float
Term
Yap_gmp_sub_big_float(MP_INT *b, Float d)
{
return mpz_get_d(b)-d;
return MkFloatTerm(mpz_get_d(b)-d);
}
Float
Term
Yap_gmp_mul_float_big(Float d, MP_INT *b)
{
return d*mpz_get_d(b);
return MkFloatTerm(d*mpz_get_d(b));
}
#endif

1
C/grow.c
View File

@ -1067,6 +1067,7 @@ fix_compiler_instructions(PInstr *pcpc)
case if_not_op:
case index_dbref_op:
case index_blob_op:
case index_long_op:
case if_nonvar_op:
case unify_last_list_op:
case write_last_list_op:

68
C/index.c
View File

@ -499,7 +499,7 @@ static char SccsId[] = "%W% %G%";
UInt STATIC_PROTO(do_index, (ClauseDef *,ClauseDef *,struct intermediates *,UInt,UInt,int,int,CELL *));
UInt STATIC_PROTO(do_compound_index, (ClauseDef *,ClauseDef *,Term *t,struct intermediates *,UInt,UInt,UInt,UInt,int,int,int,CELL *,int));
UInt STATIC_PROTO(do_dbref_index, (ClauseDef *,ClauseDef *,Term,struct intermediates *,UInt,UInt,int,int,CELL *));
UInt STATIC_PROTO(do_blob_index, (ClauseDef *,ClauseDef *,Term,struct intermediates *,UInt,UInt,int,int,CELL *));
UInt STATIC_PROTO(do_blob_index, (ClauseDef *,ClauseDef *,Term,struct intermediates *,UInt,UInt,int,int,CELL *,int));
static UInt
cleanup_sw_on_clauses(CELL larg, UInt sz, OPCODE ecls)
@ -555,6 +555,23 @@ recover_from_failed_susp_on_cls(struct intermediates *cint, UInt sz)
while (cpc) {
switch(cpc->op) {
case enter_lu_op:
if (cpc->rnd4) {
yamop *code_p = (yamop *)cpc->rnd4;
yamop *first = code_p->u.Ills.l1;
yamop *last = code_p->u.Ills.l2;
while (first) {
yamop *next = first->u.OtaLl.n;
LogUpdClause *cl = first->u.OtaLl.d;
cl->ClRefCount--;
Yap_FreeCodeSpace((char *)first);
if (first == last)
break;
first = next;
}
}
cpc->rnd4 = Zero;
break;
case jump_v_op:
case jump_nv_op:
sz = cleanup_sw_on_clauses(cpc->rnd1, sz, ecls);
@ -617,6 +634,10 @@ recover_from_failed_susp_on_cls(struct intermediates *cint, UInt sz)
}
cpc = cpc->nextInst;
}
if (cint->code_addr) {
Yap_FreeCodeSpace((char *)cint->code_addr);
cint->code_addr = NULL;
}
return sz;
}
@ -1032,6 +1053,7 @@ has_cut(yamop *pc)
case _count_a_call:
case _index_dbref:
case _index_blob:
case _index_long:
#ifdef YAPOR
case _getwork_first_time:
#endif /* YAPOR */
@ -2303,7 +2325,7 @@ do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group, struct intermediates
ncls = (cf-c0)+1;
else
ncls = 0;
Yap_emit_3ops(enter_lu_op, labl_dyn0, labl_dynf, ncls, cint);
Yap_emit_4ops(enter_lu_op, labl_dyn0, labl_dynf, ncls, Zero, cint);
Yap_emit(label_op, labl_dyn0, Zero, cint);
}
if (c0 == cf) {
@ -2655,8 +2677,10 @@ do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef)
ifs->u.Label = do_dbref_index(min, max, t, cint, argno, nxtlbl, first, clleft, top);
else if (f == FunctorLongInt)
ifs->u.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first, clleft, top, FALSE);
else
ifs->u.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first, clleft, top);
ifs->u.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first, clleft, top, TRUE);
} else {
CELL *sreg;
@ -2726,7 +2750,7 @@ emit_protection_choicepoint(int first, int clleft, UInt nxtlbl, struct intermedi
if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
UInt labl = new_label(cint);
Yap_emit_3ops(enter_lu_op, labl, labl, 0, cint);
Yap_emit_4ops(enter_lu_op, labl, labl, 0, Zero, cint);
Yap_emit(label_op, labl, Zero, cint);
}
Yap_emit(tryme_op, nxtlbl, (clleft << 1), cint);
@ -3173,7 +3197,7 @@ do_dbref_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cin
}
static UInt
do_blob_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cint, UInt argno, UInt fail_l, int first, int clleft, CELL *top)
do_blob_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cint, UInt argno, UInt fail_l, int first, int clleft, CELL *top, int blob)
{
UInt ngroups;
GroupDef *group;
@ -3185,13 +3209,16 @@ do_blob_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cint
while (cl <= max) {
if (cl->u.t_ptr == (CELL)NULL) { /* check whether it is a builtin */
cl->Tag = Zero;
} else {
} else if (blob) {
CELL *pt = RepAppl(cl->u.t_ptr);
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
cl->Tag = MkIntTerm(pt[1]^pt[2]);
#else
cl->Tag = MkIntTerm(pt[1]);
#endif
} else {
CELL *pt = RepAppl(cl->u.t_ptr);
cl->Tag = MkIntTerm((pt[1] & (MAX_ABS_INT-1)));
}
cl++;
}
@ -3202,7 +3229,10 @@ do_blob_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cint
int labl = new_label(cint);
Yap_emit(label_op, labl, Zero, cint);
Yap_emit(index_blob_op, Zero, Zero, cint);
if (blob)
Yap_emit(index_blob_op, Zero, Zero, cint);
else
Yap_emit(index_long_op, Zero, Zero, cint);
sort_group(group,(CELL *)(group+1),cint);
do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)group+1);
return labl;
@ -3997,6 +4027,12 @@ expand_index(struct intermediates *cint) {
s_reg = NULL;
ipc = NEXTOP(ipc,e);
break;
case _index_long:
t = MkIntTerm((s_reg[0] & (MAX_ABS_INT-1)));
sp[-1].extra = AbsAppl(s_reg-1);
s_reg = NULL;
ipc = NEXTOP(ipc,e);
break;
/* instructions type e */
case _switch_on_type:
t = Deref(ARG1);
@ -5756,6 +5792,13 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
}
ipc = NEXTOP(ipc,e);
break;
case _index_long:
{
CELL *pt = RepAppl(cls->u.t_ptr);
cls->Tag = MkIntTerm((pt[1] & (MAX_ABS_INT-1)));
}
ipc = NEXTOP(ipc,e);
break;
case _switch_on_cons:
case _if_cons:
case _go_on_cons:
@ -6247,6 +6290,13 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
}
ipc = NEXTOP(ipc,e);
break;
case _index_long:
{
CELL *pt = RepAppl(cls->u.t_ptr);
cls->Tag = MkIntTerm(pt[1] & (MAX_ABS_INT-1));
}
ipc = NEXTOP(ipc,e);
break;
case _switch_on_cons:
case _if_cons:
case _go_on_cons:
@ -6902,6 +6952,10 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
#endif
ipc = NEXTOP(ipc,e);
break;
case _index_long:
t = MkIntTerm(s_reg[0] & (MAX_ABS_INT-1));
ipc = NEXTOP(ipc,e);
break;
case _switch_on_cons:
case _if_cons:
case _go_on_cons:

1
C/init.c
View File

@ -1230,6 +1230,7 @@ InitCodes(void)
Yap_heap_regs->pred_static_clause = RepPredProp(PredPropByFunc(FunctorDoStaticClause,PROLOG_MODULE));
Yap_heap_regs->pred_throw = RepPredProp(PredPropByFunc(FunctorThrow,PROLOG_MODULE));
Yap_heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(FunctorHandleThrow,PROLOG_MODULE));
Yap_heap_regs->pred_is = RepPredProp(PredPropByFunc(FunctorIs,PROLOG_MODULE));
Yap_heap_regs->pred_goal_expansion = RepPredProp(PredPropByFunc(FunctorGoalExpansion,USER_MODULE));
Yap_heap_regs->env_for_trustfail_code.p =
Yap_heap_regs->env_for_trustfail_code.p0 =

4
C/iopreds.c
View File

@ -1056,8 +1056,10 @@ ReadlineGetc(int sno)
while (ttyptr == NULL) {
/* Only sends a newline if we are at the start of a line */
if (myrl_line)
if (myrl_line) {
free (myrl_line);
myrl_line = NULL;
}
rl_instream = Stream[sno].u.file.file;
rl_outstream = Stream[cur_out_sno].u.file.file;
/* window of vulnerability opened */

11
C/stdpreds.c
View File

@ -333,6 +333,7 @@ STD_PROTO(static Int p_statistics_trail_info, (void));
STD_PROTO(static Term mk_argc_list, (void));
STD_PROTO(static Int p_argv, (void));
STD_PROTO(static Int p_cputime, (void));
STD_PROTO(static Int p_systime, (void));
STD_PROTO(static Int p_runtime, (void));
STD_PROTO(static Int p_walltime, (void));
STD_PROTO(static Int p_access_yap_flags, (void));
@ -817,6 +818,15 @@ p_cputime(void)
Yap_unify_constant(ARG2, MkIntegerTerm(interval)) );
}
static Int
p_systime(void)
{
Int now, interval;
Yap_systime_interval(&now, &interval);
return( Yap_unify_constant(ARG1, MkIntegerTerm(now)) &&
Yap_unify_constant(ARG2, MkIntegerTerm(interval)) );
}
static Int
p_walltime(void)
{
@ -3938,6 +3948,7 @@ Yap_InitCPreds(void)
Yap_InitCPred("$argv", 1, p_argv, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$runtime", 2, p_runtime, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$cputime", 2, p_cputime, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$systime", 2, p_systime, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$walltime", 2, p_walltime, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$access_yap_flags", 2, p_access_yap_flags, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag);

68
C/sysbits.c
View File

@ -320,6 +320,8 @@ static struct timeval StartOfTimes;
/* since last call to runtime */
static struct timeval last_time;
#endif
static struct timeval last_time_sys;
static struct timeval StartOfTimes_sys;
/* store user time in this variable */
static void
@ -334,6 +336,8 @@ InitTime (void)
getrusage(RUSAGE_SELF, &rusage);
last_time.tv_sec = StartOfTimes.tv_sec = rusage.ru_utime.tv_sec;
last_time.tv_usec = StartOfTimes.tv_usec = rusage.ru_utime.tv_usec;
last_time_sys.tv_sec = StartOfTimes_sys.tv_sec = rusage.ru_stime.tv_sec;
last_time_sys.tv_usec = StartOfTimes_sys.tv_usec = rusage.ru_stime.tv_usec;
}
@ -360,6 +364,19 @@ void Yap_cputime_interval(Int *now,Int *interval)
last_time.tv_sec = rusage.ru_utime.tv_sec;
}
void Yap_systime_interval(Int *now,Int *interval)
{
struct rusage rusage;
getrusage(RUSAGE_SELF, &rusage);
*now = (rusage.ru_stime.tv_sec - StartOfTimes_sys.tv_sec) * 1000 +
(rusage.ru_stime.tv_usec - StartOfTimes_sys.tv_usec) / 1000;
*interval = (rusage.ru_stime.tv_sec - last_time_sys.tv_sec) * 1000 +
(rusage.ru_stime.tv_usec - last_time_sys.tv_usec) / 1000;
last_time_sys.tv_usec = rusage.ru_stime.tv_usec;
last_time_sys.tv_sec = rusage.ru_stime.tv_sec;
}
#elif defined(_WIN32)
#ifdef __GNUC__
@ -389,6 +406,8 @@ void Yap_cputime_interval(Int *now,Int *interval)
static FILETIME StartOfTimes, last_time;
static FILETIME StartOfTimes_sys, last_time_sys;
static clock_t TimesStartOfTimes, Times_last_time;
/* store user time in this variable */
@ -407,6 +426,10 @@ InitTime (void)
last_time.dwHighDateTime = UserTime.dwHighDateTime;
StartOfTimes.dwLowDateTime = UserTime.dwLowDateTime;
StartOfTimes.dwHighDateTime = UserTime.dwHighDateTime;
last_time_sys.dwLowDateTime = KernelTime.dwLowDateTime;
last_time_sys.dwHighDateTime = KernelTime.dwHighDateTime;
StartOfTimes_sys.dwLowDateTime = KernelTime.dwLowDateTime;
StartOfTimes_sys.dwHighDateTime = KernelTime.dwHighDateTime;
}
}
@ -477,6 +500,34 @@ void Yap_cputime_interval(Int *now,Int *interval)
}
}
void Yap_systime_interval(Int *now,Int *interval)
{
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
*now = *interval = 0; /* not available */
} else {
#ifdef __GNUC__
unsigned long long int t1 =
sub_utime(KernelTime, StartOfTimes_sys);
unsigned long long int t2 =
sub_utime(KernelTime, last_time_sys);
do_div(t1,10000);
*now = (Int)t1;
do_div(t2,10000);
*interval = (Int)t2;
#endif
#ifdef _MSC_VER
__int64 t1 = *(__int64 *)&KernelTime - *(__int64 *)&StartOfTimes_sys;
__int64 t2 = *(__int64 *)&KernelTime - *(__int64 *)&last_time_sys;
*now = (Int)(t1/10000);
*interval = (Int)(t2/10000);
#endif
last_time_sys.dwLowDateTime = KernelTime.dwLowDateTime;
last_time_sys.dwHighDateTime = KernelTime.dwHighDateTime;
}
}
#elif HAVE_TIMES
#if defined(_WIN32)
@ -520,6 +571,8 @@ void Yap_cputime_interval(Int *now,Int *interval)
static clock_t StartOfTimes, last_time;
static clock_t StartOfTimes_sys, last_time_sys;
/* store user time in this variable */
static void
InitTime (void)
@ -527,6 +580,7 @@ InitTime (void)
struct tms t;
times (&t);
last_time = StartOfTimes = t.tms_utime;
last_time_sys = StartOfTimes_sys = t.tms_stime;
}
UInt
@ -546,6 +600,15 @@ void Yap_cputime_interval(Int *now,Int *interval)
last_time = t.tms_utime;
}
void Yap_systime_interval(Int *now,Int *interval)
{
struct tms t;
times (&t);
*now = ((t.tms_stime - StartOfTimes_sys)*1000) / TicksPerSec;
*interval = (t.tms_stime - last_time_sys) * 1000 / TicksPerSec;
last_time_sys = t.tms_stime;
}
#else /* HAVE_TIMES */
#ifdef SIMICS
@ -597,6 +660,11 @@ void Yap_cputime_interval(Int *now,Int *interval)
last_time.tv_sec = tp.tv_sec;
}
void Yap_systime_interval(Int *now,Int *interval)
{
*now = *interval = 0; /* not available */
}
#endif /* SIMICS */
#ifdef COMMENTED_OUT

2
H/Heap.h
View File

@ -399,6 +399,7 @@ typedef struct various_codes {
struct pred_entry *pred_static_clause;
struct pred_entry *pred_throw;
struct pred_entry *pred_handle_throw;
struct pred_entry *pred_is;
struct DB_STRUCT *db_erased_marker;
struct logic_upd_clause *logdb_erased_marker;
struct logic_upd_clause *db_erased_list;
@ -588,6 +589,7 @@ extern struct various_codes *Yap_heap_regs;
#define PredStaticClause Yap_heap_regs->pred_static_clause
#define PredThrow Yap_heap_regs->pred_throw
#define PredHandleThrow Yap_heap_regs->pred_handle_throw
#define PredIs Yap_heap_regs->pred_is
#define DBErasedMarker Yap_heap_regs->db_erased_marker
#define LogDBErasedMarker Yap_heap_regs->logdb_erased_marker
#define DBErasedList Yap_heap_regs->db_erased_list

1
H/YapOpcodes.h
View File

@ -231,6 +231,7 @@
OPCODE(if_cons ,sssl),
OPCODE(index_dbref ,e),
OPCODE(index_blob ,e),
OPCODE(index_long ,e),
OPCODE(p_atom_x ,xl),
OPCODE(p_atom_y ,yl),
OPCODE(p_atomic_x ,xl),

3
H/Yapproto.h
View File

@ -316,8 +316,9 @@ void STD_PROTO(Yap_InitSysPath,(void));
#ifdef MAC
void STD_PROTO(Yap_SetTextFile,(char *));
#endif
void STD_PROTO(Yap_cputime_interval,(Int *,Int *));
int STD_PROTO(Yap_getcwd,(const char *, int));
void STD_PROTO(Yap_cputime_interval,(Int *,Int *));
void STD_PROTO(Yap_systime_interval,(Int *,Int *));
void STD_PROTO(Yap_walltime_interval,(Int *,Int *));
void STD_PROTO(Yap_InitSysbits,(void));
void STD_PROTO(Yap_InitSysPreds,(void));

2
H/Yatom.h
View File

@ -659,7 +659,7 @@ typedef enum
CompiledPredFlag = 0x00000400L, /* is static */
IndexedPredFlag = 0x00000200L, /* has indexing code */
SpiedPredFlag = 0x00000100L, /* is a spy point */
BinaryTestPredFlag = 0x00000080L, /* test predicate */
BinaryPredFlag = 0x00000080L, /* test predicate */
TabledPredFlag = 0x00000040L, /* is tabled */
SequentialPredFlag = 0x00000020L, /* may not create parallel choice points! */
ProfiledPredFlag = 0x00000010L, /* pred is being profiled */

4
H/alloc.h
View File

@ -80,7 +80,7 @@ typedef struct FREEB {
#define ALIGN_SIZE(X,SIZE) (((CELL)(X)+((SIZE)-1)) & ~((SIZE)-1))
/* I'll assume page size is always a power of two */
#ifdef _WIN32
#if defined(_WIN32) || defined(__CYGWIN__)
/* in WIN32 VirtualAlloc works in multiples of 64K */
#define YAP_ALLOC_SIZE (64*1024)
#define LGPAGE_SIZE YAP_ALLOC_SIZE
@ -102,7 +102,7 @@ void STD_PROTO(Yap_InitHeap, (void *));
UInt STD_PROTO(Yap_ExtendWorkSpaceThroughHole, (UInt));
void STD_PROTO(Yap_AllocHole, (UInt, UInt));
#if USE_MMAP
#if USE_MMAP && ! defined(__CYGWIN__)
#include <sys/types.h>
#include <sys/mman.h>

43
H/arith2.h
View File

@ -22,7 +22,7 @@
inline static int
add_overflow(Int x, Int i, Int j)
{
return (i & j & ~x) | (~i & ~j & x);
return ((i & j & ~x) | (~i & ~j & x)) < 0;
}
inline static Term
@ -32,7 +32,7 @@ add_int(Int i, Int j)
#if USE_GMP
/* Integer overflow, we need to use big integers */
Int overflow = (i & j & ~x) | (~i & ~j & x);
if (overflow) {
if (overflow < 0) {
return(Yap_gmp_add_ints(i, j));
}
#endif
@ -47,7 +47,7 @@ add_int(Int i, Int j)
inline static int
sub_overflow(Int x, Int i, Int j)
{
return (i & ~j & ~x) | (~i & j & x);
return ((i & ~j & ~x) | (~i & j & x)) < 0;
}
inline static Term
@ -55,7 +55,7 @@ sub_int(Int i, Int j)
{
Int x = i-j;
#if USE_GMP
Int overflow = (i & ~j & ~x) | (~i & j & x);
Int overflow = ((i & ~j & ~x) | (~i & j & x)) < 0;
/* Integer overflow, we need to use big integers */
if (overflow) {
return(Yap_gmp_sub_ints(i, j));
@ -88,6 +88,8 @@ sub_int(Int i, Int j)
inline static int
mul_overflow(Int z, Int i1, Int i2)
{
if (i1 == Int_MIN && i2 == -1)
return TRUE;
return (i2 && z/i2 != i1);
}
@ -114,18 +116,16 @@ times_int(Int i1, Int i2) {
#if USE_GMP
static inline int
sl_overflow(Int x,Int i)
sl_overflow(Int i,Int j)
{
Int x = (8*sizeof(CELL)-2)-j;
CELL t = (1<<x)-1;
if (x < 0) return TRUE;
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)
@ -133,24 +133,14 @@ sl_overflow(Int x,Int i)
return FALSE;
}
static inline Int
sr_overflow(Int x,Int i)
{
return FALSE;
}
#endif
inline static Term
do_sll(Int i, Int j)
{
#if USE_GMP
Int x = (8*sizeof(CELL)-2)-j;
if (x < 0||
sl_overflow(x,i)) {
return(Yap_gmp_sll_ints(i, j));
if (sl_overflow(i,j)) {
return Yap_gmp_sll_ints(i, j);
}
#endif
RINT(i << j);
}
@ -337,15 +327,18 @@ p_div(Term t1, Term t2) {
case long_int_e:
/* two integers */
{
Int i2 = IntegerOfTerm(t2);
Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2);
if (i2 == 0) {
Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
/* make GCC happy */
P = (yamop *)FAILCODE;
RERROR();
} else if (i1 == Int_MIN && i2 == -1) {
return Yap_gmp_add_ints(Int_MAX, 1);
} else {
RINT(IntegerOfTerm(t1) / i2);
}
RINT(IntegerOfTerm(t1) / i2);
}
case double_e:
Yap_Error(TYPE_ERROR_INTEGER, t2, "// /2");

1
H/compile.h
View File

@ -105,6 +105,7 @@ typedef enum compiler_op {
if_not_op,
index_dbref_op,
index_blob_op,
index_long_op,
if_nonvar_op,
save_pair_op,
save_appl_op,

9
H/iatoms.h
View File

@ -66,7 +66,7 @@
AtomDoLogUpdClause0 = Yap_FullLookupAtom("$do_log_upd_clause0");
AtomDoLogUpdClauseErase = Yap_FullLookupAtom("$do_log_upd_clause_erase");
AtomDoStaticClause = Yap_FullLookupAtom("$do_static_clause");
AtomDollarU = Yap_LookupAtom("$u");
AtomDollarU = Yap_FullLookupAtom("$u");
AtomDollarUndef = Yap_FullLookupAtom("$undef");
AtomDomainError = Yap_LookupAtom("domain_error");
AtomE = Yap_LookupAtom("e");
@ -110,7 +110,7 @@
AtomGetworkSeq = Yap_FullLookupAtom("$getwork_seq");
AtomGlobal = Yap_LookupAtom("global_sp");
AtomGoalExpansion = Yap_LookupAtom("goal_expansion");
AtomHERE = Yap_LookupAtom("\n<====HERE====>\n");
AtomHERE = Yap_LookupAtom("\n <====HERE====> \n");
AtomHandleThrow = Yap_FullLookupAtom("$handle_throw");
AtomHeap = Yap_LookupAtom("heap");
AtomHeapUsed = Yap_LookupAtom("heapused");
@ -125,8 +125,10 @@
AtomIntOverflow = Yap_LookupAtom("int_overflow");
AtomInteger = Yap_LookupAtom("integer");
AtomInternalCompilerError = Yap_LookupAtom("internal_compiler_error");
AtomIs = Yap_LookupAtom("is");
AtomKey = Yap_LookupAtom("key");
AtomLDLibraryPath = Yap_LookupAtom("LD_LIBRARY_PATH");
AtomLONGINT = Yap_LookupAtom("LongInt");
AtomLT = Yap_LookupAtom("<");
AtomLastExecuteWithin = Yap_FullLookupAtom("$last_execute_within");
AtomLeash = Yap_FullLookupAtom("$leash");
@ -201,7 +203,7 @@
AtomRecordedWithKey = Yap_FullLookupAtom("$recorded_with_key");
AtomRefoundVar = Yap_FullLookupAtom("$I_FOUND_THE_VARIABLE_AGAIN");
AtomRepeat = Yap_LookupAtom("repeat");
AtomRepeatSpace = Yap_LookupAtom("repeat");
AtomRepeatSpace = Yap_LookupAtom("repeat ");
AtomReposition = Yap_LookupAtom("reposition");
AtomRepresentationError = Yap_LookupAtom("representation_error");
AtomResize = Yap_LookupAtom("resize");
@ -337,6 +339,7 @@
FunctorGoalExpansion = Yap_MkFunctor(AtomGoalExpansion,3);
FunctorHandleThrow = Yap_MkFunctor(AtomHandleThrow,3);
FunctorId = Yap_MkFunctor(AtomId,1);
FunctorIs = Yap_MkFunctor(AtomIs,2);
FunctorLastExecuteWithin = Yap_MkFunctor(AtomLastExecuteWithin,1);
FunctorList = Yap_MkFunctor(AtomDot,2);
FunctorMegaClause = Yap_MkFunctor(AtomMegaClause,2);

2
H/ratoms.h
View File

@ -127,6 +127,7 @@
AtomIntOverflow = AtomAdjust(AtomIntOverflow);
AtomInteger = AtomAdjust(AtomInteger);
AtomInternalCompilerError = AtomAdjust(AtomInternalCompilerError);
AtomIs = AtomAdjust(AtomIs);
AtomKey = AtomAdjust(AtomKey);
AtomLDLibraryPath = AtomAdjust(AtomLDLibraryPath);
AtomLONGINT = AtomAdjust(AtomLONGINT);
@ -340,6 +341,7 @@
FunctorGoalExpansion = FuncAdjust(FunctorGoalExpansion);
FunctorHandleThrow = FuncAdjust(FunctorHandleThrow);
FunctorId = FuncAdjust(FunctorId);
FunctorIs = FuncAdjust(FunctorIs);
FunctorLastExecuteWithin = FuncAdjust(FunctorLastExecuteWithin);
FunctorList = FuncAdjust(FunctorList);
FunctorMegaClause = FuncAdjust(FunctorMegaClause);

1
H/rclause.h
View File

@ -194,6 +194,7 @@ restore_opcodes(yamop *pc)
case _expand_index:
case _index_blob:
case _index_dbref:
case _index_long:
case _index_pred:
case _lock_pred:
case _op_fail:

2
H/rheap.h
View File

@ -881,6 +881,8 @@ restore_codes(void)
PredEntryAdjust(Yap_heap_regs->pred_throw);
Yap_heap_regs->pred_handle_throw =
PredEntryAdjust(Yap_heap_regs->pred_handle_throw);
Yap_heap_regs->pred_is =
PredEntryAdjust(Yap_heap_regs->pred_is);
if (Yap_heap_regs->undef_code != NULL)
Yap_heap_regs->undef_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->undef_code));
if (Yap_heap_regs->creep_code != NULL)

4
H/tatoms.h
View File

@ -256,6 +256,8 @@
#define AtomInteger Yap_heap_regs->AtomInteger_
Atom AtomInternalCompilerError_;
#define AtomInternalCompilerError Yap_heap_regs->AtomInternalCompilerError_
Atom AtomIs_;
#define AtomIs Yap_heap_regs->AtomIs_
Atom AtomKey_;
#define AtomKey Yap_heap_regs->AtomKey_
Atom AtomLDLibraryPath_;
@ -682,6 +684,8 @@
#define FunctorHandleThrow Yap_heap_regs->FunctorHandleThrow_
Functor FunctorId_;
#define FunctorId Yap_heap_regs->FunctorId_
Functor FunctorIs_;
#define FunctorIs Yap_heap_regs->FunctorIs_
Functor FunctorLastExecuteWithin_;
#define FunctorLastExecuteWithin Yap_heap_regs->FunctorLastExecuteWithin_
Functor FunctorList_;

1
H/walkclause.h
View File

@ -150,6 +150,7 @@
case _enter_a_profiling:
case _index_blob:
case _index_dbref:
case _index_long:
case _p_equal:
case _p_functor:
case _pop:

7
LGPL/PLStream/pl-os.c
View File

@ -909,8 +909,9 @@ ExistsFile(const char *path)
bool
AccessFile(const char *path, int mode)
{ char tmp[MAXPATHLEN];
{
#ifdef HAVE_ACCESS
char tmp[MAXPATHLEN];
int m = 0;
if ( mode == ACCESS_EXIST )
@ -1461,7 +1462,7 @@ utf8_strlwr(char *s)
}
char *
static char *
canonisePath(char *path)
{ if ( !trueFeature(FILE_CASE_FEATURE) )
utf8_strlwr(path);
@ -1508,7 +1509,7 @@ takeWord(const char **string, char *wrd, int maxlen)
}
bool
static bool
expandVars(const char *pattern, char *expanded, int maxlen)
{ int size = 0;
char wordbuf[MAXPATHLEN];

1
config.h.in
View File

@ -179,6 +179,7 @@
#undef HAVE_LOCALTIME
#undef HAVE_LSTAT
#undef HAVE_MALLINFO
#undef HAVE_MBSNRTOWCS
#undef HAVE_MEMCPY
#undef HAVE_MEMMOVE
#undef HAVE_MKSTEMP

101
configure vendored
View File

@ -4166,7 +4166,6 @@ fi
prefix="\${SYSTEMDRIVE}/Yap"
fi
else
use_malloc="yes"
LIBS="-lcygwin"
fi
ENABLE_WINCONSOLE="@#"
@ -7144,7 +7143,7 @@ then
YAPLIB="$DYNYAPLIB"
DYNLIB_LD="gcc -dynamiclib"
PRE_DYNLOADER_PATH="DYLD_LIBRARY_PATH=\$(abs_top_builddir)"
EXTEND_DYNLOADER_PATH="DYLD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR)/Yap YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
EXTEND_DYNLOADER_PATH="DYLD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR)/Yap YAPBOOTDIR=\$(DESTDIR)\$(SHAREDIR)/Yap/pl YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
;;
*)
case "$target_cpu" in
@ -7158,7 +7157,7 @@ then
JAVA_TARGET=sparc
;;
esac
EXTEND_DYNLOADER_PATH="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR)/Yap YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
EXTEND_DYNLOADER_PATH="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR)/Yap YAPBOOTDIR=\$(DESTDIR)\$(SHAREDIR)/Yap/pl YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
PRE_DYNLOADER_PATH="LD_LIBRARY_PATH=\$(abs_top_builddir)"
LDFLAGS="$LDFLAGS -Wl,-R,$prefix/lib -Wl,-R,$JAVA_HOME/jre/lib/$JAVA_TARGET"
DYNYAPLIB=libYap"$SHLIB_SUFFIX"
@ -7168,7 +7167,7 @@ then
esac
else
PRE_DYNLOADER_PATH=""
EXTEND_DYNLOADER_PATH="YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR)/Yap YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
EXTEND_DYNLOADER_PATH="YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR)/Yap YAPBOOTDIR=\$(DESTDIR)\$(SHAREDIR)/Yap/pl YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
DYNYAPLIB=libYap.notused
fi
@ -14744,6 +14743,100 @@ fi
done
for ac_func in mbsnrtowcs
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
{ echo "$as_me:$LINENO: checking for $ac_func" >&5
echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; }
if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
For example, HP-UX 11i <limits.h> declares gettimeofday. */
#define $ac_func innocuous_$ac_func
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func (); below.
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
<limits.h> exists even on freestanding compilers. */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
#undef $ac_func
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $ac_func ();
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined __stub_$ac_func || defined __stub___$ac_func
choke me
#endif
int
main ()
{
return $ac_func ();
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_c_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext &&
$as_test_x conftest$ac_exeext; then
eval "$as_ac_var=yes"
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
eval "$as_ac_var=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
fi
ac_res=`eval echo '${'$as_ac_var'}'`
{ echo "$as_me:$LINENO: result: $ac_res" >&5
echo "${ECHO_T}$ac_res" >&6; }
if test `eval echo '${'$as_ac_var'}'` = yes; then
cat >>confdefs.h <<_ACEOF
#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
fi
done

2
configure.in
View File

@ -452,7 +452,6 @@ then
prefix="\${SYSTEMDRIVE}/Yap"
fi
else
use_malloc="yes"
LIBS="-lcygwin"
fi
ENABLE_WINCONSOLE="@#"
@ -1295,6 +1294,7 @@ AC_CHECK_FUNCS(gethostbyname gethostid gethostname)
AC_CHECK_FUNCS(gethrtime getpwnam getrusage gettimeofday getwd)
AC_CHECK_FUNCS(isatty isnan kill labs link lgamma)
AC_CHECK_FUNCS(localtime lstat mallinfo)
AC_CHECK_FUNCS(mbsnrtowcs)
AC_CHECK_FUNCS(memcpy memmove mkstemp mktemp)
AC_CHECK_FUNCS(nanosleep mktime opendir)
AC_CHECK_FUNCS(putenv rand random readlink regexec)

6
misc/ATOMS
View File

@ -77,7 +77,7 @@ A DoLogUpdClause F "$do_log_upd_clause"
A DoLogUpdClause0 F "$do_log_upd_clause0"
A DoLogUpdClauseErase F "$do_log_upd_clause_erase"
A DoStaticClause F "$do_static_clause"
A DollarU N "$u"
A DollarU F "$u"
A DollarUndef F "$undef"
A DomainError N "domain_error"
A E N "e"
@ -136,6 +136,7 @@ A Int N "int"
A IntOverflow N "int_overflow"
A Integer N "integer"
A InternalCompilerError N "internal_compiler_error"
A Is N "is"
A Key N "key"
A LDLibraryPath N "LD_LIBRARY_PATH"
A LONGINT N "LongInt"
@ -345,10 +346,11 @@ F GInteger Integer 1
F GNumber Number 1
F GPrimitive Primitive 1
F GVar GVar 1
F GeneratePredInfo GeneratePredInfo 4
F GeneratePredInfo GeneratePredInfo 4
F GoalExpansion GoalExpansion 3
F HandleThrow HandleThrow 3
F Id Id 1
F Is Is 2
F LastExecuteWithin LastExecuteWithin 1
F List Dot 2
F MegaClause MegaClause 2

113
pl/eval.yap
View File

@ -1,16 +1,33 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: eval.yap *
* Last rev: *
* mods: *
* comments: arithmetical optimization *
* *
*************************************************************************/
:- module('eval',
:- module('$eval',
['$compile_arithmetic'/2]).
'$compile_arithmetic'((Head :- Body), (Head :- NBody)) :-
term_variables(Head, LVs),
process_body(Body, LVs, NBody).
process_body(Body, LVs, NBody), !.
'$compile_arithmetic'(G, G).
process_body((G,Body), InputVs, NewBody) :-
arithmetic_exp(G), !,
term_variables(G, UnsortedExpVs),
sort(UnsortedExpVs, ExpVs),
'$sort'(UnsortedExpVs, ExpVs),
fetch_more(Body, ExpVs, LGs, Gs, _, RBody),
term_variables(RBody, ExtraVs),
compile_arith([G|LGs], InputVs, ExtraVs, (G,Gs), ArithComp),
@ -30,13 +47,13 @@ process_body(G, InputVs, NewBody) :-
arithmetic_exp(G), !,
term_variables(G, _),
compile_arith([G], InputVs, [], G, ArithComp),
NewBody = ArithComp.
NewBody = (ArithComp,true).
process_body(G, _, G).
fetch_more((G,Gs), ExpVs, [G|LGs], (G,AGs), AllExpVs, RGs) :-
arithmetic_exp(G),
term_variables(G,Vs),
sort(Vs, SVs),
'$sort'(Vs, SVs),
intersect_vars(SVs,ExpVs), !,
join_vars(ExpVs,SVs,MoreExpVs),
fetch_more(Gs, MoreExpVs, LGs, AGs, AllExpVs, RGs).
@ -44,7 +61,7 @@ fetch_more((G,Gs), ExpVs, [], true, ExpVs, (G,Gs)) :- !.
fetch_more(G, ExpVs, [G], (G), MoreExpVs, true) :-
arithmetic_exp(G),
term_variables(G,Vs),
sort(Vs,SVs),
'$sort'(Vs,SVs),
intersect_vars(SVs,ExpVs), !,
join_vars(ExpVs,SVs,MoreExpVs).
fetch_more(G, ExpVs, [], true, ExpVs, G).
@ -90,8 +107,8 @@ join_vars([V1|R1],[V2|R2],O) :-
compile_arith(LGs, InputVs, ExtraVs, Gs, ArithComp) :-
add_type_slots(InputVs,TypedVs),
sort(InputVs,S1),
sort(ExtraVs,S2),
'$sort'(InputVs,S1),
'$sort'(ExtraVs,S2),
join_vars(S1, S2, S),
visit(LGs, TypedVs, NewTypedVs, S, FlatExps, []),
FlatExps = [_,_|_],
@ -143,15 +160,15 @@ visit_pred((X =:= T), TypedVs, NewTypedVs, _) -->
[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),
visit_exp(X, TypedVs, ITypedVs, TMP1, _),
visit_exp(T, ITypedVs, NewTypedVs, TMP2, _),
% assign the type to X, if any
% final code
[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),
visit_exp(X, TypedVs, ITypedVs, TMP1, _),
visit_exp(T, ITypedVs, NewTypedVs, TMP2, _),
% assign the type to X, if any
% final code
[init_label(success_label), lt(TMP2,TMP1)].
@ -496,80 +513,82 @@ 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),I), '$a_eq_int'(A,I)) :- integer(I), !, \+ '$bignum'(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(x(A),I), '$ltc_int'(A,I)) :- integer(I), !, \+ '$bignum'(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(I,x(A)), '$gtc_int'(A,I)) :- integer(I), !, \+ '$bignum'(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),I,x(B)), '$add_int_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I), '$add_int_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I,x(B)), '$sub_int_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I), '$add_int_c'(A,B,I1)) :- integer(I), !, I1 is -I, \+ '$bignum'(I1).
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),I,x(B)), '$mul_int_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I), '$mul_int_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I,x(B)), '$fdiv_c1'(A,B,F)) :- integer(I), !, \+ '$bignum'(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),I), '$fdiv_c2'(A,B,F)) :- integer(I), !, \+ '$bignum'(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),I,x(B)), '$idiv_c1'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(idiv(x(A),x(B),I), '$idiv_c2'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I,x(B)), '$mod_c1'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(mod(x(A),x(B),I), '$mod_c2'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I,x(B)), '$rem_c1'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(rem(x(A),x(B),I), '$rem_c2'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I,x(B)), '$land_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(and(x(A),x(B),I), '$land_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I,x(B)), '$lor_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(or(x(A),x(B),I), '$lor_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I,x(B)), '$xor_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(xor(x(A),x(B),I), '$xor_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(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),I,x(B)), '$sr_c1'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(sr(x(A),x(B),I), '$sr_c2'(A,B,I)) :- integer(I), I >=0, !, \+ '$bignum'(I).
compile_op(sr(x(A),x(B),I), '$sl_c2'(A,B,NI)) :- integer(I), !, NI is -I, \+ '$bignum'(NI).
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),I,x(B)), '$sl_c1'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(sl(x(A),x(B),I), '$sl_c2'(A,B,I)) :- integer(I), I >= 0, !, \+ '$bignum'(I).
compile_op(sl(x(A),x(B),I), '$sr_c2'(A,B,NI)) :- integer(I), !, NI is -I, \+ '$bignum'(NI).
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),I,x(B)), exp_c(A,B,F)) :- integer(I), !, \+ '$bignum'(I), F is truncate(I).
compile_op(exp(x(A),x(B),F), exp_c(A,B,F)) :- float(F), !.
compile_op(exp(x(A),x(B),I), exp_c(A,B,F)) :- integer(I), !, F is truncate(I).
compile_op(exp(x(A),x(B),I), exp_c(A,B,F)) :- integer(I), !, \+ '$bignum'(I), F is truncate(I).
compile_op(exp(x(A),x(B),x(C)), exp(A,B,C)).
compile_op(max(x(A),F,x(B)), max_float_c(A,B,F)) :- float(F), !.
compile_op(max(x(A),I,x(B)), max_int_c(A,B,I)) :- integer(I), !.
compile_op(max(x(A),I,x(B)), max_int_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(max(x(A),x(B),F), max_float_c(A,B,F)) :- float(F), !.
compile_op(max(x(A),x(B),I), max_int_c(A,B,I)) :- integer(I), !.
compile_op(max(x(A),x(B),I), max_int_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(max(x(A),x(B),x(C)), max(A,B,C)).
compile_op(min(x(A),F,x(B)), min_float_c(A,B,F)) :- float(F), !.
compile_op(min(x(A),I,x(B)), min_int_c(A,B,I)) :- integer(I), !.
compile_op(min(x(A),I,x(B)), min_int_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(min(x(A),x(B),F), min_float_c(A,B,F)) :- float(F), !.
compile_op(min(x(A),x(B),I), min_int_c(A,B,I)) :- integer(I), !.
compile_op(min(x(A),x(B),I), min_int_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(min(x(A),x(B),x(C)), min(A,B,C)).
compile_op(gcd(x(A),I,x(B)), gcd_c(A,B,I)) :- integer(I), !.
compile_op(gcd(x(A),x(B),I), gcd_c(A,B,I)) :- integer(I), !.
compile_op(gcd(x(A),I,x(B)), gcd_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(gcd(x(A),x(B),I), gcd_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
compile_op(gcd(x(A),x(B),x(C)), gcd(A,B,C)).
compile_op(unot(x(A),x(B)), unot(A,B)).
compile_op(exp1(x(A),x(B)), exp1(A,B)).

9
pl/init.yap
View File

@ -48,6 +48,11 @@ otherwise.
:- compile_expressions.
lists:append([], L, L).
lists:append([H|T], L, [H|R]) :-
lists:append(T, L, R).
:- [
'yio.yap',
'debug.yap',
@ -83,10 +88,6 @@ otherwise.
:- source.
lists:append([], L, L).
lists:append([H|T], L, [H|R]) :-
lists:append(T, L, R).
% member(?Element, ?Set)
% is true when Set is a list, and Element occurs in it. It may be used
% to test for an element or to enumerate all the elements by backtracking.

11
pl/modules.yap
View File

@ -194,11 +194,18 @@ module(N) :-
% A6: head module (this is the one used in compiling and accessing).
%
%
'$module_expansion'((H:-B),(H:-B1),(H:-BO),M,HM) :- !,
'$module_expansion'((H:-B),(H:-B1),(H:-NBO),M,HM) :- !,
'$is_mt'(M, H, B, IB, MM),
'$module_u_vars'(H,UVars,M), % collect head variables in
% expanded positions
'$module_expansion'(IB,B1,BO,M,MM,HM,UVars).
'$module_expansion'(IB,B1,BO,M,MM,HM,UVars),
(
get_value('$c_arith',true)
->
'$eval':'$compile_arithmetic'((H:-BO),(H:-NBO))
;
NBO = BO
).
% do not expand bodyless clauses.
'$module_expansion'(H,H,H,_,_).

10
pl/profile.yap
View File

@ -59,14 +59,14 @@ profile_reset :-
profile_reset.
showprofres :-
'$proftype'(offline), !,
'$offline_showprofres'.
'$proftype'(offline), !,
'$offline_showprofres'.
showprofres :-
showprofres(-1).
showprofres(-1).
showprofres(A) :-
'$proftype'(offline), !,
'$offline_showprofres'(A).
'$proftype'(offline), !,
'$offline_showprofres'(A).
showprofres(A) :-
('$profison' -> profoff, Stop = true ; Stop = false),
'$profglobs'(Tot,GCs,HGrows,SGrows,Mallocs,ProfOns),

9
pl/statistics.yap
View File

@ -20,6 +20,7 @@
statistics :-
'$runtime'(Runtime,_),
'$cputime'(CPUtime,_),
'$systime'(SYStime,_),
'$walltime'(Walltime,_),
'$statistics_heap_info'(HpSpa, HpInUse),
'$statistics_heap_max'(HpMax),
@ -33,9 +34,9 @@ statistics :-
'$inform_trail_overflows'(NOfTO,TotTOTime),
'$inform_gc'(NOfGC,TotGCTime,TotGCSize),
'$inform_agc'(NOfAGC,TotAGCTime,TotAGCSize),
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize).
'$statistics'(Runtime,CPUtime,SYStime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize).
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,_TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize) :-
'$statistics'(Runtime,CPUtime,SYStime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,_TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize) :-
TotalMemory is HpSpa+StkSpa+TrlSpa,
format(user_error,'memory (total)~t~d bytes~35+~n', [TotalMemory]),
format(user_error,' program space~t~d bytes~35+', [HpSpa]),
@ -71,10 +72,12 @@ statistics :-
format(user_error,'~t~3f~12+ sec. runtime~n', [RTime]),
CPUTime is float(CPUtime)/1000,
format(user_error,'~t~3f~12+ sec. cputime~n', [CPUTime]),
SYSTime is float(SYStime)/1000,
format(user_error,'~t~3f~12+ sec. systime~n', [SYSTime]),
WallTime is float(Walltime)/1000,
format(user_error,'~t~3f~12+ sec. elapsed time~n~n', [WallTime]),
fail.
'$statistics'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).
'$statistics'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).
statistics(runtime,[T,L]) :-
'$runtime'(T,L).

3
pl/utils.yap
View File

@ -856,8 +856,9 @@ nb_current(GlobalVariable, Val) :-
nb_getval(GlobalVariable, Val).
between(I,_,I).
between(I,M,I) :- I =< M.
between(I0,I,J) :- I0 < I,
I1 is I0+1,
between(I1,I,J).