From: David S. W. <dw...@us...> - 2005-11-17 21:47:16
|
Update of /cvsroot/xsb/XSB/emu In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20631 Modified Files: cell_xsb.h emudef.h emuloop.c unify_xsb.h Log Message: Changes to try to improve floating point handling for doubles. There are still some issues with compiled indexes on floats, and they don't work correctly. Index: cell_xsb.h =================================================================== RCS file: /cvsroot/xsb/XSB/emu/cell_xsb.h,v retrieving revision 1.25 retrieving revision 1.26 diff -u -r1.25 -r1.26 --- cell_xsb.h 14 Nov 2005 18:58:49 -0000 1.25 +++ cell_xsb.h 17 Nov 2005 21:46:56 -0000 1.26 @@ -99,9 +99,9 @@ #else #define FLOAT_MASK 0xfffffff8 #endif -extern float getfloatval(Cell); -extern Cell makefloat(float); -extern int sign(Float); +extern inline float getfloatval(Cell); +extern inline Cell makefloat(float); +extern inline int sign(Float); #define isref(cell) (!((word)(cell)&0x3)) #define isnonvar(cell) ((word)(cell)&0x3) /* dcell -> xsbBool */ @@ -224,6 +224,7 @@ #define isnil(dcell) (isstring(dcell) && (char *)string_val(dcell) == nil_string) #define isboxed(term) (isconstr(term) && get_str_psc(term) == box_psc ) +#define box_has_id(dcell, box_identifier) (int_val(cell(clref_val(dcell)+1))>>16 == box_identifier) /*======================================================================*/ /* Miscellaneous */ @@ -233,16 +234,14 @@ #define CELL_DEFS_INCLUDED #define arity_integer(dcell) \ - (isinteger(dcell) && int_val(dcell) >= 0 \ - && int_val(dcell) <= MAX_ARITY) + (isinteger(dcell) && int_val(dcell) >= 0 \ + && int_val(dcell) <= MAX_ARITY) - -#define isboxedinteger(dcell) (isconstr(dcell) && (get_str_psc(dcell)==box_psc) \ - && (int_val(cell(clref_val(dcell)+1))>>16 == ID_BOXED_INT)) +#define isboxedinteger(dcell) (isboxed(dcell) && box_has_id(dcell, ID_BOXED_INT)) #ifndef FAST_FLOATS -#define isboxedfloat(dcell) (isconstr(dcell) && (get_str_psc(dcell)==box_psc) \ - && (int_val(cell(clref_val(dcell)+1))>>16 == ID_BOXED_FLOAT)) +#define isboxedfloat(dcell) (isboxed(dcell) && box_has_id(dcell, ID_BOXED_FLOAT)) + #else //If FAST_FLOATS is defined, there should be no boxed floats (only Cell floats). // isboxedfloat is therefore expanded to FALSE (0), in hopes that the optimizer will remove. Index: emudef.h =================================================================== RCS file: /cvsroot/xsb/XSB/emu/emudef.h,v retrieving revision 1.54 retrieving revision 1.55 diff -u -r1.54 -r1.55 --- emudef.h 14 Nov 2005 18:58:49 -0000 1.54 +++ emudef.h 17 Nov 2005 21:46:56 -0000 1.55 @@ -184,16 +184,41 @@ XSB_Deref(OP1); \ if (isref(OP1)) { \ /* op1 is FREE */ \ - bind_float_tagged(vptr(OP1), OP2); \ + bind_float_tagged(vptr(OP1), OP2); \ } \ else if (isofloat(OP1)) { \ - if (OP1 == OP2) {XSB_Next_Instr();} else Fail1; \ + if ( (float)ofloat_val(OP1) == float_val(OP2)) { \ + XSB_Next_Instr(); \ + } \ + else Fail1; \ + } \ + else if (isattv(OP1)) { \ + xsb_dbgmsg((LOG_ATTV,">>>> ATTV nunify_with_float, interrupt needed\n")); \ + /* add_interrupt(OP1, OP2); */ \ + add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),OP2); \ + bind_float_tagged((CPtr)dec_addr(op1), OP2); \ + } \ + else Fail1; /* op1 is INT, STRING, STRUCT, or LIST */ + +/*======================================================================*/ + +#define nunify_with_float_get(OP1,OP2) \ + XSB_Deref(OP1); \ + if (isref(OP1)) { \ + /* op1 is FREE */ \ + bind_boxedfloat(vptr(OP1), float_val(OP2)); \ + } \ + else if (isofloat(OP1)) { \ + if ( (float)ofloat_val(OP1) == float_val(OP2)) { \ + XSB_Next_Instr(); \ + } \ + else Fail1; \ } \ else if (isattv(OP1)) { \ xsb_dbgmsg((LOG_ATTV,">>>> ATTV nunify_with_float, interrupt needed\n")); \ /* add_interrupt(OP1, OP2); */ \ add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),OP2); \ - bind_float_tagged((CPtr)dec_addr(op1), OP2); \ + bind_boxedfloat((CPtr)dec_addr(op1), float_val(OP2)); \ } \ else Fail1; /* op1 is INT, STRING, STRUCT, or LIST */ @@ -216,10 +241,18 @@ } \ else Fail1; \ } \ - else if (isattv(OP1)) { \ + else if ((Psc)OP2 == box_psc) { \ + Cell ignore_addr; \ + if (isfloat(OP1)) \ + bld_boxedfloat(CTXTc &ignore_addr, float_val(OP1)); \ + else if (isinteger(OP1)) \ + bld_boxedint(&ignore_addr, int_val(OP1)); \ + flag = READFLAG; \ + sreg = hreg - 3; \ + } else if (isattv(OP1)) { \ xsb_dbgmsg((LOG_ATTV,">>>> ATTV nunify_with_str, interrupt needed\n")); \ /* add_interrupt(OP1, makecs(hreg)); */ \ - add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),makecs(hreg)); \ + add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),makecs(hreg)); \ bind_copy((CPtr)dec_addr(op1), makecs(hreg)); \ new_heap_functor(hreg, (Psc)OP2); \ flag = WRITE; \ Index: emuloop.c =================================================================== RCS file: /cvsroot/xsb/XSB/emu/emuloop.c,v retrieving revision 1.123 retrieving revision 1.124 diff -u -r1.123 -r1.124 --- emuloop.c 14 Nov 2005 18:58:49 -0000 1.123 +++ emuloop.c 17 Nov 2005 21:46:56 -0000 1.124 @@ -635,7 +635,7 @@ Op1(Register(get_xxr)); Op2(get_xxxn); ADVANCE_PC(size_xxxX); - nunify_with_float(op1,op2); + nunify_with_float_get(op1,op2); //printf("\nGETFLOAT LEFT!\n"); XSB_End_Instr() @@ -654,7 +654,8 @@ Op1(get_xxr); Op2(get_xxxn); ADVANCE_PC(size_xxxX); - bld_float_tagged((CPtr)op1, op2); + // bld_float_tagged((CPtr)op1, op2); + bld_boxedfloat(CTXTc (CPtr)op1, float_val(op2)); //printf("\nPUTFLOAT DONE!\n"); XSB_End_Instr() @@ -1074,6 +1075,12 @@ } XSB_End_Instr() +#define struct_hash_value(op1) \ + (isboxedinteger(op1)?boxedint_val(op1): \ + (isboxedfloat(op1)? \ + int_val(cell(clref_val(op1)+1)) ^ int_val(cell(clref_val(op1)+2)) ^ int_val(cell(clref_val(op1)+3)): \ + (Cell)get_str_psc(op1))) + XSB_Start_Instr(switchonbound,_switchonbound) /* PPR-L-L */ Def3ops /* op1 is register, op2 is hash table offset, op3 is modulus */ @@ -1081,13 +1088,13 @@ XSB_Deref(op1); switch (cell_tag(op1)) { case XSB_STRUCT: - op1 = (Cell)get_str_psc(op1); + op1 = struct_hash_value(op1); break; case XSB_STRING: /* We should change the compiler to avoid this test */ op1 = (Cell)(isnil(op1) ? 0 : string_val(op1)); break; case XSB_INT: - case XSB_FLOAT: /* Yes, use int_val to avoid conversion problem */ + case XSB_FLOAT: /* cvt to double and use that indexing.... */ op1 = (Cell)int_val(op1); break; case XSB_LIST: @@ -1160,7 +1167,8 @@ depth++; argsleft[depth] = get_arity(get_str_psc(op1)); stk[depth] = clref_val(op1)+1; - op1 = (Cell)get_str_psc(op1); + //op1 = (Cell)get_str_psc(op1); + op1 = struct_hash_value(op1); break; case XSB_STRING: op1 = (Cell)string_val(op1); @@ -1185,7 +1193,8 @@ op1 = (Cell)(list_pscPair); break; case XSB_STRUCT: - op1 = (Cell)get_str_psc(op1); + // op1 = (Cell)get_str_psc(op1); + op1 = struct_hash_value(op1); break; case XSB_STRING: op1 = (Cell)string_val(op1); @@ -1460,9 +1469,13 @@ lpcreg = (byte *)op3; } else if (isboxedinteger(op1)) { - if (oint_val(op1) == oint_val(op2)) + if (oint_val(op1) == int_val(op2)) lpcreg = (byte *)op3; } + else if (isboxedfloat(op1)) { + if (ofloat_val(op1) == (double)int_val(op2)) + lpcreg = (byte *) op3; + } else { arithmetic_comp_abort(CTXTc op1, "=\\=", op2); } @@ -1480,9 +1493,13 @@ lpcreg = (byte *) op3; } else if (isboxedinteger(op1)) { - if (oint_val(op1) != oint_val(op2)) + if (oint_val(op1) != int_val(op2)) lpcreg = (byte *)op3; } + else if (isboxedfloat(op1)) { + if (ofloat_val(op1) != (double)int_val(op2)) + lpcreg = (byte *) op3; + } else { arithmetic_comp_abort(CTXTc op1, "=:=", op2); } Index: unify_xsb.h =================================================================== RCS file: /cvsroot/xsb/XSB/emu/unify_xsb.h,v retrieving revision 1.6 retrieving revision 1.7 diff -u -r1.6 -r1.7 --- unify_xsb.h 14 Jan 2005 18:31:54 -0000 1.6 +++ unify_xsb.h 17 Nov 2005 21:46:57 -0000 1.7 @@ -43,6 +43,19 @@ if (isattv(op1)) goto loc##_label_op1_attv; \ if (isattv(op2)) goto loc##_label_op2_attv; \ \ + if (isfloat(op2) && isboxedfloat(op1) ) { \ + if ( float_val(op2) == (float)boxedfloat_val(op1)) \ + {IFTHEN_SUCCEED;} \ + else \ + {IFTHEN_FAILED;} \ + } \ + if (isfloat(op1) && isboxedfloat(op2) ) { \ + if ( float_val(op1) == (float)boxedfloat_val(op2)) \ + {IFTHEN_SUCCEED;} \ + else \ + {IFTHEN_FAILED;} \ + } \ + \ if (cell_tag(op1) != cell_tag(op2)) \ {IFTHEN_FAILED;} \ \ |