From 8a3978e3e13622208155ef29f2b0f197623994eb Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 9 Feb 2009 21:56:40 +0000 Subject: [PATCH] rename BinaryTestPredFlag to BinaryPredFlag get rid of small annoying arithmetic bugs --- BEAM/toeam.c | 4 +- C/absmi.c | 186 ++++++++++++++++++++++++++++++------------ C/alloc.c | 12 +-- C/amasm.c | 41 +++++----- C/arith1.c | 12 ++- C/arith2.c | 10 ++- C/cdmgr.c | 9 +- C/cmppreds.c | 50 ++++++------ C/compiler.c | 149 +++++++++++++++++++-------------- C/computils.c | 57 ++++++++++++- C/dbase.c | 2 +- C/eval.c | 2 +- C/exec.c | 2 +- C/gmp_support.c | 42 +++++----- C/grow.c | 1 + C/index.c | 68 +++++++++++++-- C/init.c | 1 + C/iopreds.c | 4 +- C/stdpreds.c | 11 +++ C/sysbits.c | 68 +++++++++++++++ H/Heap.h | 2 + H/YapOpcodes.h | 1 + H/Yapproto.h | 3 +- H/Yatom.h | 2 +- H/alloc.h | 4 +- H/arith2.h | 43 ++++------ H/compile.h | 1 + H/iatoms.h | 9 +- H/ratoms.h | 2 + H/rclause.h | 1 + H/rheap.h | 2 + H/tatoms.h | 4 + H/walkclause.h | 1 + LGPL/PLStream/pl-os.c | 7 +- config.h.in | 1 + configure | 101 ++++++++++++++++++++++- configure.in | 2 +- misc/ATOMS | 6 +- pl/eval.yap | 113 ++++++++++++++----------- pl/init.yap | 9 +- pl/modules.yap | 11 ++- pl/profile.yap | 10 +-- pl/statistics.yap | 9 +- pl/utils.yap | 3 +- 44 files changed, 767 insertions(+), 311 deletions(-) diff --git a/BEAM/toeam.c b/BEAM/toeam.c index 933dcc99e..53f7ca1bd 100644 --- a/BEAM/toeam.c +++ b/BEAM/toeam.c @@ -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; } } diff --git a/C/absmi.c b/C/absmi.c index 78d431c7c..29f44fcb1 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -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<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<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]<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]<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(); diff --git a/C/alloc.c b/C/alloc.c index 2fa818ab6..5db475ff9 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -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; diff --git a/C/amasm.c b/C/amasm.c index 801d8ef36..6342e3380 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -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); diff --git a/C/arith1.c b/C/arith1.c index 571541585..df6aaa536 100644 --- a/C/arith1.c +++ b/C/arith1.c @@ -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); diff --git a/C/arith2.c b/C/arith2.c index bcafae4ed..720c018e1 100644 --- a/C/arith2.c +++ b/C/arith2.c @@ -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); diff --git a/C/cdmgr.c b/C/cdmgr.c index 7315d69da..84d34131d 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -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; diff --git a/C/cmppreds.c b/C/cmppreds.c index e4ac6f1fa..0236505d0 100644 --- a/C/cmppreds.c +++ b/C/cmppreds.c @@ -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); } diff --git a/C/compiler.c b/C/compiler.c index 893f52e8b..75d5e9c47 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -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: diff --git a/C/computils.c b/C/computils.c index 108c46a4a..f68d0fae4 100644 --- a/C/computils.c +++ b/C/computils.c @@ -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", diff --git a/C/dbase.c b/C/dbase.c index 611b778e5..329d3adac 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -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; } diff --git a/C/eval.c b/C/eval.c index f03525c17..273dad410 100644 --- a/C/eval.c +++ b/C/eval.c @@ -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); diff --git a/C/exec.c b/C/exec.c index 89c584d28..878a57d6c 100644 --- a/C/exec.c +++ b/C/exec.c @@ -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(); diff --git a/C/gmp_support.c b/C/gmp_support.c index dc22f8894..67ff16f7f 100644 --- a/C/gmp_support.c +++ b/C/gmp_support.c @@ -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 diff --git a/C/grow.c b/C/grow.c index 73d6a9e51..9bdf762ef 100644 --- a/C/grow.c +++ b/C/grow.c @@ -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: diff --git a/C/index.c b/C/index.c index a0434cc76..8a5801550 100644 --- a/C/index.c +++ b/C/index.c @@ -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: diff --git a/C/init.c b/C/init.c index 4345923f4..e8009f1b3 100644 --- a/C/init.c +++ b/C/init.c @@ -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 = diff --git a/C/iopreds.c b/C/iopreds.c index 7ad3fb15f..48e9b7252 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -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 */ diff --git a/C/stdpreds.c b/C/stdpreds.c index 8604b97fd..371fc7d77 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -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); diff --git a/C/sysbits.c b/C/sysbits.c index ad5a915be..b4404beec 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -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 diff --git a/H/Heap.h b/H/Heap.h index 99e4c9cbb..a4dd7d38e 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -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 diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 57387b6f5..3a93a05b0 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -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), diff --git a/H/Yapproto.h b/H/Yapproto.h index 6cf7b0396..5c7c007aa 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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)); diff --git a/H/Yatom.h b/H/Yatom.h index e630b541d..11ca40be0 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -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 */ diff --git a/H/alloc.h b/H/alloc.h index 97d063a65..ff01cd860 100644 --- a/H/alloc.h +++ b/H/alloc.h @@ -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 #include diff --git a/H/arith2.h b/H/arith2.h index 59eb5f0fc..780477242 100644 --- a/H/arith2.h +++ b/H/arith2.h @@ -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; - 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"); diff --git a/H/compile.h b/H/compile.h index 7437509d6..7b6283856 100644 --- a/H/compile.h +++ b/H/compile.h @@ -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, diff --git a/H/iatoms.h b/H/iatoms.h index fa1c3fb27..addc172f7 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -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); diff --git a/H/ratoms.h b/H/ratoms.h index b1f798bb2..77d848a94 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -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); diff --git a/H/rclause.h b/H/rclause.h index 042b28007..49876c3b8 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -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: diff --git a/H/rheap.h b/H/rheap.h index 86d4a6193..1669ecf24 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -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) diff --git a/H/tatoms.h b/H/tatoms.h index fcc277cd3..46cb0f99b 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -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_; diff --git a/H/walkclause.h b/H/walkclause.h index 15112f3e4..57652f4eb 100644 --- a/H/walkclause.h +++ b/H/walkclause.h @@ -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: diff --git a/LGPL/PLStream/pl-os.c b/LGPL/PLStream/pl-os.c index bfe86a064..74feaea66 100644 --- a/LGPL/PLStream/pl-os.c +++ b/LGPL/PLStream/pl-os.c @@ -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]; diff --git a/config.h.in b/config.h.in index 1cbd4889a..1cfaa1c34 100644 --- a/config.h.in +++ b/config.h.in @@ -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 diff --git a/configure b/configure index acc4789f0..8d9fe160f 100755 --- a/configure +++ b/configure @@ -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 declares $ac_func. + For example, HP-UX 11i 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 to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#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 + + diff --git a/configure.in b/configure.in index 4aa4d40f1..20d1e62d7 100644 --- a/configure.in +++ b/configure.in @@ -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) diff --git a/misc/ATOMS b/misc/ATOMS index efba7438d..d6e847d94 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -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 diff --git a/pl/eval.yap b/pl/eval.yap index cfadadac7..294f83132 100644 --- a/pl/eval.yap +++ b/pl/eval.yap @@ -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)). diff --git a/pl/init.yap b/pl/init.yap index da689ac2b..5c1d0f4d3 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -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. diff --git a/pl/modules.yap b/pl/modules.yap index 436a9c7a1..0a883ef34 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -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,_,_). diff --git a/pl/profile.yap b/pl/profile.yap index 58d3b0fc8..09b1bfc8d 100644 --- a/pl/profile.yap +++ b/pl/profile.yap @@ -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), diff --git a/pl/statistics.yap b/pl/statistics.yap index 41df05ec2..02a7a5b3f 100644 --- a/pl/statistics.yap +++ b/pl/statistics.yap @@ -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). diff --git a/pl/utils.yap b/pl/utils.yap index 0ed5c01f8..0ea427ec2 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -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). +