[GOODIE] named primitives without dynamic loading

ohshima at is.titech.ac.jp ohshima at is.titech.ac.jp
Thu Dec 9 15:36:27 UTC 1999


----Next_Part(Fri_Dec_10_00:36:26_1999)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit


  Hi,

  I wrote a snippet of code to make the named primitive
mechanism works on the platform where the dynamic loading
(by name) is not supported.

  The idea is to generate a C data something like:

int (*namedPrimitivesAddr[])() =
  {setInterpreter, gePrimitiveAddLine,
   gePrimitiveAddRect, gePrimitiveSetDepth,
   gePrimitiveSetOffset, gePrimitiveGetTimes, ...};

whose entries are the exported C functions, and lookup the
address of the called primitive at runtime.

  The mapping from the primitive name (a Squeak String) to
the index to the array is done by a perfect hash function
generated by my implementation of the perfect hash function
generator written in Squeak.  (So, the table actually
generated is a bit sparser than that shown above.)  The
algorithm is similar to gperf.  Its heuristics to minimize
the hash table size is not so clever, but at least it works
for 65 named primitives, which 2.6 release uses.  (Sometimes
the table is smaller than generated by gperf).

  I think this is not interesting to the most of people on
the list, but if you want to port the VM to a platform that
doesn't support dynamic loading, it might be worth to see
the code attached.

  Modified 'interp.c' can be generated by evaluating the
expression below:

  Interpreter translate: 'interp.c' doInlining: true keyPositions: #(6 10 12 13 16 18 20 21 30).

  As you see, you have to specify 'keyPositions', which is
used for calculating the hash.

  Any comments are welcome.

  -- Yoshiki

P.S.
   However, thinking the space/speed trade-off, I'm not sure
the perfect hash is really suitable for this purpose.
Simple binary search or something could perform better.

  Further, some primitives have similar name, such as
'gePrimitiveSetDepth' and 'gePrimitiveGetDepth'.  Those pair
make the generation of perfect hash function difficult.

----Next_Part(Fri_Dec_10_00:36:26_1999)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: quoted-printable


'From Squeak2.6 of 11 October 1999 [latest update: #1578] on 10 December=
 1999 at 12:16:39 am'!=0DObject subclass: #PerfectHashGenerator=0D	insta=
nceVariableNames: 'affectedSymbols symbols assocValues keyPositions keyP=
ositionsSize charOccurence hashToSymbols sorted jumpFactor repetition ma=
xHash minHash namedPrimitives namedPrimitivesAddr '=0D	classVariableName=
s: 'WithLength '=0D	poolDictionaries: ''=0D	category: 'Hash-Generator'!=0D=
=0D!CCodeGenerator methodsFor: 'public' stamp: 'yo 12/9/1999 00:03'!=0Dv=
ariables=0D	^variables! !=0D=0D!CCodeGenerator methodsFor: 'C code gener=
ator' stamp: 'yo 12/9/1999 19:21'!=0DemitCCodeOn: aStream doInlining: in=
lineFlag doAssertions: assertionFlag=0D	"Emit C code for all methods in =
the code base onto the given stream. All inlined method calls should alr=
eady have been expanded."=0D=0D	| verbose |=0D	"method preparation"=0D	v=
erbose _ false.=0D	self prepareMethods.=0D	verbose ifTrue: [=0D		self pr=
intUnboundCallWarnings.=0D		self printUnboundVariableReferenceWarnings.=0D=
		Transcript cr.=0D	].=0D	assertionFlag ifFalse: [ self removeAssertions=
 ].=0D	self doInlining: inlineFlag.=0D=0D	"code generation"=0D	methods _=
 methods asSortedCollection: [ :m1 :m2 | m1 selector < m2 selector ].=0D=
	self emitCHeaderOn: aStream.=0D	self emitCFunctionPrototypesOn: aStream=
..=0D	self emitCVariablesOn: aStream.=0D'Writing Translated Code...'=0Ddi=
splayProgressAt: Sensor cursorPoint=0Dfrom: 0 to: methods size=0Dduring:=
 [:bar |=0D	methods doWithIndex: [ :m :i | bar value: i.=0D		m emitCCode=
On: aStream generator: self.=0D]].! !=0D=0D!CCodeGenerator methodsFor: '=
static link support' stamp: 'yo 12/9/1999 00:03'!=0DcomputePerfectHashKe=
yPositions: aCollection=0D	| exported perfect |=0D	perfect _ PerfectHash=
Generator new.=0D	exported _ methods select: [:m | m export].=0D	exporte=
d _ exported collect: [:m | self cFunctionNameFor: m selector].=0D	perfe=
ct symbols: exported keyPositions: aCollection withLength: true jumpFact=
or: 1.=0D=0D	perfect solve.=0D	perfect cCodeInCcg: self.=0D	perfect decl=
areCVarsIn: self.! !=0D=0D=0D!Interpreter methodsFor: 'other primitives'=
 stamp: 'yo 12/9/1999 18:41'!=0DprimitiveExternalCall=0D	"Call an extern=
al primitive. The external primitive methods contain as first literal an=
 array consisting of:=0D		* The module name (String | Symbol)=0D		* The =
function name (String | Symbol)=0D		* The session ID (SmallInteger)=0D		=
* The function address (Integer)=0D	"=0D	| thisSession lit functionAddre=
ss addr moduleName functionName moduleLength functionLength session |=0D=
=0D	self var: #thisSession declareC:'static int thisSession =3D 0'.=0D=0D=
	"Make sure the session is initialized"=0D	thisSession =3D 0 ifTrue:[=0D=
		thisSession _ self ioMicroMSecs bitAnd: 16r1FFFFFFF.=0D		thisSession =3D=
 0 ifTrue:[thisSession _ 1]].=0D=0D	"Fetch the first literal of the meth=
od"=0D	self success: (self literalCountOf: newMethod) > 0.	"@@: Could th=
is be omitted for speed?!!"=0D	successFlag ifFalse:[^nil].=0D	lit _ self=
 literal: 0 ofMethod: newMethod.=0D=0D	"Check if it's an array of length=
 4"=0D	self success: ((self fetchClassOf: lit) =3D (self splObj: ClassAr=
ray) and:[(self lengthOf: lit) =3D 4]).=0D	successFlag ifFalse:[^nil].=0D=
=0D	"Look at the function address and session id in case it has been loa=
ded before"=0D	addr _ self positive32BitValueOf: (self fetchPointer: 3 o=
fObject: lit).=0D	session _ self fetchInteger: 2 ofObject: lit.=0D=0D	"I=
f so, call the function directly"=0D	(successFlag and:[session =3D thisS=
ession and:[addr ~=3D 0]])=0D		ifTrue:[^self cCode:' ((int (*) (void)) a=
ddr) ()'].=0D=0D	"Clean up session id and function address"=0D	self stor=
eInteger: 2 ofObject: lit withValue: 0.=0D	self storeInteger: 3 ofObject=
: lit withValue: 0.=0D=0D	"The function has not been loaded yet. =0D	Fet=
ch module and function name."=0D	moduleName _ self fetchPointer: 0 ofObj=
ect: lit.=0D	moduleName =3D nilObj ifTrue:[=0D		moduleLength _ 0.=0D	] i=
fFalse:[=0D		self success: (self isBytes: moduleName).=0D		moduleLength =
_ self lengthOf: moduleName.=0D	].=0D=0D	functionName _ self fetchPointe=
r: 1 ofObject: lit.=0D	self success: (self isBytes: functionName).=0D	fu=
nctionLength _ self lengthOf: functionName.=0D	successFlag ifFalse:[^nil=
].=0D	"addr _ self ioLoadExternalFunction: functionName + 4=0D				OfLeng=
th: functionLength =0D				FromModule: moduleName + 4=0D				OfLength: mod=
uleLength."=0D	addr _ self addrOfNamedPrimitive: (self cCoerce: (functio=
nName + 4) to: 'char*') length: functionLength.=0D=0D	self success: addr=
 ~=3D 0.=0D=0D	"If the function has been successfully loaded process it"=
=0D	successFlag ifTrue:[=0D		"Store the session ID"=0D		self storeIntege=
r: 2 ofObject: lit withValue: thisSession.=0D		"Store the address back i=
n the literal"=0D		self pushRemappableOop: lit.=0D		functionAddress _ se=
lf positive32BitIntegerFor: addr.=0D		lit _ self popRemappableOop.=0D		s=
elf storePointer: 3 ofObject: lit withValue: functionAddress.=0D		(succe=
ssFlag and:[addr ~=3D 0])=0D			ifTrue:[self cCode:' ((int (*) (void)) ad=
dr) ()'].=0D	].! !=0D=0D=0D!PerfectHashGenerator reorganize!=0D('accessi=
ng' assocValues jumpFactor keyPositions repetition symbols withLength)=0D=
('solving' confirmParameter hashFor:size: solve solve: symbols:keyPositi=
ons:withLength:jumpFactor:)=0D('code generation' addrOfNamedPrimitive:le=
ngth: cCodeInCcg: declareCVarsIn: hashMethodString)=0D('private' conflic=
tRemaining: disjointUnionOf:and: registerSymbol:at: resolveConflictSymbo=
l:hash: sortBlock unregisterSymbol:)=0D!=0D=0D=0D!PerfectHashGenerator m=
ethodsFor: 'accessing' stamp: 'yo 11/29/1999 19:59'!=0DassocValues=0D	^a=
ssocValues! !=0D=0D!PerfectHashGenerator methodsFor: 'accessing' stamp: =
'yo 12/8/1999 18:52'!=0DjumpFactor=0D	^jumpFactor! !=0D=0D!PerfectHashGe=
nerator methodsFor: 'accessing' stamp: 'yo 11/28/1999 18:51'!=0DkeyPosit=
ions=0D	^keyPositions! !=0D=0D!PerfectHashGenerator methodsFor: 'accessi=
ng' stamp: 'yo 11/29/1999 17:59'!=0Drepetition=0D	^repetition! !=0D=0D!P=
erfectHashGenerator methodsFor: 'accessing' stamp: 'yo 11/24/1999 19:03'=
!=0Dsymbols=0D	^symbols! !=0D=0D!PerfectHashGenerator methodsFor: 'acces=
sing' stamp: 'yo 12/9/1999 03:09'!=0DwithLength=0D	^WithLength! !=0D=0D!=
PerfectHashGenerator methodsFor: 'solving' stamp: 'yo 12/9/1999 02:28'!=0D=
confirmParameter=0D	| message |=0D	"self halt."=0D	sorted _ (SortedColle=
ction new: symbols size) sortBlock: [:x :y | x key <=3D y key].=0D	hashT=
oSymbols associationsDo: [:assoc |=0D		sorted add: assoc.=0D	].=0D	messa=
ge _ 'minHash =3D ', (minHash _ sorted first key) printString, ','.=0D	m=
essage _ message, 'maxHash =3D ', (maxHash _ sorted last key) printStrin=
g, ','.=0D	message _ message copyWith: Character cr.=0D	message _ messag=
e, 'loadFactor =3D ', ((symbols size asFloat / (maxHash - minHash + 1))=0D=
										roundTo: 0.01) printString.=0D	message _ message copyWith: Cha=
racter cr.=0D=0D	(self confirm: message, 'is it OK?') ifFalse: [=0D		sel=
f halt.=0D	].=0D		=0D! !=0D=0D!PerfectHashGenerator methodsFor: 'solving=
' stamp: 'yo 12/9/1999 19:55'!=0DhashFor: aSymbol size: size=0D	| hash c=
Size |=0D	self var: #aSymbol declareC: 'char *aSymbol'.=0D=0D	hash _ 0.=0D=
	cSize _ self cCode: 'size - 1' inSmalltalk: [size].=0D=0D	1 to: keyPosi=
tionsSize do: [:keyPosIndex |=0D		(keyPositions at: keyPosIndex) <=3D cS=
ize ifTrue: [=0D			hash _ hash + (assocValues at: (aSymbol at: (keyPosit=
ions at: keyPosIndex))).=0D		].=0D	].=0D=0D	hash _ hash - minHash.=0D=0D=
	WithLength ifTrue: [=0D		^hash + size=0D	] ifFalse: [=0D		^hash.=0D	].=0D=
=0D! !=0D=0D!PerfectHashGenerator methodsFor: 'solving' stamp: 'yo 12/9/=
1999 20:05'!=0Dsolve=0D	| hash num s |=0D	num _ 0.=0D	s _ (symbols keys)=
 asSortedCollection: self sortBlock.=0D	"self halt."=0D	(s) do: [:e |=0D=
		num _ num  + 1.=0D		hash _ self hashFor: e size: e size.=0D		(hashToSy=
mbols includesKey: hash) ifFalse: [=0D			self registerSymbol: e at: hash=
..			=0D		] ifTrue: [=0D			(self resolveConflictSymbol: e hash: hash) ifF=
alse: [=0D				self error: 'unresolved'.=0D			].=0D		].=0D		num ~=3D (has=
hToSymbols size) ifTrue: [self error: 'should not happen'].=0D	].=0D	sel=
f confirmParameter! !=0D=0D!PerfectHashGenerator methodsFor: 'solving' s=
tamp: 'yo 12/9/1999 03:02'!=0Dsolve: ccg=0D	| hash num |=0D	num _ 0.=0D	=
((symbols keys) asSortedCollection: [:x :y | (x size =3D y size) ifTrue:=
 [x > y] ifFalse: [x size > y size]]) do: [:e |=0D		num _ num  + 1.=0D		=
"e =3D 'gePrimitiveAddLine' ifTrue: [self halt]."=0D		hash _ self hashFo=
r: e size: e size.=0D		(hashToSymbols includesKey: hash) ifFalse: [=0D		=
	self registerSymbol: e at: hash.			=0D		] ifTrue: [=0D			(self resolveC=
onflictSymbol: e hash: hash) ifFalse: [=0D				self error: 'unresolved'.=0D=
			].=0D		].=0D		num ~=3D (hashToSymbols size) ifTrue: [self error: 'sho=
uld not happen'].=0D	].=0D	self confirmParameter! !=0D=0D!PerfectHashGen=
erator methodsFor: 'solving' stamp: 'yo 12/9/1999 19:10'!=0Dsymbols: s k=
eyPositions: k withLength: w jumpFactor: j=0D=0D	jumpFactor _ j.=0D	keyP=
ositions _ k.=0D	keyPositionsSize _ k size.=0D	WithLength _ w.=0D=0D	ass=
ocValues _ Dictionary new: 256.=0D	affectedSymbols _ Dictionary new: 256=
..=0D	charOccurence _ Dictionary new: 256.=0D	Character allCharacters do:=
 [:c |=0D		assocValues at: c put: 0.=0D		affectedSymbols at: c put: (Set=
 new: 0).=0D		charOccurence at: c put: 0.=0D	].=0D=0D	symbols _ Dictiona=
ry new: s size.=0D	s do: [:each |=0D		symbols at: each put: 0.=0D		keyPo=
sitions do: [:key |=0D			(key <=3D each size) ifTrue: [=0D				charOccure=
nce at: (each at: key)=0D							put: (charOccurence at: (each at: key)) =
+ 1.=0D			].=0D		].=0D	].=0D=0D	hashToSymbols _ Dictionary new: symbols =
size.=0D	=0D	repetition _ symbols size + 1.=0D	minHash _ 0.=0D=0D	Charac=
ter allCharacters do: [:c |=0D		((charOccurence at: c) =3D 0) ifTrue: [=0D=
			assocValues at: c put: -1.=0D		].=0D	].=0D! !=0D=0D!PerfectHashGenera=
tor methodsFor: 'code generation' stamp: 'yo 12/9/1999 23:02'!=0DaddrOfN=
amedPrimitive: aString length: length=0D	| hash primitiveName |=0D	self =
var: #aString declareC: 'char *aString'.=0D	self var: #primitiveName dec=
lareC: 'char *primitiveName'.=0D=0D	hash _ self hashFor: aString size: l=
ength.=0D	(0 <=3D hash and: [hash <=3D maxHash]) ifTrue: [=0D		primitive=
Name _ namedPrimitives at: hash.=0D=0D		0 to: (length - 1) do: [:i |=0D	=
		(primitiveName at: i) =3D 0 ifTrue: [^0].=0D			(aString at: i) ~=3D (p=
rimitiveName at: i) ifTrue: [=0D				^0.=0D			].=0D		].=0D		((primitiveNa=
me at: length) ~=3D 0) ifTrue: [^0].=0D		^self cCoerce: (namedPrimitives=
Addr at: hash) to: 'int'.=0D	].=0D	^ 0.! !=0D=0D!PerfectHashGenerator me=
thodsFor: 'code generation' stamp: 'yo 12/9/1999 01:02'!=0DcCodeInCcg: c=
cg=0D	| |=0D"	definition _ self hashMethodString."=0D	ccg ifNotNil: [=0D=
		ccg addMethod: ((Compiler new parse: (self class sourceCodeAt: #hashFo=
r:size:) in: self class notifying: nil) asTMethodFromClass: self class).=
=0D		ccg addMethod: ((Compiler new parse: (self class sourceCodeAt: #add=
rOfNamedPrimitive:length:) in: self class notifying: nil) asTMethodFromC=
lass: self class).=0D	].! !=0D=0D!PerfectHashGenerator methodsFor: 'code=
 generation' stamp: 'yo 12/9/1999 19:19'!=0DdeclareCVarsIn: ccg=0D	| nam=
es addrs as sortedIndex sortedHash assoc keyPos |=0D	"self halt."=0D=0D	=
ccg variables addAll: #('namedPrimitives' 'namedPrimitivesAddr' 'minHash=
' 'maxHash' 'assocValues' 'keyPositions' 'keyPositionsSize').=0D	ccg add=
ClassVarsFor: self class class.=0D=0D	sortedHash _ (SortedCollection new=
: symbols size) sortBlock: [:x :y | x value <=3D y value].=0D	hashToSymb=
ols associationsDo: [:elem |=0D		sortedHash add: (elem value -> elem key=
).=0D	].=0D=0D	minHash _ sortedHash first value.=0D	sortedHash do: [:ele=
m | elem value: (elem value - minHash)].=0D	maxHash _ sortedHash last va=
lue.=0D"	minHash _ 0."=0D=0D	names _ WriteStream on: ''.=0D	addrs _ Writ=
eStream on: ''.=0D	as _ WriteStream on: ''.=0D	keyPos _ WriteStream on: =
''.=0D=0D	sortedIndex _ 1.=0D=0D	0 to: maxHash do: [:index |=0D		assoc _=
 sortedHash at: sortedIndex.=0D		assoc value =3D index ifTrue: [=0D			na=
mes nextPut: $".=0D			names nextPutAll: assoc key.=0D			names nextPut: $=
".=0D			names nextPutAll: ', '.=0D			addrs nextPutAll: assoc key.=0D			a=
ddrs nextPutAll: ', '.=0D			sortedIndex _ sortedIndex + 1.=0D		] ifFalse=
: [=0D			names nextPutAll: '"", '.=0D			addrs nextPutAll: '0, '.=0D		].=0D=
	=0D	].=0D	Character allCharacters do: [:c |=0D		(assocValues at: c) =3D=
 -1 ifTrue: [=0D			as nextPutAll: (maxHash + 1) printString.=0D		] ifFal=
se: [=0D			as nextPutAll: (assocValues at: c) printString.=0D		].=0D		as=
 nextPutAll: ', '.=0D	].=0D	ccg var: 'namedPrimitives' declareC: 'char *=
namedPrimitives[',=0D									((maxHash + 1) printString), '] =3D {', (n=
ames contents), '}'.=0D	ccg var: 'namedPrimitivesAddr'=0D		declareC: 'in=
t (*namedPrimitivesAddr[',=0D					(maxHash + 1) printString, '])() =3D {=
', (addrs contents), '}'.=0D	ccg var: 'minHash' declareC: 'int minHash =3D=
 ', minHash printString.=0D	ccg var: 'maxHash' declareC: 'int maxHash =3D=
 ', maxHash printString.=0D	ccg var: 'assocValues' declareC: 'int assocV=
alues[] =3D {', (as contents), '}'.=0D=0D	keyPos nextPutAll: '-1, '.=0D	=
keyPositions do: [:key | keyPos nextPutAll: (key - 1) printString. keyPo=
s nextPutAll: ', '.].=0D	ccg var: 'keyPositions' declareC: 'int keyPosit=
ions[] =3D {', (keyPos contents), '}'.=0D	ccg var: 'keyPositionsSize' de=
clareC: 'int keyPositionsSize =3D ', keyPositionsSize printString.=0D! !=
=0D=0D!PerfectHashGenerator methodsFor: 'code generation' stamp: 'yo 12/=
9/1999 03:10'!=0DhashMethodString=0D	| stream |=0D	"self halt."=0D	strea=
m _ WriteStream on: ''.=0D	sorted _ (SortedCollection new: symbols size)=
 sortBlock: [:x :y | x value <=3D y value].=0D	hashToSymbols association=
sDo: [:assoc |=0D		sorted add: (assoc value -> assoc key).=0D	].=0D	minH=
ash _ sorted first value.=0D	sorted do: [:assoc | assoc value: (assoc va=
lue - minHash)].=0D	maxHash _ sorted last value.=0D=0D	stream nextPutAll=
: 'hashForNamedPrimitive: aSymbol length: length'.=0D	stream nextPut: Ch=
aracter cr.=0D	stream nextPutAll: '=0D	| hash keys |=0D	self var: #keys =
declareC: ''int keys[] =3D =0D'.=0D	stream nextPutAll: '{-1, '.=0D	keyPo=
sitions do: [:key | stream nextPutAll: key printString. stream nextPutAl=
l: ', '.].=0D	stream nextPutAll: '}''.'.=0D	stream nextPut: Character cr=
..=0D	stream nextPutAll: '	self var: #aSymbol declareC: ''char *aSymbol''=
..'.=0D	stream nextPutAll: '=0D	hash _ 0.=0D'.=0D	stream nextPut: Charact=
er tab.=0D	stream nextPutAll: '1 to: '.=0D	stream nextPutAll: keyPositio=
ns size printString.=0D	stream nextPutAll: ' do: [:keyPos |=0D		(keys at=
: keyPos) <=3D length ifTrue: [=0D			hash _ hash + (assocValues at: (aSy=
mbol at: ((keys at: keyPos) -1))).=0D		].=0D	].=0D'.=0D	WithLength ifTru=
e: [=0D		stream nextPutAll: '	hash _ hash + length.\' withCRs.=0D	] ifFa=
lse: [=0D		stream nextPutAll: '	hash _ hash + 0.\' withCRs.=0D	].=0D	str=
eam nextPutAll: '	^hash - '.=0D	stream nextPutAll: minHash printString.=0D=
	minHash _ 0.=0D=0D	^stream contents.=0D! !=0D=0D!PerfectHashGenerator m=
ethodsFor: 'private' stamp: 'yo 12/9/1999 00:06'!=0DconflictRemaining: r=
ehashSymbols=0D	| rehashed hash |=0D=0D	rehashed _ OrderedCollection new=
: rehashSymbols size.=0D=0D	rehashSymbols do: [:sym |=0D		hash _ self ha=
shFor: sym size: sym size.=0D		(hashToSymbols includesKey: hash) ifTrue:=
 [=0D			rehashed do: [:again |=0D				self unregisterSymbol: again.=0D			=
].=0D			^true.=0D		] ifFalse: [=0D			self registerSymbol: sym at: hash.=0D=
			rehashed add: sym.=0D		].=0D	].=0D	^false.=0D! !=0D=0D!PerfectHashGen=
erator methodsFor: 'private' stamp: 'yo 11/29/1999 19:36'!=0DdisjointUni=
onOf: sym1 and: sym2=0D	| set1 set2 duplicate char |=0D	duplicate _ (Set=
 new: keyPositions size * 2).=0D	set1 _ Bag new.=0D	set2 _ Bag new.=0D	k=
eyPositions do: [:pos |=0D		pos <=3D sym1 size ifTrue: [=0D			char _ sym=
1 at: pos.=0D			duplicate add: char.=0D			set1 add: char.=0D		].=0D		pos=
 <=3D sym2 size ifTrue: [=0D			char _ sym2 at: pos.=0D			duplicate add: =
char.=0D			set2 add: char.=0D		].=0D	].=0D	^duplicate reject: [:c | (set=
1 includes: c) and: [set2 includes: c]].! !=0D=0D!PerfectHashGenerator m=
ethodsFor: 'private' stamp: 'yo 12/8/1999 23:24'!=0DregisterSymbol: sym =
at: hash=0D	| char |=0D	hashToSymbols at: hash put: sym.=0D	symbols at: =
sym put: hash.=0D	keyPositions do: [:keySig |=0D		keySig <=3D sym size i=
fTrue: [=0D			char _ (sym at: keySig).=0D			(affectedSymbols at: char) a=
dd: sym.=0D		].=0D	].=0D! !=0D=0D!PerfectHashGenerator methodsFor: 'priv=
ate' stamp: 'yo 12/9/1999 20:07'!=0DresolveConflictSymbol: aSymbol hash:=
 hash=0D	| previous candidates rehashSymbols oldAssocValues rehash |=0D=0D=
	previous _ (hashToSymbols at: hash).=0D=0D	candidates _ (self disjointU=
nionOf: aSymbol and: previous) asArray.=0D=0D	candidates do: [:c |=0D		r=
ehashSymbols _ (affectedSymbols at: c) asArray.=0D		rehashSymbols do: [:=
sym | self unregisterSymbol: sym].=0D=0D		oldAssocValues _ assocValues c=
opy.=0D=0D		repetition timesRepeat: [=0D			assocValues at: c put: (assoc=
Values at: c) + jumpFactor.=0D			(self conflictRemaining: (rehashSymbols=
 copyWith: aSymbol)) ifFalse: [=0D				^true.=0D			].=0D		].=0D=0D		assoc=
Values _ oldAssocValues.=0D		rehashSymbols do: [:e |=0D			rehash _ self =
hashFor: e size: e size.=0D			(hashToSymbols includesKey: rehash) ifFals=
e: [=0D				self registerSymbol: e at: rehash.			=0D			] ifTrue: [=0D				=
self error: 'should not happen'.=0D			].=0D		].=0D	].=0D	^false.=0D! !=0D=
=0D!PerfectHashGenerator methodsFor: 'private' stamp: 'yo 12/9/1999 18:3=
3'!=0DsortBlock=0D	| sx sy |=0D	^[:x :y |=0D		sx _ 0.=0D		sy _ 0.=0D		ke=
yPositions do: [:key |=0D			(key <=3D x size) ifTrue: [=0D				sx _ sx + =
(charOccurence at: (x at: key)).=0D			].=0D			(key <=3D y size) ifTrue: =
[=0D				sy _ sy + (charOccurence at: (y at: key)).=0D			].=0D		].=0D		(s=
x =3D sy) ifTrue: [=0D			x size > y size=0D		] ifFalse: [=0D			sx > sy=0D=
		].=0D	].=0D		! !=0D=0D!PerfectHashGenerator methodsFor: 'private' stam=
p: 'yo 12/8/1999 23:25'!=0DunregisterSymbol: sym=0D	| char |=0D	hashToSy=
mbols removeKey: (symbols at: sym) ifAbsent: [self error: 'should not ha=
ppen'].=0D	symbols at: sym put: 0.=0D	keyPositions do: [:keySig |=0D		ke=
ySig <=3D sym size ifTrue: [=0D			char _ (sym at: keySig).=0D			(affecte=
dSymbols at: char) remove: sym ifAbsent: ["this occasionary happens"].=0D=
		].=0D	].=0D=0D=0D! !=0D=0D=0D!PerfectHashGenerator class methodsFor: '=
as yet unclassified' stamp: 'yo 12/9/1999 19:02'!=0Dtest  "PerfectHashGe=
nerator test"=0D	| mnames gen |=0D	mnames _ #('m23PrimitiveTransformPoin=
t' 'gePrimitiveNeedsFlush' 'm23PrimitiveIsIdentity' 'setInterpreter' 'm2=
3PrimitiveIsPureTranslation' 'primitiveFloatArrayAddScalar' 'primitiveFl=
oatArrayAt' 'gePrimitiveSetAALevel' 'primitiveFloatArrayDivFloatArray' '=
m23PrimitiveTransformRectInto' 'gePrimitiveCopyBuffer' 'm23PrimitiveInve=
rtRectInto' 'gePrimitiveAddActiveEdgeEntry' 'gePrimitiveGetCounts' 'gePr=
imitiveSetOffset' 'gePrimitiveAddGradientFill' 'gePrimitiveChangedActive=
EdgeEntry' 'gePrimitiveRegisterExternalFill' 'gePrimitiveGetDepth' 'gePr=
imitiveSetEdgeTransform' 'primitiveFloatArrayEqual' 'gePrimitiveAddOval'=
 'primitiveFloatArrayDivScalar' 'primitiveFloatArrayMulScalar' 'primitiv=
eFloatArraySubScalar' 'gePrimitiveGetTimes' 'gePrimitiveSetClipRect' 'pr=
imitiveFloatArrayMulFloatArray' 'gePrimitiveAddBezier' 'primitiveFloatAr=
rayAddFloatArray' 'primitiveFloatArraySubFloatArray' 'gePrimitiveRenderI=
mage' 'gePrimitiveGetAALevel' 'gePrimitiveAddLine' 'primitiveFFTScaleDat=
a' 'primitiveFloatArrayHash' 'gePrimitiveInitializeBuffer' 'gePrimitiveA=
ddRect' 'primitiveFFTTransformData' 'primitiveFloatArrayAtPut' 'gePrimit=
iveMergeFillFrom' 'gePrimitiveSetDepth' 'gePrimitiveAbortProcessing' 'ge=
PrimitiveRenderScanline' 'gePrimitiveFinishedProcessing' 'gePrimitiveAdd=
BezierShape' 'gePrimitiveDoProfileStats' 'gePrimitiveAddCompressedShape'=
 'gePrimitiveGetBezierStats' 'gePrimitiveNextActiveEdgeEntry' 'gePrimiti=
veNeedsFlushPut' 'gePrimitiveRegisterExternalEdge' 'gePrimitiveAddBitmap=
Fill' 'gePrimitiveInitializeProcessing' 'primitiveFFTPermuteData' 'gePri=
mitiveGetClipRect' 'gePrimitiveGetFailureReason' 'gePrimitiveNextGlobalE=
dgeEntry' 'gePrimitiveNextFillEntry' 'm23PrimitiveComposeMatrix' 'gePrim=
itiveSetColorTransform' 'gePrimitiveDisplaySpanBuffer' 'm23PrimitiveInve=
rtPoint' 'gePrimitiveGetOffset' 'gePrimitiveAddPolygon' ).=0D=0D	gen _ P=
erfectHashGenerator new.=0D	gen symbols: mnames keyPositions: #(6 10 12 =
13 16 18 20 21 30) withLength: true jumpFactor: 1.=0D=0D	gen solve.=0D	^=
gen=0D! !=0D=0D=0D=

----Next_Part(Fri_Dec_10_00:36:26_1999)----





More information about the Squeak-dev mailing list