hash_t obj_hash(obj_ptr obj)
{
switch (TYPE(obj))
{
case TYPE_INT:
case TYPE_BOOL:
return (hash_t) INT(obj);
case TYPE_SYMBOL:
return string_hash_imp(SYMBOL(obj));
case TYPE_STRING:
return string_hash(&STRING(obj));
case TYPE_CONS:
{
hash_t res = 0;
for (;;)
{
if (NTYPEP(obj, TYPE_CONS))
{
res += obj_hash(obj);
break;
}
res += obj_hash(CAR(obj));
obj = CDR(obj);
}
return res;
}
case TYPE_VEC:
return vec_hash(&obj->data.as_vec);
/* These types shouldn't be keys anyway ... */
case TYPE_FLOAT:
assert(TYPE(obj) != TYPE_FLOAT);
break;
case TYPE_MAP:
assert(TYPE(obj) != TYPE_MAP);
break;
case TYPE_CLOSURE:
assert(TYPE(obj) != TYPE_CLOSURE);
break;
case TYPE_PRIMITIVE:
assert(TYPE(obj) != TYPE_PRIMITIVE);
break;
case TYPE_ERROR:
assert(TYPE(obj) != TYPE_ERROR);
break;
case TYPE_PORT:
assert(TYPE(obj) != TYPE_PORT);
break;
}
return 0;
}
static void notice_obj( struct Scanning *ctx, obj *pitem )
{
struct VMPageRecord *vmp;
obj item;
item = *pitem;
again:
if (!OBJ_ISA_PTR(item))
return;
/* check for an within-the-store ptr */
/* might want to quickly check a small cache to
* speed up resolution, instead of probing the Big Cache
*/
vmp = addr_to_vm_page_record( ctx->store, PTR_TO_PHH(item) );
if (vmp)
{
an_xlated_ptr( ctx, vmp );
return;
}
else
{
obj reloc = objecttable_lookup( ctx->store->reloc_table,
obj_hash(item),
item );
if (EQ(reloc,FALSE_OBJ))
{
/* it had better be a pivot! */
table_lookup_or_fail( ctx,
ctx->store->pivot_table,
item,
item );
return;
}
else
{
/* it was found in the relocation table
* -- store the new pointer into the object
* making the reference, and try again
*/
item = *pitem = reloc;
/* note that we loop back to BEFORE the PTR check;
* -- this allows a relocation to a non-ptr
*/
goto again;
}
}
/* failed! */
RS_LVerbose( 463, 3681, "from {%lx} found escaping {%lx}",
VAL(ctx->source) ,
VAL(item) );
ctx->failures = cons( item, ctx->failures );
return;
}
uint32_t vector_hash (object_t * o)
{
uint32_t accum = 0;
vector_t *v = OVAL (o);
size_t i;
for (i = 0; i < v->len; i++)
accum ^= obj_hash (v->v[i]);
return accum;
}
static void table_lookup_or_fail( struct Scanning *ctx,
obj lookup_table,
obj failing_unit,
obj key_value )
{
obj refnum;
refnum = objecttable_lookup( lookup_table,
obj_hash(key_value),
key_value );
if (EQ(refnum,FALSE_OBJ))
{
RS_LVerbose( 463, 3682, "from {%lx} found escaping {%lx}",
VAL(ctx->source) ,
VAL(failing_unit) );
ctx->failures = cons( failing_unit, ctx->failures );
}
else
{
an_xlated_indir( ctx, refnum );
}
}
static unsigned initix( obj key )
{
obj h = obj_hash( key );
unsigned i = fx2int(h);
return i % COMMENT_TABLE_SIZE;
}
Expr* PrimInliner::tryInline() {
// Returns the failure result or the result of the primitive (if the
// primitive can't fail) if the primitive has been inlined; returns
// NULL otherwise. If the primitive has been inlined but can't fail,
// the bci in the MethodDecoder is set to the first instruction after
// the failure block.
// NB: The comparisons below should be replaced with pointer comparisons
// comparing with the appropriate vmSymbol. Should fix this at some point.
char* name = _pdesc->name();
Expr* res = NULL;
switch (_pdesc->group()) {
case IntArithmeticPrimitive:
if (number_of_parameters() == 2) {
Expr* x = parameter(0);
Expr* y = parameter(1);
if (equal(name, "primitiveAdd:ifFail:")) { res = smi_ArithmeticOp(tAddArithOp, x, y); break; }
if (equal(name, "primitiveSubtract:ifFail:")) { res = smi_ArithmeticOp(tSubArithOp, x, y); break; }
if (equal(name, "primitiveMultiply:ifFail:")) { res = smi_ArithmeticOp(tMulArithOp, x, y); break; }
if (equal(name, "primitiveDiv:ifFail:")) { res = smi_Div(x, y); break; }
if (equal(name, "primitiveMod:ifFail:")) { res = smi_Mod(x, y); break; }
if (equal(name, "primitiveBitAnd:ifFail:")) { res = smi_BitOp(tAndArithOp, x, y); break; }
if (equal(name, "primitiveBitOr:ifFail:")) { res = smi_BitOp(tOrArithOp , x, y); break; }
if (equal(name, "primitiveBitXor:ifFail:")) { res = smi_BitOp(tXOrArithOp, x, y); break; }
if (equal(name, "primitiveRawBitShift:ifFail:")) { res = smi_Shift(x, y); break; }
}
break;
case IntComparisonPrimitive:
if (number_of_parameters() == 2) {
Expr* x = parameter(0);
Expr* y = parameter(1);
if (equal(name, "primitiveSmallIntegerEqual:ifFail:")) { res = smi_Comparison(EQBranchOp, x, y); break; }
if (equal(name, "primitiveSmallIntegerNotEqual:ifFail:")) { res = smi_Comparison(NEBranchOp, x, y); break; }
if (equal(name, "primitiveLessThan:ifFail:")) { res = smi_Comparison(LTBranchOp, x, y); break; }
if (equal(name, "primitiveLessThanOrEqual:ifFail:")) { res = smi_Comparison(LEBranchOp, x, y); break; }
if (equal(name, "primitiveGreaterThan:ifFail:")) { res = smi_Comparison(GTBranchOp, x, y); break; }
if (equal(name, "primitiveGreaterThanOrEqual:ifFail:")) { res = smi_Comparison(GEBranchOp, x, y); break; }
}
break;
case FloatArithmeticPrimitive:
break;
case FloatComparisonPrimitive:
break;
case ObjArrayPrimitive:
if (equal(name, "primitiveIndexedObjectSize")) { res = array_size(); break; }
if (equal(name, "primitiveIndexedObjectAt:ifFail:")) { res = array_at_ifFail(ArrayAtNode::object_at); break; }
if (equal(name, "primitiveIndexedObjectAt:put:ifFail:")) { res = array_at_put_ifFail(ArrayAtPutNode::object_at_put); break; }
break;
case ByteArrayPrimitive:
if (equal(name, "primitiveIndexedByteSize")) { res = array_size(); break; }
if (equal(name, "primitiveIndexedByteAt:ifFail:")) { res = array_at_ifFail(ArrayAtNode::byte_at); break; }
if (equal(name, "primitiveIndexedByteAt:put:ifFail:")) { res = array_at_put_ifFail(ArrayAtPutNode::byte_at_put); break; }
break;
case DoubleByteArrayPrimitive:
if (equal(name, "primitiveIndexedDoubleByteSize")) { res = array_size(); break; }
if (equal(name, "primitiveIndexedDoubleByteAt:ifFail:")) { res = array_at_ifFail(ArrayAtNode::double_byte_at); break; }
if (equal(name, "primitiveIndexedDoubleByteCharacterAt:ifFail:")) { res = array_at_ifFail(ArrayAtNode::character_at); break; }
if (equal(name, "primitiveIndexedDoubleByteAt:put:ifFail:")) { res = array_at_put_ifFail(ArrayAtPutNode::double_byte_at_put);break; }
break;
case BlockPrimitive:
if (strncmp(name, "primitiveValue", 14) == 0) { res = block_primitiveValue(); break; }
break;
case NormalPrimitive:
if (strncmp(name, "primitiveNew", 12) == 0) { res = obj_new(); break; }
if (equal(name, "primitiveShallowCopyIfFail:ifFail:")) { res = obj_shallowCopy(); break; }
if (equal(name, "primitiveEqual:")) { res = obj_equal(); break; }
if (equal(name, "primitiveClass")) { res = obj_class(true); break; }
if (equal(name, "primitiveClassOf:")) { res = obj_class(false); break; }
if (equal(name, "primitiveHash")) { res = obj_hash(true); break; }
if (equal(name, "primitiveHashOf:")) { res = obj_hash(false); break; }
if (equal(name, "primitiveProxyByteAt:ifFail:")) { res = proxy_byte_at(); break; }
if (equal(name, "primitiveProxyByteAt:put:ifFail:")) { res = proxy_byte_at_put(); break; }
break;
default:
fatal1("bad primitive group %d", _pdesc->group());
break;
}
if (CompilerDebug) {
cout(PrintInlining && (res != NULL))->print("%*sinlining %s %s\n", _scope->depth + 2, "", _pdesc->name(),
_usingUncommonTrap ? "(unc. failure)" : (_cannotFail ? "(cannot fail)" : ""));
}
if (!_usingUncommonTrap && !_cannotFail) theCompiler->reporter->report_prim_failure(_pdesc);
return res;
}
object_t *lisp_hash (object_t * lst)
{
DOC ("Return integer hash of object.");
REQ (lst, 1, c_sym ("hash"));
return c_int (obj_hash (CAR (lst)));
}
