1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. 2-- All rights reserved. 3-- 4-- Redistribution and use in source and binary forms, with or without 5-- modification, are permitted provided that the following conditions are 6-- met: 7-- 8-- - Redistributions of source code must retain the above copyright 9-- notice, this list of conditions and the following disclaimer. 10-- 11-- - Redistributions in binary form must reproduce the above copyright 12-- notice, this list of conditions and the following disclaimer in 13-- the documentation and/or other materials provided with the 14-- distribution. 15-- 16-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the 17-- names of its contributors may be used to endorse or promote products 18-- derived from this software without specific prior written permission. 19-- 20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 32)package "BOOT" 33 34-- Type hasher for old compiler style type names which produces a hash code 35-- compatible with the asharp compiler. Takes a hard error if the type 36-- is parameterized, but has no constructor modemap. 37getDomainHash dom == SPADCALL(CDR dom, (CAR dom).4) 38 39hashType(type, percentHash) == 40 SYMBOLP type => 41 type = '$ => percentHash 42 type = "%" => percentHash 43 hashString SYMBOL_-NAME type 44 STRINGP type => hashCombine(hashString type, 45 hashString('"Enumeration")) 46 type is ['QUOTE, val] => hashType(val, percentHash) 47 type is [dom] => hashString SYMBOL_-NAME dom 48 type is ['_:, ., type2] => hashType(type2, percentHash) 49 isDomain type => getDomainHash type 50 [op, :args] := type 51 hash := hashString SYMBOL_-NAME op 52 op = 'Mapping => 53 hash := hashString '"->" 54 [retType, :mapArgs] := args 55 for arg in mapArgs repeat 56 hash := hashCombine(hashType(arg, percentHash), hash) 57 retCode := hashType(retType, percentHash) 58 EQL(retCode, $VoidHash) => hashCombine(32236, hash) 59 hashCombine(retCode, hashCombine(32236,hash)) 60 op = 'Enumeration => 61 for arg in args repeat 62 hash := hashCombine(hashString(STRING arg), hash) 63 hash 64 op in $DomainsWithoutLisplibs => 65 for arg in args repeat 66 hash := hashCombine(hashType(arg, percentHash), hash) 67 hash 68 69 cmm := CDDAR getConstructorModemap(op) 70 cosig := rest GETDATABASE(op, 'COSIG) 71 for arg in args for c in cosig for ct in cmm repeat 72 if c then 73 hash := hashCombine(hashType(arg, percentHash), hash) 74 else 75 hash := hashCombine(7, hash) 76-- !!! If/when asharp hashes values using their type, use instead 77-- ctt := EQSUBSTLIST(args, $FormalMapVariableList, ct) 78-- hash := hashCombine(hashType(ctt, percentHash), hash) 79 80 81 hash 82 83--The following are in cfuns.lisp 84$hashModulus := 1073741789 -- largest 30-bit prime 85 86-- Produce a 30-bit hash code. This function must produce the same codes 87-- as the asharp string hasher in src/strops.c 88hashString str == 89 h := 0 90 for i in 0..#str-1 repeat 91 j := CHAR_-CODE char str.i 92 h := LOGXOR(h, ASH(h, 8)) 93 h := h + j + 200041 94 h := LOGAND(h, 1073741823) -- 0x3FFFFFFF 95 REM(h, $hashModulus) 96 97-- Combine two hash codes to make a new one. Must be the same as in 98-- the hashCombine function in aslib/runtime.as in asharp. 99 100-- 419AC241: 1100661313 101-- 5577F8E1: 1433925857 102-- 440BADFC05072367: 4903203917250634599 103 104 105$hashZ1 := 1100661313 106$hashZ2 := 1433925857 107$hashZZ := 4903203917250634599 108 109 110hashCombine(hash1, hash2) == 111 h1 := LOGAND(hash1, ASH(1, 32) - 1) 112 h2 := LOGAND(hash2, ASH(1, 32) - 1) 113 LOGAND(ASH((h1*$hashZ1 + h2*$hashZ2) * $hashZZ, -32), 1073741823) 114 115$VoidHash := hashString '"Void" 116