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

[commits at source.squeak.org]

ClementBera uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-cb.1935.mcz

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

Name: VMMaker.oscog-cb.1935
Author: cb
Time: 5 September 2016, 2:20:00.894774 pm
UUID: 9bf8b308-8e98-44bf-a054-abcd22177339
Ancestors: VMMaker.oscog-cb.1934

Fixes related to Immutability / read-only objects:
- weak structures can't be mmutable
- primitiveStringReplace fails if the receier is immutable only if it attempts to mutate something.

=============== Diff against VMMaker.oscog-cb.1934 ===============

Item was changed:
  ----- Method: InterpreterPrimitives>>canBeImmutable: (in category 'object access primitives') -----
  canBeImmutable: oop
  	<option: #IMMUTABILITY>
  	| scheduler processLists |
  	
  	self assert: (objectMemory isNonImmediate: oop).
  	
  	"For now we fail the primitive for contexts to we ensure there are no immutable contexts.
  	Later we can consider having immutable contexts and send cannotReturn callback
  	when returning to an immutable context. That would mean that setting a context 
  	to immutable would require a divorce and returns to immutable context are 
  	necessarily across stack pages"
  	(objectMemory isContext: oop) ifTrue: [ ^ false ].
  	
+ 	"Weak structures can't be immutable"
+ 	(objectMemory isEphemeron: oop) ifTrue: [^ false].
+ 	(objectMemory isWeakNonImm: oop) ifTrue: [^ false].
+ 	
+ 	"No clue what is going on for semaphores so they can't be immutable"
- 	"I don't get it for semaphores so they can't be immutable"
  	(objectMemory isSemaphoreObj: oop) ifTrue: [^ false].
  	
+ 	"Simple version of process management: we forbid Process and LinkedList instances to be immutable 
+ 	 as well as the Processor and the array of activeProcess"
- 	"simple version of process management: we forbid Process and LinkedList instances to be immutable 
- 	as well as the Processor and the array of activeProcess"
  	scheduler := self fetchPointer: ValueIndex ofObject: (self splObj: SchedulerAssociation).
  	processLists := objectMemory fetchPointer: ProcessListsIndex ofObject: scheduler.
  	oop = scheduler ifTrue: [ ^ false ].
  	oop = processLists ifTrue: [ ^ false ].
  	"Is it a linkedList ?"
  	(objectMemory classIndexOf: (objectMemory fetchPointer: 1 ofObject: processLists)) = (objectMemory classIndexOf: oop) ifTrue: [ ^ false ].
  	"is it a Process ?"
  	(objectMemory classIndexOf: (objectMemory fetchPointer: ActiveProcessIndex ofObject: scheduler)) =  (objectMemory classIndexOf: oop) ifTrue: [ ^ false ].
  	
  	"The rest of the code is relative to process management: the Processor (the active 
  	process scheduler) can't be immutable, as well as all the objects relative to Process management "
  	"scheduler := self fetchPointer: ValueIndex ofObject: (self splObj: SchedulerAssociation).
  	processLists := objectMemory fetchPointer: ProcessListsIndex ofObject: scheduler.
  	((objectMemory formatOf: oop) = objectMemory nonIndexablePointerFormat)
  		ifFalse: 
  			[ (objectMemory isArrayNonImm: oop) ifFalse: [ ^ true ].
  			  ^ (oop = processLists) not ].
  	(objectMemory numSlotsOf: oop) >= 2 ifFalse: [ ^ true ].
  	""is the oop the scheduler itself ?""
  	oop = scheduler ifTrue: [ ^ false ].
  	1 to: (objectMemory numSlotsOf: processLists) do: [ :i |
  		""is the oop one of the linked lists ?""
  		(list := processLists at: i) = oop ifTrue: [^ false].
  		""is the oop one of the runnable process ?""
  		first := objectMemory fetchPointer: FirstLinkIndex ofObject: list.
  		first = objectMemory nilObject ifFalse: 
  			[ last := objectMemory fetchPointer: LastLinkIndex ofObject: list.
  			  link := first.
  			  [ link = last ] whileFalse: 
  				[ link = oop ifTrue: [ ^ false ]. 
  				  link := objectMemory fetchPointer: NextLinkIndex ofObject: link. ] ] ]."
  	^ true!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveStringReplace (in category 'indexing primitives') -----
  primitiveStringReplace
  	" 
  	<array> primReplaceFrom: start to: stop with: replacement 
  	startingAt: repStart  
  	<primitive: 105>
  	"
  	| array start stop repl replStart hdr arrayFmt totalLength arrayInstSize replFmt replInstSize srcIndex |
  	array := self stackValue: 4.
  	start := self stackIntegerValue: 3.
  	stop := self stackIntegerValue: 2.
  	repl := self stackValue: 1.
  	replStart := self stackIntegerValue: 0.
  
  	self successful ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument]. 
- 		[^self primitiveFailFor: PrimErrBadArgument].
  	(objectMemory isImmediate: repl) ifTrue: "can happen in LgInt copy"
  		[^self primitiveFailFor: PrimErrBadArgument].
+ 	(stop >= start and: [objectMemory isObjImmutable: array]) ifTrue:
- 	(objectMemory isObjImmutable: array) ifTrue:
  		[^self primitiveFailFor: PrimErrNoModification].
  
  	hdr := objectMemory baseHeader: array.
  	arrayFmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: array baseHeader: hdr format: arrayFmt.
  	arrayInstSize := objectMemory fixedFieldsOf: array format: arrayFmt length: totalLength.
  	(start >= 1 and: [start - 1 <= stop and: [stop + arrayInstSize <= totalLength]]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
  
  	hdr := objectMemory baseHeader: repl.
  	replFmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: repl baseHeader: hdr format: replFmt.
  	replInstSize := objectMemory fixedFieldsOf: repl format: replFmt length: totalLength.
  	(replStart >= 1 and: [stop - start + replStart + replInstSize <= totalLength]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
  
  	"Still to do: rewrite the below to accomodate short & long access"
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [(arrayFmt between: objectMemory firstShortFormat and: objectMemory firstLongFormat - 1)
  		or: [arrayFmt = objectMemory sixtyFourBitIndexableFormat]]) ifTrue:
  		[^self primitiveFailFor: PrimErrUnsupported].
  
  	"Array formats (without byteSize bits, if bytes array) must be the same"
  	arrayFmt < objectMemory firstByteFormat
  		ifTrue: [arrayFmt = replFmt ifFalse:
  					[^self primitiveFailFor: PrimErrInappropriate]]
  		ifFalse: [(arrayFmt bitAnd: objectMemory byteFormatMask) = (replFmt bitAnd: objectMemory byteFormatMask) ifFalse:
  					[^self primitiveFailFor: PrimErrInappropriate]].
  
  	srcIndex := replStart + replInstSize - 1.
  	"- 1 for 0-based access"
  
  	arrayFmt <= objectMemory lastPointerFormat
  		ifTrue:
  			[start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do:
  				[:i |
  				objectMemory storePointer: i ofObject: array withValue: (objectMemory fetchPointer: srcIndex ofObject: repl).
  				srcIndex := srcIndex + 1]]
  		ifFalse:
  			[arrayFmt < objectMemory firstByteFormat
  				ifTrue: "32-bit-word type objects"
  					[start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do:
  						[:i |
  						objectMemory storeLong32: i ofObject: array withValue: (objectMemory fetchLong32: srcIndex ofObject: repl).
  						srcIndex := srcIndex + 1]]
  				ifFalse: "byte-type objects"
  					[start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do:
  						[:i |
  						objectMemory storeByte: i ofObject: array withValue: (objectMemory fetchByte: srcIndex ofObject: repl).
  						srcIndex := srcIndex + 1]]].
  	"We might consider comparing stop - start to some value here and using forceInterruptCheck"
  
  	self pop: argumentCount "leave rcvr on stack"!