[squeak-dev] The Trunk: System-ul.774.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Oct 26 23:46:45 UTC 2015


Levente Uzonyi uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ul.774.mcz

==================== Summary ====================

Name: System-ul.774
Author: ul
Time: 27 October 2015, 1:44:16.212 am
UUID: 5c00c594-7a1a-4148-9b3b-bfe6ae6486e1
Ancestors: System-ul.773

Reverted some of the less efficient optimizations.

=============== Diff against System-mt.772 ===============

Item was changed:
  Object subclass: #SecureHashAlgorithm
  	instanceVariableNames: 'totalA totalB totalC totalD totalE totals'
+ 	classVariableNames: 'K1 K2 K3 K4 TA TB TC TD TE TI'
- 	classVariableNames: 'K1 K2 K3 K4'
  	poolDictionaries: ''
  	category: 'System-Digital Signatures'!
  
  !SecureHashAlgorithm commentStamp: '<historical>' prior: 0!
  This class implements the Secure Hash Algorithm (SHA) described in the U.S. government's Secure Hash Standard (SHS). This standard is described in FIPS PUB 180-1, "SECURE HASH STANDARD", April 17, 1995.
  
  The Secure Hash Algorithm is also described on p. 442 of 'Applied Cryptography: Protocols, Algorithms, and Source Code in C' by Bruce Scheier, Wiley, 1996.
  
  See the comment in class DigitalSignatureAlgorithm for details on its use.
  
  Implementation notes:
  The secure hash standard was created with 32-bit hardware in mind. All arithmetic in the hash computation must be done modulo 2^32. This implementation uses ThirtyTwoBitRegister objects to simulate hardware registers; this implementation is about six times faster than using LargePositiveIntegers (measured on a Macintosh G3 Powerbook). Implementing a primitive to process each 64-byte buffer would probably speed up the computation by a factor of 20 or more.
  !

Item was changed:
  ----- Method: SecureHashAlgorithm class>>initialize (in category 'class initialization') -----
  initialize
  	"SecureHashAlgorithm initialize"
  	"For the curious, here's where these constants come from:
  	  #(2 3 5 10) collect: [:x | ((x sqrt / 4.0) * (2.0 raisedTo: 32)) truncated hex]"
  
  	K1 := ThirtyTwoBitRegister fromInteger: 16r5A827999.
  	K2 := ThirtyTwoBitRegister fromInteger: 16r6ED9EBA1.
  	K3 := ThirtyTwoBitRegister fromInteger: 16r8F1BBCDC.
  	K4 := ThirtyTwoBitRegister fromInteger: 16rCA62C1D6.
+ 	
+ 	TA := ThirtyTwoBitRegister fromInteger: 16r67452301.
+ 	TB := ThirtyTwoBitRegister fromInteger: 16rEFCDAB89.
+ 	TC := ThirtyTwoBitRegister fromInteger: 16r98BADCFE.
+ 	TD := ThirtyTwoBitRegister fromInteger: 16r10325476.
+ 	TE := ThirtyTwoBitRegister fromInteger: 16rC3D2E1F0.
+ 	(TI := Bitmap new: 5)
+ 		at: 1 put: 16r67452301;	
+ 		at: 2 put: 16rEFCDAB89;
+ 		at: 3 put: 16r98BADCFE;
+ 		at: 4 put: 16r10325476;
+ 		at: 5 put: 16rC3D2E1F0!
- !

Item was changed:
  ----- Method: SecureHashAlgorithm>>expandedBlock: (in category 'private') -----
  expandedBlock: aByteArray
+ 	"Convert the given 64 byte buffer into 80 32-bit registers and answer the result."
+ 
+ 	| out src |
- 	"Convert the given 64 byte buffer into 80 32-bit registers and answer the result." 
- 	| out src v |
  	out := Array new: 80.
  	src := 1.
  	1 to: 16 do: [:i |
  		out at: i put: (ThirtyTwoBitRegister fromByteArray: aByteArray at: src).
  		src := src + 4].
  
  	17 to: 80 do: [:i |
+ 		out at: i put: (
+ 			(out at: i - 3) copy
+ 				bitXor: (out at: i - 8);
+ 				bitXor: (out at: i - 14);
+ 				bitXor: (out at: i - 16);
+ 				leftRotateBy: 1) ].
- 		v := (out at: i - 3) copy.
- 		v	bitXor: (out at: i - 8);
- 			bitXor: (out at: i - 14);
- 			bitXor: (out at: i - 16);
- 			leftRotateBy: 1.
- 		out at: i put: v].
  	^ out
  !

Item was changed:
  ----- Method: SecureHashAlgorithm>>finalHash (in category 'private') -----
  finalHash
  	"Concatenate the final totals to build the 160-bit integer result."
  	"Details: If the primitives are supported, the results are in the totals array. Otherwise, they are in the instance variables totalA through totalE."
  
+ 	| result |
+ 	result := ByteArray new: 20.
+ 	totals 
+ 		ifNil: [ "compute final hash when not using primitives"
+ 			result
+ 				unsignedShortAt: 1 put: totalE low bigEndian: false;
+ 				unsignedShortAt: 3 put: totalE hi bigEndian: false;
+ 				unsignedShortAt: 5 put: totalD low bigEndian: false;
+ 				unsignedShortAt: 7 put: totalD hi bigEndian: false;
+ 				unsignedShortAt: 9 put: totalC low bigEndian: false;
+ 				unsignedShortAt: 11 put: totalC hi bigEndian: false;
+ 				unsignedShortAt: 13 put: totalB low bigEndian: false;
+ 				unsignedShortAt: 15 put: totalB hi bigEndian: false;
+ 				unsignedShortAt: 17 put: totalA low bigEndian: false;
+ 				unsignedShortAt: 19 put: totalA hi bigEndian: false ]
+ 		ifNotNil: [ "compute final hash when using primitives"
+ 			result
+ 				unsignedLongAt: 1 put: (totals at: 5) bigEndian: false;
+ 				unsignedLongAt: 5 put: (totals at: 4) bigEndian: false;
+ 				unsignedLongAt: 9 put: (totals at: 3) bigEndian: false;
+ 				unsignedLongAt: 13 put: (totals at: 2) bigEndian: false;
+ 				unsignedLongAt: 17 put: (totals at: 1) bigEndian: false ].
+ 	^(LargePositiveInteger new: result size)
+ 		replaceFrom: 1
+ 			to: result size
+ 			with: result
+ 			startingAt: 1;
+ 		normalize!
- 	| r |
- 	totals ifNil: [  "compute final hash when not using primitives"
- 		^ (totalA asInteger bitShift: 128) +
- 		  (totalB asInteger bitShift:  96) +
- 		  (totalC asInteger bitShift:  64) +
- 		  (totalD asInteger bitShift:  32) +
- 		  (totalE asInteger)].
- 
- 	"compute final hash when using primitives"
- 	r := 0.
- 	1 to: 5 do: [:i |
- 		r := r bitOr: ((totals at: i) bitShift: (32 * (5 - i)))].
- 	^ r
- !

Item was removed:
- ----- Method: SecureHashAlgorithm>>hashFunction:of:with:with: (in category 'private') -----
- hashFunction: i of: x with: y with: z
- 	"Compute the hash function for the i-th step of the block hash loop. We number our steps 1-80, versus the 0-79 of the standard."
- 	"Details: There are four functions, one for each 20 iterations. The second and fourth are the same."
- 
- 	i <= 20 ifTrue: [^ x copy bitAnd: y; bitOr: (x copy bitInvert; bitAnd: z)].
- 	i <= 40 ifTrue: [^ x copy bitXor: y; bitXor: z].
- 	i <= 60 ifTrue: [^ x copy bitAnd: y; bitOr: (x copy bitAnd: z); bitOr: (y copy bitAnd: z)].
- 	^ x copy bitXor: y; bitXor: z
- !

Item was added:
+ ----- Method: SecureHashAlgorithm>>hashFunction:of:with:with:using:and: (in category 'private') -----
+ hashFunction: i of: x with: y with: z using: t1 and: t2
+ 	"Compute the hash function for the i-th step of the block hash loop. We number our steps 1-80, versus the 0-79 of the standard."
+ 	"Details: There are four functions, one for each 20 iterations. The second and fourth are the same."
+ 
+ 	t1 loadFrom: x.
+ 	i <= 20 ifTrue: [
+ 		t2
+ 			loadFrom: x;
+ 			bitInvert;
+ 			bitAnd: z.
+ 		^t1
+ 			bitAnd: y;
+ 			bitOr: t2 ].
+ 	i <= 40 ifTrue: [
+ 		^t1
+ 			bitXor: y;
+ 			bitXor: z ].
+ 	i <= 60 ifTrue: [
+ 		t2
+ 			loadFrom: x;
+ 			bitOr: y;
+ 			bitAnd: z.
+ 		^t1
+ 			bitAnd: y;
+ 			bitOr: t2 ].
+ 	^t1
+ 		bitXor: y;
+ 		bitXor: z
+ !

Item was changed:
  ----- Method: SecureHashAlgorithm>>hashInteger:seed: (in category 'public') -----
  hashInteger: aPositiveInteger seed: seedInteger
  	"Hash the given positive integer. The integer to be hashed should have 512 or fewer bits. This entry point is used in the production of random numbers"
  
  	| buffer dstIndex |
  	"Initialize totalA through totalE to their seed values."
+ 	totals
+ 		ifNil: [
+ 			totalA := ThirtyTwoBitRegister
+ 				fromInteger: ((seedInteger bitShift: -128) bitAnd: 16rFFFFFFFF).
+ 			totalB := ThirtyTwoBitRegister
+ 				fromInteger: ((seedInteger bitShift: -96) bitAnd: 16rFFFFFFFF).
+ 			totalC := ThirtyTwoBitRegister
+ 				fromInteger: ((seedInteger bitShift: -64) bitAnd: 16rFFFFFFFF).
+ 			totalD := ThirtyTwoBitRegister
+ 				fromInteger: ((seedInteger bitShift: -32) bitAnd: 16rFFFFFFFF).
+ 			totalE := ThirtyTwoBitRegister
+ 				fromInteger: (seedInteger bitAnd: 16rFFFFFFFF) ]
+ 		ifNotNil: [
+ 			totals
+ 				at: 1 put: ((seedInteger bitShift: -128) bitAnd: 16rFFFFFFFF);
+ 				at: 2 put: ((seedInteger bitShift: -96) bitAnd: 16rFFFFFFFF);
+ 				at: 3 put: ((seedInteger bitShift: -64) bitAnd: 16rFFFFFFFF);
+ 				at: 4 put: ((seedInteger bitShift: -32) bitAnd: 16rFFFFFFFF);
+ 				at: 5 put: (seedInteger bitAnd: 16rFFFFFFFF) ].
- 	totalA := ThirtyTwoBitRegister
- 		fromInteger: ((seedInteger bitShift: -128) bitAnd: 16rFFFFFFFF).
- 	totalB := ThirtyTwoBitRegister
- 		fromInteger: ((seedInteger bitShift: -96) bitAnd: 16rFFFFFFFF).
- 	totalC := ThirtyTwoBitRegister
- 		fromInteger: ((seedInteger bitShift: -64) bitAnd: 16rFFFFFFFF).
- 	totalD := ThirtyTwoBitRegister
- 		fromInteger: ((seedInteger bitShift: -32) bitAnd: 16rFFFFFFFF).
- 	totalE := ThirtyTwoBitRegister
- 		fromInteger: (seedInteger bitAnd: 16rFFFFFFFF).
- 	self initializeTotalsArray.
- 
  	"pad integer with zeros"
  	buffer := ByteArray new: 64.
  	dstIndex := 0.
  	aPositiveInteger digitLength to: 1 by: -1 do: [:i |
  		buffer at: (dstIndex := dstIndex + 1) put: (aPositiveInteger digitAt: i)].
  
  	"process that one block"
  	self processBuffer: buffer.
  
  	^ self finalHash
  !

Item was changed:
  ----- Method: SecureHashAlgorithm>>hashStream: (in category 'public') -----
  hashStream: aPositionableStream
  	"Hash the contents of the given stream from the current position to the end using the Secure Hash Algorithm. The SHA algorithm is defined in FIPS PUB 180-1. It is also described on p. 442 of 'Applied Cryptography: Protocols, Algorithms, and Source Code in C' by Bruce Scheier, Wiley, 1996."
  	"SecureHashAlgorithm new hashStream: (ReadStream on: 'foo')"
  
  	| startPosition buf bitLength |
  	self initializeTotals.
  
  	"(SecureHashAlgorithm new hashMessage: '') radix: 16 	
  	=> 'DA39A3EE5E6B4B0D3255BFEF95601890AFD80709'"
+ 	aPositionableStream atEnd ifTrue: [self processFinalBuffer: #[] bitLength: 0].
- 	aPositionableStream atEnd ifTrue: [self processFinalBuffer: #() bitLength: 0].
  
  	startPosition := aPositionableStream position.
+ 	buf := ByteArray new: 64.
  	[aPositionableStream atEnd] whileFalse: [
+ 		buf := aPositionableStream next: 64 into: buf startingAt: 1.
- 		buf := aPositionableStream next: 64.
  		(aPositionableStream atEnd not and: [buf size = 64])
  			ifTrue: [self processBuffer: buf]
  			ifFalse: [
  				bitLength := (aPositionableStream position - startPosition) * 8.
  				self processFinalBuffer: buf bitLength: bitLength]].
  
  	^ self finalHash
  !

Item was added:
+ ----- Method: SecureHashAlgorithm>>initialize (in category 'initialize-release') -----
+ initialize
+ 
+ 	self primHasSecureHashPrimitive
+ 		ifTrue: [ totals := Bitmap new: 5 ]
+ 		ifFalse: [
+ 			totalA := ThirtyTwoBitRegister new.
+ 			totalB := ThirtyTwoBitRegister new.
+ 			totalC := ThirtyTwoBitRegister new.
+ 			totalD := ThirtyTwoBitRegister new.
+ 			totalE := ThirtyTwoBitRegister new ]!

Item was changed:
  ----- Method: SecureHashAlgorithm>>initializeTotals (in category 'private') -----
  initializeTotals
  	"Initialize totalA through totalE to their seed values."
  
+ 	totals
+ 		ifNil: [
+ 			"total registers for use when primitives are absent"
+ 			totalA loadFrom: TA.
+ 			totalB loadFrom: TB.
+ 			totalC loadFrom: TC.
+ 			totalD loadFrom: TD.
+ 			totalE loadFrom: TE ]
+ 		ifNotNil: [
+ 			totals
+ 				replaceFrom: 1
+ 				to: totals size
+ 				with: TI
+ 				startingAt: 1 ]!
- 	"total registers for use when primitives are absent"
- 	totalA := ThirtyTwoBitRegister fromInteger: 16r67452301.
- 	totalB := ThirtyTwoBitRegister fromInteger: 16rEFCDAB89.
- 	totalC := ThirtyTwoBitRegister fromInteger: 16r98BADCFE.
- 	totalD := ThirtyTwoBitRegister fromInteger: 16r10325476.
- 	totalE := ThirtyTwoBitRegister fromInteger: 16rC3D2E1F0.
- 	self initializeTotalsArray.
- !

Item was removed:
- ----- Method: SecureHashAlgorithm>>initializeTotalsArray (in category 'private') -----
- initializeTotalsArray
- 	"Initialize the totals array from the registers for use with the primitives."
- 
- 	totals := Bitmap new: 5.
- 	totals at: 1 put: totalA asInteger.
- 	totals at: 2 put: totalB asInteger.
- 	totals at: 3 put: totalC asInteger.
- 	totals at: 4 put: totalD asInteger.
- 	totals at: 5 put: totalE asInteger.
- !

Item was changed:
  ----- Method: SecureHashAlgorithm>>processBuffer: (in category 'private') -----
  processBuffer: aByteArray
  	"Process given 64-byte buffer, accumulating the results in totalA through totalE."
  
+ 	| a b c d e t tmp w tmp2 tmp3 |
+ 	totals ifNotNil: [ ^self processBufferUsingPrimitives: aByteArray ].
- 	| a b c d e w tmp |
- 	self primHasSecureHashPrimitive
- 		ifTrue: [^ self processBufferUsingPrimitives: aByteArray]
- 		ifFalse: [totals := nil].
  
  	"initialize registers a through e from the current totals" 
  	a := totalA copy.
  	b := totalB copy.
  	c := totalC copy.
  	d := totalD copy.
  	e := totalE copy.
  
  	"expand and process the buffer"
  	w := self expandedBlock: aByteArray.
+ 	tmp := ThirtyTwoBitRegister new.
+ 	tmp2 := ThirtyTwoBitRegister new.
+ 	tmp3 := ThirtyTwoBitRegister new.
  	1 to: 80 do: [:i |
+ 		tmp
+ 			loadFrom: a;
+ 			leftRotateBy: 5;
+ 			+= (self hashFunction: i of: b with: c with: d using: tmp2 and: tmp3);
- 		tmp := (a copy leftRotateBy: 5)
- 			+= (self hashFunction: i of: b with: c with: d);
  			+= e;
  			+= (w at: i);
  			+= (self constantForStep: i).
+ 		t := e.
  		e := d.
  		d := c.
  		c := b leftRotateBy: 30.
  		b := a.
+ 		a := tmp.
+ 		tmp := t ].
- 		a := tmp].
  
  	"add a through e into total accumulators"
  	totalA += a.
  	totalB += b.
  	totalC += c.
  	totalD += d.
  	totalE += e.
  !



More information about the Squeak-dev mailing list