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))); }