VM Maker: VMMaker.oscog-eem.2445.mcz - Vm-dev

29 Sep 2018


      Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2445.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2445
Author: eem
Time: 28 September 2018, 5:34:39.268193 pm
UUID: ecf80f10-9e24-4ff5-8a41-d65cb2690c94
Ancestors: VMMaker.oscog-eem.2444
Fix degenerate calculations of preload and skew (i.e. a preload that sets notSkewMask to all ones and skewMask to zero, and there-by fix accessing the word beyond the end of a bitmap.  If using external forms such access can crash the VM by trying to access a word that is not in memory (e.g. in an unmapped page).  N.B. when preload is true, notSkewMask is all ones and skewMask is zero this extra word is read but discarded.
Clean up primitiveCopyBits & primitiveWarpBits to use the more modern (and simpler) methodReturnReceiver style.
Recategorise some C library extensions as such.
=============== Diff against VMMaker.oscog-eem.2444 ===============
Item was changed:
  ----- Method: BitBltSimulation>>copyLoop (in category 'inner loop') -----
  copyLoop
    | prevWord thisWord skewWord halftoneWord mergeWord hInc y unskew skewMask notSkewMask mergeFnwith destWord |
    "This version of the inner loop assumes noSource = false."
    <inline: false>
    <var: #prevWord type: #'unsigned int'>
    <var: #thisWord type: #'unsigned int'>
    <var: #skewWord type: #'unsigned int'>
    <var: #halftoneWord type: #'unsigned int'>
    <var: #mergeWord type: #'unsigned int'>
    <var: #destWord type: #'unsigned int'>
    <var: #skewMask type: #'unsigned int'>
    <var: #notSkewMask type: #'unsigned int'>
    <var: #unskew type: #int> "unskew is a bitShift and MUST remain signed, while skewMask is unsigned."
    <var: #mergeFnwith declareC: 'unsigned int (*mergeFnwith)(unsigned int, unsigned int)'>
    mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to: 'unsigned int (*)(unsigned int, unsigned int)'.
    mergeFnwith.  "null ref for compiler"
hInc := hDir * 4.  "Byte delta"
+ 	"degenerate skew fixed in sourceSkewAndPointerInit, eem 9/28/2018"
+ 	self assert: (skew > -32 and: [skew < 32]).
+ 	skew < 0
+ 		ifTrue:
+ 			[unskew := skew + 32.
+ 			skewMask := AllOnes << (0 - skew)]
- 	"degenerate skew fixed for Sparc. 10/20/96 ikp"
- 	skew = -32
- 		ifTrue: [skew := unskew := skewMask := 0]
    	ifFalse:
+ 			[skew = 0
- 			[skew < 0
    			ifTrue:
+ 					[unskew := 0.
+ 					skewMask := AllOnes]
- 					[unskew := skew+32.
- 					skewMask := AllOnes << (0-skew)]
    			ifFalse:
+ 					[unskew := skew - 32.
+ 					skewMask := AllOnes >> skew]].
- 					[skew = 0
- 						ifTrue:
- 							[unskew := 0.
- 							skewMask := AllOnes]
- 						ifFalse:
- 							[unskew := skew-32.
- 							skewMask := AllOnes >> skew]]].
    notSkewMask := skewMask bitInvert32.
    noHalftone
    	ifTrue: [halftoneWord := AllOnes.  halftoneHeight := 0]
    	ifFalse: [halftoneWord := self halftoneAt: 0].
y := dy.
    "Here is the vertical loop, in two versions, one for the combinationRule = 3 copy mode, one for the general case."
    combinationRule = 3
    	ifTrue:
    		[1 to: bbH do: "here is the vertical loop for combinationRule = 3 copy mode; no need to call merge"
    			[ :i |
    			halftoneHeight > 1 ifTrue:  "Otherwise, its always the same"
    				[halftoneWord := self halftoneAt: y.
    				y := y + vDir].
    			preload
    				ifTrue: "load the 64-bit shifter"
    					[prevWord := self srcLongAt: sourceIndex.
    					self incSrcIndex: hInc]
    				ifFalse:
    					[prevWord := 0].
"Note: the horizontal loop has been expanded into three parts for speed:"
"This first section requires masking of the destination store..."
    			destMask := mask1.
    			thisWord := self srcLongAt: sourceIndex.  "pick up next word"
    			self incSrcIndex: hInc.
    			skewWord := ((prevWord bitAnd: notSkewMask) bitShift: unskew)
    							bitOr:  "32-bit rotate"
    								((thisWord bitAnd: skewMask) bitShift: skew).
    			prevWord := thisWord.
    			destWord := self dstLongAt: destIndex.
    			destWord := (destMask bitAnd: (skewWord bitAnd: halftoneWord))
    							bitOr: (destWord bitAnd: destMask bitInvert32).
    			self dstLongAt: destIndex put: destWord.
    			self incDestIndex: hInc.
"This central horizontal loop requires no store masking"
    			destMask := AllOnes.
    			(skew = 0 and: [halftoneWord = AllOnes])
    				ifTrue: "Very special inner loop for STORE mode with no skew -- just move words"
    					[hDir = -1
    						ifTrue: "Woeful patch: revert to older code for hDir = -1"
    							[2 to: nWords-1 do: 
    								[ :word |
    								thisWord := self srcLongAt: sourceIndex.
    								self incSrcIndex: hInc.
    								self dstLongAt: destIndex put: thisWord.
    								self incDestIndex: hInc]]
    						ifFalse:
    							[2 to: nWords-1 do: 
    								[ :word |  "Note loop starts with prevWord loaded (due to preload)"
    								self dstLongAt: destIndex put: prevWord.
    								self incDestIndex: hInc.
    								prevWord := self srcLongAt: sourceIndex.
    								self incSrcIndex: hInc]]]
    					ifFalse:
    						[2 to: nWords-1 do: 
    							[ :word |
    							thisWord := self srcLongAt: sourceIndex.
    							self incSrcIndex: hInc.
    							skewWord := ((prevWord bitAnd: notSkewMask) bitShift: unskew)
    											bitOr:  "32-bit rotate"
    										((thisWord bitAnd: skewMask) bitShift: skew).
    							prevWord := thisWord.
    							self dstLongAt: destIndex put: (skewWord bitAnd: halftoneWord).
    							self incDestIndex: hInc]].
"This last section, if used, requires masking of the destination store..."
    			nWords > 1 ifTrue:
    				[destMask := mask2.
    				thisWord := self srcLongAt: sourceIndex.  "pick up next word"
    				self incSrcIndex: hInc.
    				skewWord := ((prevWord bitAnd: notSkewMask) bitShift: unskew)
    								bitOr:  "32-bit rotate"
    									((thisWord bitAnd: skewMask) bitShift: skew).
    				destWord := self dstLongAt: destIndex.
    				destWord := (destMask bitAnd: (skewWord bitAnd: halftoneWord))
    								bitOr: (destWord bitAnd: destMask bitInvert32).
    				self dstLongAt: destIndex put: destWord.
    				self incDestIndex: hInc].
self incSrcIndex: sourceDelta.
    			self incDestIndex: destDelta]]
    	ifFalse:
    		[1 to: bbH do: "here is the vertical loop for the general case (combinationRule ~= 3)"
    			[ :i |
    			halftoneHeight > 1 ifTrue:  "Otherwise, its always the same"
    				[halftoneWord := self halftoneAt: y.
    				y := y + vDir].
    			preload
    				ifTrue: "load the 64-bit shifter"
    					[prevWord := self srcLongAt: sourceIndex.
    					self incSrcIndex: hInc]
    				ifFalse:
    					[prevWord := 0].
"Note: the horizontal loop has been expanded into three parts for speed:"
"This first section requires masking of the destination store..."
    			destMask := mask1.
    			thisWord := self srcLongAt: sourceIndex.  "pick up next word"
    			self incSrcIndex: hInc.
    			skewWord := ((prevWord bitAnd: notSkewMask) bitShift: unskew)
    							bitOr:  "32-bit rotate"
    						((thisWord bitAnd: skewMask) bitShift: skew).
    			prevWord := thisWord.
    			destWord := self dstLongAt: destIndex.
    			mergeWord := self mergeFn: (skewWord bitAnd: halftoneWord) with: destWord.
    			destWord := (destMask bitAnd: mergeWord)
    							bitOr: (destWord bitAnd: destMask bitInvert32).
    			self dstLongAt: destIndex put: destWord.
    			self incDestIndex: hInc.
"This central horizontal loop requires no store masking"
    			destMask := AllOnes.
    			2 to: nWords-1 do: "Normal inner loop does merge:"
    				[ :word |
    				thisWord := self srcLongAt: sourceIndex.  "pick up next word"
    				self incSrcIndex: hInc.
    				skewWord := ((prevWord bitAnd: notSkewMask) bitShift: unskew)
    								bitOr:  "32-bit rotate"
    							((thisWord bitAnd: skewMask) bitShift: skew).
    				prevWord := thisWord.
    				mergeWord := self mergeFn: (skewWord bitAnd: halftoneWord)
    								with: (self dstLongAt: destIndex).
    				self dstLongAt: destIndex put: mergeWord.
    				self incDestIndex: hInc].
"This last section, if used, requires masking of the destination store..."
    			nWords > 1 ifTrue:
    				[destMask := mask2.
    				thisWord := self srcLongAt: sourceIndex.  "pick up next word"
    				self incSrcIndex: hInc.
    				skewWord := ((prevWord bitAnd: notSkewMask) bitShift: unskew)
    								bitOr:  "32-bit rotate"
    							((thisWord bitAnd: skewMask) bitShift: skew).
    				destWord := self dstLongAt: destIndex.
    				mergeWord := self mergeFn: (skewWord bitAnd: halftoneWord) with: destWord.
    				destWord := (destMask bitAnd: mergeWord)
    								bitOr: (destWord bitAnd: destMask bitInvert32).
    				self dstLongAt: destIndex put: destWord.
    				self incDestIndex: hInc].
self incSrcIndex: sourceDelta.
    			self incDestIndex: destDelta]]!
Item was changed:
  ----- Method: BitBltSimulation>>primitiveCopyBits (in category 'primitives') -----
  primitiveCopyBits
    "Invoke the copyBits primitive. If the destination is the display, then copy it to the screen."
    | rcvr |
    <export: true>
    rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount.
+ 	(self loadBitBltFrom: rcvr) ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	(self loadBitBltFrom: rcvr)  ifFalse:[^interpreterProxy primitiveFail].
    self copyBits.
+ 	interpreterProxy failed ifTrue: [^nil].
- 	interpreterProxy failed ifTrue:[^nil].
    self showDisplayBits.
+ 	interpreterProxy failed ifTrue: [^nil].
+ 	(combinationRule = 22 or: [combinationRule = 32])
+ 		ifTrue: [interpreterProxy methodReturnInteger: bitCount]
+ 		ifFalse: [interpreterProxy methodReturnReceiver]!
- 	interpreterProxy failed ifTrue:[^nil].
- 	interpreterProxy pop: interpreterProxy methodArgumentCount.
- 	(combinationRule = 22) | (combinationRule = 32) ifTrue:[
- 		interpreterProxy pop: 1.
- 		^ interpreterProxy pushInteger: bitCount].!
Item was changed:
  ----- Method: BitBltSimulation>>primitiveWarpBits (in category 'primitives') -----
  primitiveWarpBits
    "Invoke the warpBits primitive. If the destination is the display, then copy it to the screen."
    | rcvr |
    <export: true>
    rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount.
    (self loadWarpBltFrom: rcvr) 
    	ifFalse:[^interpreterProxy primitiveFail].
    self warpBits.
    interpreterProxy failed ifTrue:[^nil].
    self showDisplayBits.
    interpreterProxy failed ifTrue:[^nil].
+ 	interpreterProxy methodReturnReceiver!
- 	interpreterProxy pop: interpreterProxy methodArgumentCount.!
Item was changed:
  ----- Method: BitBltSimulation>>sourceSkewAndPointerInit (in category 'setup') -----
  sourceSkewAndPointerInit
    "This is only used when source and dest are same depth,
    ie, when the barrel-shift copy loop is used."
    | dWid sxLowBits dxLowBits pixPerM1 |
    <inline: true>
    pixPerM1 := destPPW - 1.  "A mask, assuming power of two"
    sxLowBits := sx bitAnd: pixPerM1.
    dxLowBits := dx bitAnd: pixPerM1.
    "check if need to preload buffer
    (i.e., two words of source needed for first word of destination)"
    hDir > 0 ifTrue:
    	["n Bits stored in 1st word of dest"
    	dWid := bbW min: destPPW - dxLowBits.
    	preload := (sxLowBits + dWid) > pixPerM1]
    ifFalse:
    	[dWid := bbW min: dxLowBits + 1.
    	preload := (sxLowBits - dWid + 1) < 0].
"calculate right-shift skew from source to dest"
+ 	skew := (sourceMSB
+ 				ifTrue: [sxLowBits - dxLowBits] 
+ 				ifFalse: [dxLowBits - sxLowBits]) * destDepth.  " -32..32 "
- 	sourceMSB
- 		ifTrue:[skew := (sxLowBits - dxLowBits) * destDepth] 
- 		ifFalse:[skew := (dxLowBits - sxLowBits) * destDepth].  " -32..32 "
    preload ifTrue: 
+ 		[skew ~= 0 ifTrue:
+ 			[skew := skew < 0 ifTrue: [skew + 32] ifFalse: [skew - 32]].
+ 		 skew = 0 ifTrue:
+ 			[preload := false]].
- 		[skew < 0
- 			ifTrue: [skew := skew+32]
- 			ifFalse: [skew := skew-32]].
"Calc byte addr and delta from longWord info"
+ 	sourceIndex := sourceBits + (sy * sourcePitch) + ((sx // (32 // sourceDepth)) * 4).
- 	sourceIndex := sourceBits + (sy * sourcePitch) + ((sx // (32//sourceDepth)) *4).
    "calculate increments from end of 1 line to start of next"
    sourceDelta := (sourcePitch * vDir) - (4 * (nWords * hDir)).
preload ifTrue:
    	["Compensate for extra source word fetched"
+ 		sourceDelta := sourceDelta - (4*hDir)]!
- 		sourceDelta := sourceDelta - (4*hDir)].!
Item was changed:
+ ----- Method: VMClass>>asString: (in category 'C library extensions') -----
- ----- Method: VMClass>>asString: (in category 'C library simulation') -----
  asString: aStringOrStringIndex
    "aStringOrStringIndex is either a string or an address in the heap.
     Create a String of the requested length form the bytes in the
     heap starting at stringIndex."
    <doNotGenerate>
    | sz |
    aStringOrStringIndex isString ifTrue:
    	[^aStringOrStringIndex].
    sz := self strlen: aStringOrStringIndex.
    ^self strncpy: (ByteString new: sz) _: aStringOrStringIndex _: sz!
Item was changed:
+ ----- Method: VMClass>>asString:size: (in category 'C library extensions') -----
- ----- Method: VMClass>>asString:size: (in category 'C library simulation') -----
  asString: stringIndex size: stringSize
    "stringIndex is an address in the heap.  Create a String of the requested length
    form the bytes in the heap starting at stringIndex."
    <doNotGenerate>
    ^self strncpy: (ByteString new: stringSize) _: stringIndex _: stringSize!