[Vm-dev] VM Maker: VMMaker-oscog.18.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Sun Jul 4 04:20:09 UTC 2010


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://www.squeaksource.com/VMMaker/VMMaker-oscog.18.mcz

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

Name: VMMaker-oscog.18
Author: eem
Time: 3 July 2010, 7:15:06 am
UUID: 66fabf9e-52f4-43aa-a0fc-023e1c0e686e
Ancestors: VMMaker-oscog.17

BitBltSImulation:
	Juan Vuletich's fixes for combination rules that need to be
	handled as RGBA, not RGB.  Fixes font rendering in 4.1 images.

CogVM:
	FIx symbolicMethod:'s initial latest continuation (simulator)
	CogMethodSurrogate>>isZero for simulation
	set-up the quitBlock to close simulation window

=============== Diff against VMMaker-oscog.17 ===============

Item was changed:
  ----- Method: BitBltSimulation>>partitionedMul:with:nBits:nPartitions: (in category 'combination rules') -----
  partitionedMul: word1 with: word2 nBits: nBits nPartitions: nParts
  	"Multiply word1 with word2 as nParts partitions of nBits each.
  	This is useful for packed pixels, or packed colors.
  	Bug in loop version when non-white background"
  
  	| sMask product result dMask |
+ 	"In C, integer multiplication might answer a wrong value if the unsigned values are declared as signed.
+ 	This problem does not affect this method, because the most significant bit (i.e. the sign bit) will
+ 	always be zero (jmv)"
  	sMask := maskTable at: nBits.  "partition mask starts at the right"
  	dMask :=  sMask << nBits.
  	result := (((word1 bitAnd: sMask)+1) * ((word2 bitAnd: sMask)+1) - 1 
  				bitAnd: dMask) >> nBits.	"optimized first step"
+ 	nParts = 1
+ 		ifTrue: [ ^result ].
  	product := (((word1>>nBits bitAnd: sMask)+1) * ((word2>>nBits bitAnd: sMask)+1) - 1 bitAnd: dMask).
+ 	result := result bitOr: product.
+ 	nParts = 2
+ 		ifTrue: [ ^result ].
- 	result := result bitOr: (product bitAnd: dMask).
  	product := (((word1>>(2*nBits) bitAnd: sMask)+1) * ((word2>>(2*nBits) bitAnd: sMask)+1) - 1 bitAnd: dMask).
+ 	result := result bitOr: product << nBits.
+ 	nParts = 3
+ 		ifTrue: [ ^result ].
+ 	product := (((word1>>(3*nBits) bitAnd: sMask)+1) * ((word2>>(3*nBits) bitAnd: sMask)+1) - 1 bitAnd: dMask).
+ 	result := result bitOr: product << (2*nBits).
- 	result := result bitOr: (product bitAnd: dMask) << nBits.
  	^ result
- 
  
  "	| sMask product result dMask |
  	sMask := maskTable at: nBits.  'partition mask starts at the right'
  	dMask :=  sMask << nBits.
  	result := (((word1 bitAnd: sMask)+1) * ((word2 bitAnd: sMask)+1) - 1 
  				bitAnd: dMask) >> nBits.	'optimized first step'
  	nBits to: nBits * (nParts-1) by: nBits do: [:ofs |
  		product := (((word1>>ofs bitAnd: sMask)+1) * ((word2>>ofs bitAnd: sMask)+1) - 1 bitAnd: dMask).
  		result := result bitOr: (product bitAnd: dMask) << (ofs-nBits)].
  	^ result"!

Item was changed:
  ----- Method: BitBltSimulation>>partitionedMin:with:nBits:nPartitions: (in category 'combination rules') -----
  partitionedMin: word1 with: word2 nBits: nBits nPartitions: nParts
  	"Min word1 to word2 as nParts partitions of nBits each"
  	| mask result |
+ 	"In C, most arithmetic operations answer the same bit pattern regardless of the operands being signed or unsigned ints
+ 	(this is due to the way 2's complement numbers work). However, comparisions might fail. Add the proper declaration of
+ 	words as unsigned int in those cases where comparisions are done (jmv)"
+ 	<var: #word1 type: 'unsigned int'>
+ 	<var: #word2 type: 'unsigned int'>
+ 	<var: #mask type: 'unsigned int'>
+ 	<var: #result type: 'unsigned int'>
  	mask := maskTable at: nBits.  "partition mask starts at the right"
  	result := 0.
  	1 to: nParts do:
  		[:i |
  		result := result bitOr: ((word2 bitAnd: mask) min: (word1 bitAnd: mask)).
  		mask := mask << nBits  "slide left to next partition"].
  	^ result
  !

Item was changed:
  ----- Method: BitBltSimulation>>partitionedMax:with:nBits:nPartitions: (in category 'combination rules') -----
  partitionedMax: word1 with: word2 nBits: nBits nPartitions: nParts
  	"Max word1 to word2 as nParts partitions of nBits each"
  	| mask result |
+ 	"In C, most arithmetic operations answer the same bit pattern regardless of the operands being signed or unsigned ints
+ 	(this is due to the way 2's complement numbers work). However, comparisions might fail. Add the proper declaration of
+ 	words as unsigned int in those cases where comparisions are done (jmv)"
+ 	<var: #word1 type: 'unsigned int'>
+ 	<var: #word2 type: 'unsigned int'>
+ 	<var: #mask type: 'unsigned int'>
+ 	<var: #result type: 'unsigned int'>
  	mask := maskTable at: nBits.  "partition mask starts at the right"
  	result := 0.
  	1 to: nParts do:
  		[:i |
  		result := result bitOr: ((word2 bitAnd: mask) max: (word1 bitAnd: mask)).
  		mask := mask << nBits  "slide left to next partition"].
  	^ result
  !

Item was changed:
  ----- Method: BitBltSimulation>>rgbMul:with: (in category 'combination rules') -----
  rgbMul: sourceWord with: destinationWord
  	<inline: false>
  	destDepth < 16 ifTrue:
  		["Mul each pixel separately"
  		^ self partitionedMul: sourceWord with: destinationWord
  						nBits: destDepth nPartitions: destPPW].
  	destDepth = 16 ifTrue:
  		["Mul RGB components of each pixel separately"
  		^ (self partitionedMul: sourceWord with: destinationWord
  						nBits: 5 nPartitions: 3)
  		+ ((self partitionedMul: sourceWord>>16 with: destinationWord>>16
  						nBits: 5 nPartitions: 3) << 16)]
  	ifFalse:
+ 		["Mul RGBA components of the pixel separately"
- 		["Mul RGB components of the pixel separately"
  		^ self partitionedMul: sourceWord with: destinationWord
+ 						nBits: 8 nPartitions: 4]
- 						nBits: 8 nPartitions: 3]
  
  "	| scanner |
  	Display repaintMorphicDisplay.
  	scanner := DisplayScanner quickPrintOn: Display.
+ 	MessageTally time: [0 to: 760 by: 4 do:  [:y |scanner drawString: 'qwrepoiuasfd=)(/&()=#!!lkjzxv.,mn124+09857907QROIYTOAFDJZXNBNB,M-.,Mqwrepoiuasfd=)(/&()=#!!lkjzxv.,mn124+09857907QROIYTOAFDJZXNBNB,M-.,M1234124356785678' at: 0 at y]]. "!
- 	MessageTally time: [0 to: 760 by: 4 do:  [:y |scanner drawString: 'qwrepoiuasfd=)(/&()=#!!¡lkjzxv.,mn124+09857907QROIYTOAFDJZXNBNB,M-.,Mqwrepoiuasfd=)(/&()=#!!¡lkjzxv.,mn124+09857907QROIYTOAFDJZXNBNB,M-.,M1234124356785678' at: 0 at y]]. "!

Item was changed:
  ----- Method: CogVMSimulator>>runWithBreakCount: (in category 'testing') -----
  runWithBreakCount: theBreakCount
  	"Just run, halting when byteCount is reached"
+ 	quitBlock := [([transcript dependents anyOne outermostMorphThat: [:m| m isSystemWindow]]
+ 					on: Error
+ 					do: [:ex| nil])
+ 						ifNotNil: [:window| (UIManager default confirm: 'close?') ifTrue: [window delete]].
+ 				  ^self].
- 	quitBlock := [^self].
  	breakCount := theBreakCount.
  	self initStackPages.
  	self loadInitialContext.
  	self initialEnterSmalltalkExecutive!

Item was changed:
  ----- Method: BitBltSimulation>>rgbSub:with: (in category 'combination rules') -----
  rgbSub: sourceWord with: destinationWord
  	<inline: false>
  	destDepth < 16 ifTrue:
  		["Sub each pixel separately"
  		^ self partitionedSub: sourceWord from: destinationWord
  						nBits: destDepth nPartitions: destPPW].
  	destDepth = 16 ifTrue:
  		["Sub RGB components of each pixel separately"
  		^ (self partitionedSub: sourceWord from: destinationWord
  						nBits: 5 nPartitions: 3)
  		+ ((self partitionedSub: sourceWord>>16 from: destinationWord>>16
  						nBits: 5 nPartitions: 3) << 16)]
  	ifFalse:
+ 		["Sub RGBA components of the pixel separately"
- 		["Sub RGB components of the pixel separately"
  		^ self partitionedSub: sourceWord from: destinationWord
+ 						nBits: 8 nPartitions: 4]!
- 						nBits: 8 nPartitions: 3]!

Item was changed:
  ----- Method: BitBltSimulation>>rgbAdd:with: (in category 'combination rules') -----
  rgbAdd: sourceWord with: destinationWord
  	<inline: false>
  	destDepth < 16 ifTrue:
  		["Add each pixel separately"
  		^ self partitionedAdd: sourceWord to: destinationWord
  						nBits: destDepth nPartitions: destPPW].
  	destDepth = 16 ifTrue:
  		["Add RGB components of each pixel separately"
  		^ (self partitionedAdd: sourceWord to: destinationWord
  						nBits: 5 nPartitions: 3)
  		+ ((self partitionedAdd: sourceWord>>16 to: destinationWord>>16
  						nBits: 5 nPartitions: 3) << 16)]
  	ifFalse:
+ 		["Add RGBA components of the pixel separately"
- 		["Add RGB components of the pixel separately"
  		^ self partitionedAdd: sourceWord to: destinationWord
+ 						nBits: 8 nPartitions: 4]!
- 						nBits: 8 nPartitions: 3]!

Item was changed:
  ----- Method: BitBltSimulation>>rgbMax:with: (in category 'combination rules') -----
  rgbMax: sourceWord with: destinationWord
  	<inline: false>
  	destDepth < 16 ifTrue:
  		["Max each pixel separately"
  		^ self partitionedMax: sourceWord with: destinationWord
  						nBits: destDepth nPartitions: destPPW].
  	destDepth = 16 ifTrue:
  		["Max RGB components of each pixel separately"
  		^ (self partitionedMax: sourceWord with: destinationWord
  						nBits: 5 nPartitions: 3)
  		+ ((self partitionedMax: sourceWord>>16 with: destinationWord>>16
  						nBits: 5 nPartitions: 3) << 16)]
  	ifFalse:
+ 		["Max RGBA components of the pixel separately"
- 		["Max RGB components of the pixel separately"
  		^ self partitionedMax: sourceWord with: destinationWord
+ 						nBits: 8 nPartitions: 4]!
- 						nBits: 8 nPartitions: 3]!

Item was changed:
  ----- Method: CogVMSimulator>>symbolicMethod: (in category 'debug printing') -----
  symbolicMethod: aMethod
  	| pc end latestContinuation |
+ 	pc := latestContinuation := self startPCOfMethod: aMethod.
+ 	end := self byteSizeOf: aMethod.
- 	pc := self startPCOfMethod: aMethod.
- 	end := latestContinuation := self byteSizeOf: aMethod.
  	[pc <= end] whileTrue:
  		[| byte byte2 byte3 byte4 type offset jumpTarget |
  		 byte := self fetchByte: pc ofObject: aMethod.
  		 type := byte // 16.
  		 offset := byte \\ 16.  
  		 (type =7 and: [offset >= 8 and: [pc >= latestContinuation]]) ifTrue:"Return bytecodes (possible lastPC here)"
  			[end := pc].
  		 (type = 8 and: [offset = 15]) ifTrue: "closure creation; update latest continuation"
  			[byte3 := self fetchByte: pc + 2 ofObject: aMethod.
  			 byte4 := self fetchByte: pc + 3 ofObject: aMethod.
  			 jumpTarget := (byte3 * 256) + byte4 + pc + 4.
  			 jumpTarget > latestContinuation ifTrue: [latestContinuation := jumpTarget]].
  		 type=9 ifTrue: "Short jumps (need to update latest continuation"
  			[jumpTarget := (offset < 8 ifTrue: [offset] ifFalse: [offset - 8]) + pc + 2.
  			jumpTarget > latestContinuation ifTrue: [latestContinuation := jumpTarget]].
  		 type=10 ifTrue: "Long jumps (need to update latest continuation)"
  			[byte2 := self fetchByte: pc + 1 ofObject: aMethod.
  			 jumpTarget := (offset < 8 ifTrue: [offset - 4] ifFalse: [offset bitAnd: 3]) * 256 + byte2 + pc + 2.
  			 jumpTarget > latestContinuation ifTrue: [latestContinuation := jumpTarget]].
  
  		 transcript print: pc + 1 ; space.
  		 byte printOn: transcript base: 16 length: 2 padded: false.
  		 transcript space; nextPutAll: (self symbolic: byte at: pc inMethod: aMethod); cr; flush.
  		 pc := type = 8 "extensions"
  					ifTrue: [pc + (#(2 2 2 2 3 2 2 1 1 1 2 1 3 3 3 4) at: byte \\ 16 + 1)]
  					ifFalse: [type = 10 "long jumps"
  								ifTrue: [pc + 2]
  								ifFalse: [pc + 1]]]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>run (in category 'testing') -----
  run
  	"Just run"
+ 	quitBlock := [([transcript dependents anyOne outermostMorphThat: [:m| m isSystemWindow]]
+ 					on: Error
+ 					do: [:ex| nil])
+ 						ifNotNil: [:window| (UIManager default confirm: 'close?') ifTrue: [window delete]].
+ 				  ^self].
- 	quitBlock := [^self].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 atEachStepBlock value. "N.B. may be nil"
  		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount].
  	localIP := localIP - 1.
  	"undo the pre-increment of IP before returning"
  	self externalizeIPandSP!

Item was changed:
  ----- Method: BitBltSimulation>>rgbMinInvert:with: (in category 'combination rules') -----
  rgbMinInvert: wordToInvert with: destinationWord
  	| sourceWord |
  	<inline: false>
  	sourceWord := wordToInvert bitInvert32.
  	destDepth < 16 ifTrue:
  		["Min each pixel separately"
  		^ self partitionedMin: sourceWord with: destinationWord
  						nBits: destDepth nPartitions: destPPW].
  	destDepth = 16 ifTrue:
  		["Min RGB components of each pixel separately"
  		^ (self partitionedMin: sourceWord with: destinationWord
  						nBits: 5 nPartitions: 3)
  		+ ((self partitionedMin: sourceWord>>16 with: destinationWord>>16
  						nBits: 5 nPartitions: 3) << 16)]
  	ifFalse:
+ 		["Min RGBA components of the pixel separately"
- 		["Min RGB components of the pixel separately"
  		^ self partitionedMin: sourceWord with: destinationWord
+ 						nBits: 8 nPartitions: 4]!
- 						nBits: 8 nPartitions: 3]!

Item was added:
+ ----- Method: CogMethodSurrogate>>isZero (in category 'comparing') -----
+ isZero
+ 	^address = 0!

Item was changed:
  ----- Method: BitBltSimulation>>rgbMin:with: (in category 'combination rules') -----
  rgbMin: sourceWord with: destinationWord
  	<inline: false>
  	destDepth < 16 ifTrue:
  		["Min each pixel separately"
  		^ self partitionedMin: sourceWord with: destinationWord
  						nBits: destDepth nPartitions: destPPW].
  	destDepth = 16 ifTrue:
  		["Min RGB components of each pixel separately"
  		^ (self partitionedMin: sourceWord with: destinationWord
  						nBits: 5 nPartitions: 3)
  		+ ((self partitionedMin: sourceWord>>16 with: destinationWord>>16
  						nBits: 5 nPartitions: 3) << 16)]
  	ifFalse:
+ 		["Min RGBA components of the pixel separately"
- 		["Min RGB components of the pixel separately"
  		^ self partitionedMin: sourceWord with: destinationWord
+ 						nBits: 8 nPartitions: 4]!
- 						nBits: 8 nPartitions: 3]!

Item was changed:
  ----- Method: CogVMSimulator>>run (in category 'testing') -----
  run
  	"Just run"
+ 	quitBlock := [([transcript dependents anyOne outermostMorphThat: [:m| m isSystemWindow]]
+ 					on: Error
+ 					do: [:ex| nil])
+ 						ifNotNil: [:window| (UIManager default confirm: 'close?') ifTrue: [window delete]].
+ 				  ^self].
- 	quitBlock := [^self].
  	self initStackPages.
  	self loadInitialContext.
  	self initialEnterSmalltalkExecutive!

Item was changed:
  ----- Method: BitBltSimulation>>partitionedAdd:to:nBits:nPartitions: (in category 'combination rules') -----
  partitionedAdd: word1 to: word2 nBits: nBits nPartitions: nParts
  	"Add word1 to word2 as nParts partitions of nBits each.
  	This is useful for packed pixels, or packed colors"
+ 	| mask sum result maskedWord1 |
+ 	"In C, most arithmetic operations answer the same bit pattern regardless of the operands being signed or unsigned ints
+ 	(this is due to the way 2's complement numbers work). However, comparisions might fail. Add the proper declaration of
+ 	words as unsigned int in those cases where comparisions are done (jmv)"
+ 	<var: #word1 type: 'unsigned int'>
+ 	<var: #word2 type: 'unsigned int'>
+ 	<var: #mask type: 'unsigned int'>
+ 	<var: #sum type: 'unsigned int'>
+ 	<var: #result type: 'unsigned int'>
+ 	<var: #maskedWord1 type: 'unsigned int'>
- 	| mask sum result |
  	mask := maskTable at: nBits.  "partition mask starts at the right"
  	result := 0.
  	1 to: nParts do:
  		[:i |
+ 		maskedWord1 := word1 bitAnd: mask.
+ 		sum := maskedWord1 + (word2 bitAnd: mask).
+ 		(sum <= mask "result must not carry out of partition"
+ 				and: [ sum >= maskedWord1 ])	"This is needed because in C, integer arithmetic overflows silently!! (jmv)"
- 		sum := (word1 bitAnd: mask) + (word2 bitAnd: mask).
- 		sum <= mask  "result must not carry out of partition"
  			ifTrue: [result := result bitOr: sum]
  			ifFalse: [result := result bitOr: mask].
  		mask := mask << nBits  "slide left to next partition"].
  	^ result
  !

Item was changed:
  ----- Method: BitBltSimulation>>partitionedSub:from:nBits:nPartitions: (in category 'combination rules') -----
  partitionedSub: word1 from: word2 nBits: nBits nPartitions: nParts
  	"Subtract word1 from word2 as nParts partitions of nBits each.
  	This is useful for packed pixels, or packed colors"
  	| mask result p1 p2 |
+ 	"In C, most arithmetic operations answer the same bit pattern regardless of the operands being signed or unsigned ints
+ 	(this is due to the way 2's complement numbers work). However, comparisions might fail. Add the proper declaration of
+ 	words as unsigned int in those cases where comparisions are done (jmv)"
+ 	<var: #word1 type: 'unsigned int'>
+ 	<var: #word2 type: 'unsigned int'>
+ 	<var: #p1 type: 'unsigned int'>
+ 	<var: #p2 type: 'unsigned int'>
+ 	<var: #mask type: 'unsigned int'>
+ 	<var: #result type: 'unsigned int'>
  	mask := maskTable at: nBits.  "partition mask starts at the right"
  	result := 0.
  	1 to: nParts do:
  		[:i |
  		p1 := word1 bitAnd: mask.
  		p2 := word2 bitAnd: mask.
  		p1 < p2  "result is really abs value of thedifference"
  			ifTrue: [result := result bitOr: p2 - p1]
  			ifFalse: [result := result bitOr: p1 - p2].
  		mask := mask << nBits  "slide left to next partition"].
  	^ result
  !



More information about the Vm-dev mailing list