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

commits at source.squeak.org commits at source.squeak.org
Wed Dec 12 00:43:03 UTC 2012


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.231.mcz

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

Name: VMMaker.oscog-eem.231
Author: eem
Time: 11 December 2012, 4:41:13.926 pm
UUID: 3222a519-8cd5-4e1a-9689-6534df290217
Ancestors: VMMaker.oscog-eem.230

Rename misnamed internameIsMutable: and internalIsImmutable:
to isOopMutable: and isOopImmutable:.  Affects sqVirtualMachine.c,
but only part of api used in Newspeak VMs.

=============== Diff against VMMaker.oscog-eem.230 ===============

Item was added:
+ ----- Method: InterpreterProxy>>isOopImmutable: (in category 'testing') -----
+ isOopImmutable: anOop
+ 	<api>
+ 	^self error: 'not yet implemented in Smalltalk'!

Item was added:
+ ----- Method: InterpreterProxy>>isOopMutable: (in category 'testing') -----
+ isOopMutable: anOop
+ 	<api>
+ 	^self error: 'not yet implemented in Smalltalk'!

Item was removed:
- ----- Method: NewCoObjectMemorySimulator>>internalIsImmutable: (in category 'simulation only') -----
- internalIsImmutable: oop
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter internalIsImmutable: oop!

Item was changed:
  ----- Method: NewspeakInterpreter>>bytecodePrimAtPut (in category 'common selector sends') -----
  bytecodePrimAtPut
  	"BytecodePrimAtPut will only succeed if the receiver is in the atCache.
  	Otherwise it will fail so that the more general primitiveAtPut will put it in the
  	cache after validating that message lookup results in a primitive response."
  	| index rcvr atIx value |
  	value := self internalStackTop.
  	index := self internalStackValue: 1.
  	rcvr := self internalStackValue: 2.
  	self success: ((self isIntegerObject: rcvr) not
  					and: [(self isIntegerObject: index)
+ 					and: [self isObjMutable: rcvr]]).
- 					and: [self internalIsMutable: rcvr]]).
  	self successful ifTrue:
  		[atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase.  "Index into atPutCache"
  		 (atCache at: atIx+AtCacheOop) = rcvr ifTrue:
  			[self commonVariable: rcvr
  				at: (self integerValueOf: index)
  				put: value
  				cacheIndex: atIx.
  			 self successful ifTrue:
  				[self fetchNextBytecode.
  				 ^self internalPop: 3 thenPush: value]]].
  
  	messageSelector := self specialSelector: 17.
  	argumentCount := 2.
  	self normalSend!

Item was changed:
  ----- Method: NewspeakInterpreter>>commonAtPut: (in category 'indexing primitive support') -----
  commonAtPut: stringy
  	"This code is called if the receiver responds primitively to at:Put:.
  	If this is so, it will be installed in the atPutCache so that subsequent calls of at:
  	or  next may be handled immediately in bytecode primitive routines."
  	| value index rcvr atIx |
  	self initPrimCall.
  	rcvr := self stackObjectValue: 2.
  	self successful ifFalse:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	index := self positive32BitValueOf: (self stackValue: 1).
  	self successful ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
+ 	(self isOopImmutable: rcvr) ifTrue:
- 	(self internalIsMutable: rcvr) ifFalse:
  		[^self primitiveFailFor: PrimErrNoModification].
  	value := self stackTop.
  
  	"NOTE:  The atPut-cache, since it is specific to the non-super response to #at:Put:.
  	Therefore we must determine that the message is #at:Put: (not, eg, #basicAt:Put:),
  	and that the send is not a super-send, before using the at-cache."
  	(messageSelector = (self specialSelector: 17)
  	  and: [lkupClass = (self fetchClassOfNonInt: rcvr)])
  		ifTrue:
  		["OK -- look in the at-cache"
  		atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase.  "Index into atPutCache"
  		(atCache at: atIx+AtCacheOop) = rcvr ifFalse:
  			["Rcvr not in cache.  Install it..."
  			self install: rcvr inAtCache: atCache at: atIx string: stringy].
  		self successful ifTrue:
  			[self commonVariable: rcvr at: index put: value cacheIndex: atIx].
  		self successful ifTrue:
  			[^ self pop: argumentCount+1 thenPush: value]].
  
  	"The slow but sure way..."
  	self initPrimCall.
  	stringy ifTrue: [self stObject: rcvr at: index put: (self asciiOfCharacter: value)]
  			ifFalse: [self stObject: rcvr at: index put: value].
  	self successful ifTrue: [^ self pop: argumentCount+1 thenPush: value].
  !

Item was changed:
  ----- Method: NewspeakInterpreter>>doubleExtendedDoAnythingBytecode (in category 'send bytecodes') -----
  doubleExtendedDoAnythingBytecode
  	"Replaces the Blue Book double-extended send [132], in which the first byte was wasted on 8 bits of argument count. 
  	Here we use 3 bits for the operation sub-type (opType),  and the remaining 5 bits for argument count where needed. 
  	The last byte give access to 256 instVars or literals. 
  	See also secondExtendedSendBytecode"
  	| byte2 byte3 opType top |
  	byte2 := self fetchByte.
  	byte3 := self fetchByte.
  	opType := byte2 >> 5.
  	opType = 0 ifTrue:
  		[messageSelector := self literal: byte3.
  		 argumentCount := byte2 bitAnd: 31.
  		 ^ self normalSend].
  	opType = 1 ifTrue:
  		[messageSelector := self literal: byte3.
  		 argumentCount := byte2 bitAnd: 31.
  		 ^ self superclassSend].
  	self fetchNextBytecode.
  	opType = 2 ifTrue: [^ self pushReceiverVariable: byte3].
  	opType = 3 ifTrue: [^ self pushLiteralConstant: byte3].
  	opType = 4 ifTrue: [^ self pushLiteralVariable: byte3].
  	opType = 5 ifTrue:
  		[top := self internalStackTop.
+ 		(self isObjImmutable: receiver) ifTrue:
- 		(self internalIsImmutable: receiver) ifTrue:
  			[self undoFetchNextBytecode.
  			 ^self internalCannotAssign: top to: receiver withIndex: byte3].
  		 ^ self storePointer: byte3 ofObject: receiver withValue: top].
  	opType = 6 ifTrue:
  		[top := self internalStackTop.
  		 self internalPop: 1.
+ 		(self isObjImmutable: receiver) ifTrue:
- 		(self internalIsImmutable: receiver) ifTrue:
  			[self undoFetchNextBytecode.
  			 ^self internalCannotAssign: top to: receiver withIndex: byte3].
  		 ^ self storePointer: byte3 ofObject: receiver withValue: top].
  	opType = 7 ifTrue:
  		[top := self internalStackTop.
  		 ^ self storePointer: ValueIndex ofObject: (self literal: byte3) withValue: top]!

Item was changed:
  ----- Method: NewspeakInterpreter>>extendedStoreBytecode (in category 'stack bytecodes') -----
  extendedStoreBytecode
  	| descriptor variableType value variableIndex association isPop |
  	<inline: true>
  	isPop := currentBytecode = 130.  "extendedStoreAndPopBytecode"
  	descriptor := self fetchByte.
  	self fetchNextBytecode.
  	variableType := descriptor >> 6 bitAnd: 3.
  	variableIndex := descriptor bitAnd: 63.
  	variableType = 2 ifTrue:
  		[^self error: 'illegal store'].
  	value := self internalStackTop.
  	variableType = 0 ifTrue:
+ 		[(self isObjImmutable: receiver) ifTrue:
- 		[(self internalIsImmutable: receiver) ifTrue:
  			[isPop ifTrue: [self internalPop: 1].
  			 self undoFetchNextBytecode.
  			 ^self internalCannotAssign: value to: receiver withIndex: variableIndex].
  		^self storePointer: variableIndex ofObject: receiver withValue: value].
  	variableType = 1 ifTrue:
  		[^self storePointerUnchecked: variableIndex + TempFrameStart ofObject: localHomeContext withValue: value].
  	variableType = 3 ifTrue:
  		[association := self literal: variableIndex.
+ 		 (self isObjImmutable: association) ifTrue:
- 		 (self internalIsImmutable: association) ifTrue:
  			[isPop ifTrue: [self internalPop: 1].
  			 self undoFetchNextBytecode.
  			 ^self internalCannotAssign: value to: association withIndex: ValueIndex].
  		^self storePointer: ValueIndex ofObject: association withValue: value]!

Item was removed:
- ----- Method: NewspeakInterpreter>>internalIsImmutable: (in category 'object format') -----
- internalIsImmutable: oop
- 	<inline: true>
- 	<export: true>
- 	^((self baseHeader: oop) bitAnd: ImmutabilityBit) ~= 0!

Item was removed:
- ----- Method: NewspeakInterpreter>>internalIsMutable: (in category 'object format') -----
- internalIsMutable: oop
- 	<inline: true>
- 	<export: true>
- 	^((self baseHeader: oop) bitAnd: ImmutabilityBit) = 0!

Item was changed:
  ----- Method: NewspeakInterpreter>>primitiveByteArrayDoubleAtPut (in category 'array and stream primitive support') -----
  primitiveByteArrayDoubleAtPut
  	"Store a Double at given byte offset in a ByteArray."
  	| byteOffset rcvr addr floatValue floatOop |
  	<export: true>
  	<inline: false>
  	<var: #floatValue type:'double '>
  	floatOop := self stackValue: 0.
  	(self isIntegerObject: floatOop)
  		ifTrue:[floatValue := self cCoerce: (self integerValueOf: floatOop) to:'double']
  		ifFalse:[floatValue := self cCoerce: (self floatValueOf: floatOop) to:'double'].
  	byteOffset := self stackIntegerValue: 1.
  	self failed ifTrue:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	rcvr := self stackObjectValue: 2.
  	self failed ifTrue:[^self primitiveFailFor: PrimErrInappropriate].
  	addr := self addressOf: rcvr startingAt: byteOffset size: 8.
  	self failed ifTrue:[^0].
+ 	(self isOopImmutable: rcvr) ifTrue:
- 	(self internalIsMutable: rcvr) ifFalse:
  		[^self primitiveFailFor: PrimErrNoModification].
  	self cCode:'((int*)addr)[0] = ((int*)(&floatValue))[0]'.
  	self cCode:'((int*)addr)[1] = ((int*)(&floatValue))[1]'.
  	self pop: 3.
  	^self push: floatOop!

Item was changed:
  ----- Method: NewspeakInterpreter>>primitiveByteArrayFloatAtPut (in category 'array and stream primitive support') -----
  primitiveByteArrayFloatAtPut
  	"Store a Float at the given byteOffset in a ByteArray"
  	| byteOffset rcvr addr floatValue floatOop |
  	<export: true>
  	<inline: false>
  	<var: #floatValue type:'float '>
  	floatOop := self stackValue: 0.
  	(self isIntegerObject: floatOop)
  		ifTrue:[floatValue := self cCoerce: (self integerValueOf: floatOop) to:'float']
  		ifFalse:[floatValue := self cCoerce: (self floatValueOf: floatOop) to:'float'].
  	byteOffset := self stackIntegerValue: 1.
  	self failed ifTrue:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	rcvr := self stackObjectValue: 2.
  	self failed ifTrue:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	addr := self addressOf: rcvr startingAt: byteOffset size: 4.
  	self failed ifTrue:[^0].
+ 	(self isOopImmutable: rcvr) ifTrue:
- 	(self internalIsMutable: rcvr) ifFalse:
  		[^self primitiveFailFor: PrimErrNoModification].
  	self cCode:'((int*)addr)[0] = ((int*)(&floatValue))[0]'.
  	self pop: 3.
  	^self push: floatOop!

Item was changed:
  ----- Method: NewspeakInterpreter>>primitiveByteArrayNByteIIntegerAtPut (in category 'array and stream primitive support') -----
  primitiveByteArrayNByteIIntegerAtPut
  	"Store a (signed or unsigned) n byte integer at the given byte offset."
  	| isSigned byteSize byteOffset rcvr addr value max valueOop |
  	<export: true>
  	<inline: false>
  	isSigned := self booleanValueOf: (self stackValue: 0).
  	byteSize := self stackIntegerValue: 1.
  	valueOop := self stackValue: 2.
  	byteOffset := self stackIntegerValue: 3.
  	self failed ifTrue:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	rcvr := self stackObjectValue: 4.
  	self failed ifTrue:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	(byteOffset > 0 and:[byteSize = 1 or:[byteSize = 2 or:[byteSize = 4]]])
  		ifFalse:[^self primitiveFailFor: PrimErrBadArgument].
  	addr := self addressOf: rcvr startingAt: byteOffset size: byteSize.
  	self failed ifTrue:[^0].
  	isSigned 
  		ifTrue:[value := self signed32BitValueOf: valueOop]
  		ifFalse:[value := self positive32BitValueOf: valueOop].
  	self failed ifTrue:[^0].
  	byteSize < 4
  		ifTrue:
  			[isSigned ifTrue:[
  				max := 1 << (8 * byteSize - 1).
  				value >= max ifTrue:[^self primitiveFail].
  				value < (0 - max) ifTrue:[^self primitiveFail].
  			] ifFalse:[
  				value >= (1 << (8*byteSize)) ifTrue:[^self primitiveFail].
  			].
+ 			(self isOopImmutable: rcvr) ifTrue:
- 			(self internalIsMutable: rcvr) ifFalse:
  				[^self primitiveFailFor: PrimErrNoModification]..
  			"short/byte"
  			byteSize = 1 
  				ifTrue:[self byteAt: addr put: value]
  				ifFalse:[	self cCode: '*((short int *) addr) = value' 
  							inSmalltalk: [self shortAt: addr put: value]]]
  		ifFalse:
+ 			[(self isOopImmutable: rcvr) ifTrue:
- 			[(self internalIsMutable: rcvr) ifFalse:
  				[^self primitiveFailFor: PrimErrNoModification].
  			self longAt: addr put: value].
  	self pop: 5.
  	^self push: valueOop.!

Item was changed:
  ----- Method: NewspeakInterpreter>>primitiveIntegerAtPut (in category 'sound primitives') -----
  primitiveIntegerAtPut
  	"Return the 32bit signed integer contents of a words receiver"
  	| index rcvr sz addr value valueOop |
  	valueOop := self stackValue: 0.
  	index := self stackIntegerValue: 1.
  	(self isIntegerObject: valueOop)
  		ifTrue:[value := self integerValueOf: valueOop]
  		ifFalse:[value := self signed32BitValueOf: valueOop].
  	self successful ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	rcvr := self stackValue: 2.
  	((self isIntegerObject: rcvr)
  	or: [(self isWords: rcvr) not]) ifTrue:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	sz := self lengthOf: rcvr.  "number of fields"
  	(index >= 1 and: [index <= sz]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
+ 	(self isOopImmutable: rcvr) ifTrue:
- 	(self internalIsMutable: rcvr) ifFalse:
  		[^self primitiveFailFor: PrimErrNoModification].
  	addr := rcvr + BaseHeaderSize - 4 "for zero indexing" + (index * 4).
  	value := self intAt: addr put: value.
  	self pop: 3 thenPush: valueOop "pop all; return value"
  !

Item was changed:
  ----- Method: NewspeakInterpreter>>primitiveNextPut (in category 'array and stream primitives') -----
  primitiveNextPut
  	"PrimitiveNextPut will succeed only if the stream's array is in the atPutCache.
  	Otherwise failure will lead to proper message lookup of at:put: and
  	subsequent installation in the cache if appropriate."
  	| value stream index limit array atIx |
  	value := self stackTop.
  	stream := self stackValue: 1.
  	((self isPointers: stream)
  		and: [(self lengthOf: stream) >= (StreamReadLimitIndex + 1)])
  		ifFalse: [^ self primitiveFail].
  
  	array := self fetchPointer: StreamArrayIndex ofObject: stream.
  	index := self fetchInteger: StreamIndexIndex ofObject: stream.
  	limit := self fetchInteger: StreamReadLimitIndex ofObject: stream.
  	atIx := (array bitAnd: AtCacheMask) + AtPutBase.
  	(index < limit
  	 and: [(atCache at: atIx+AtCacheOop) = array]) ifFalse:
  		[^self primitiveFail].
+ 	((self isOopImmutable: stream)
+ 	 or: [self isOopImmutable: array]) ifTrue:
- 	((self internalIsMutable: stream)
- 	 and: [self internalIsMutable: array]) ifFalse:
  		[^self primitiveFailFor: PrimErrNoModification].
  
  	"OK -- its not at end, and the array is in the cache"
  	index := index + 1.
  	self commonVariable: array at: index put: value cacheIndex: atIx.
  	self successful ifTrue:
  		[self storeInteger: StreamIndexIndex ofObject: stream withValue: index.
  		^ self pop: 2 thenPush: value].
  !

Item was changed:
  ----- Method: NewspeakInterpreter>>primitiveObjectAtPut (in category 'object access primitives') -----
  primitiveObjectAtPut
  "Defined for CompiledMethods only"
+ 	| rcvr index newValue |
- 	| thisReceiver index newValue |
  	newValue := self stackValue: 0.
  	index := self stackIntegerValue: 1.
  	self successful ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
+ 	rcvr := self stackValue: 2.
+ 	(index > 0 and: [index <= ((self literalCountOf: rcvr) + LiteralStart)]) ifFalse:
- 	thisReceiver := self stackValue: 2.
- 	(index > 0 and: [index <= ((self literalCountOf: thisReceiver) + LiteralStart)]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
+ 	(self isOopImmutable: rcvr) ifTrue:
- 	(self internalIsMutable: thisReceiver) ifFalse:
  		[^self primitiveFailFor: PrimErrNoModification].
+ 	self storePointer: index - 1 ofObject: rcvr withValue: newValue.
- 	self storePointer: index - 1 ofObject: thisReceiver withValue: newValue.
  	self pop: 3 thenPush: newValue!

Item was changed:
  ----- Method: NewspeakInterpreter>>primitiveShortAtPut (in category 'sound primitives') -----
  primitiveShortAtPut
  	"Treat the receiver, which can be indexible by either bytes or words, as an array of signed 16-bit values. Set the contents of the given index to the given value. Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
  
  	| index rcvr sz addr value |
  	value := self stackIntegerValue: 0.
  	index := self stackIntegerValue: 1.
  	(self successful and: [(value >= -32768) and: [value <= 32767]]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	rcvr := self stackValue: 2.
  	((self isIntegerObject: rcvr) not and: [self isWordsOrBytes: rcvr]) ifFalse:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	sz := ((self sizeBitsOf: rcvr) - BaseHeaderSize) // 2.  "number of 16-bit fields"
  	(index >= 1 and: [index <= sz]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
+ 	(self isOopImmutable: rcvr) ifTrue:
- 	(self internalIsMutable: rcvr) ifFalse:
  		[^self primitiveFailFor: PrimErrNoModification].
  	addr := rcvr + BaseHeaderSize + (2 * (index - 1)).
  	self shortAt: addr put: value.
  	self pop: 3 thenPush: (self integerObjectOf: value) "pop all; return value"!

Item was changed:
  ----- Method: NewspeakInterpreter>>storeAndPopReceiverVariableBytecode (in category 'stack bytecodes') -----
  storeAndPopReceiverVariableBytecode
  	"Note: This code uses storePointerUnchecked:ofObject:withValue: and does the 
  	 store check explicitly in order to help the translator produce better code."
  	| rcvr top |
  	<expandCases>
  	self
  		cCode: "this bytecode will be expanded so that refs to currentBytecode below will be constant"
  			[rcvr := receiver.
  			 top := self internalStackTop.
+ 			 (self isObjImmutable: rcvr) ifTrue:
- 			 (self internalIsImmutable: rcvr) ifTrue:
  				[self internalPop: 1.
  				 self internalCannotAssign: top to: receiver withIndex: (currentBytecode bitAnd: 7)].
  			 "cannot fetch next bytecode until after immutability check so pc is correct (set to
  			  following bytecode, not the bytecode after that) after attemptToAssign:withIndex:"
  			 self fetchNextBytecode.
  			 rcvr < youngStart ifTrue:
  				[self possibleRootStoreInto: rcvr value: top].
  			 self storePointerUnchecked: (currentBytecode bitAnd: 7) ofObject: rcvr withValue: top.
  			 self internalPop: 1]
  		inSmalltalk: "Interpreter version has fetchNextBytecode out of order"
  			[rcvr := receiver.
  			 top := self internalStackTop.
+ 			 (self isObjImmutable: rcvr) ifTrue:
- 			 (self internalIsImmutable: rcvr) ifTrue:
  				[self internalPop: 1.
  				 self internalCannotAssign: top to: receiver withIndex: (currentBytecode bitAnd: 7)].
  			 rcvr < youngStart ifTrue:
  				[self possibleRootStoreInto: rcvr value: top].
  			 self storePointerUnchecked: (currentBytecode bitAnd: 7) ofObject: rcvr withValue: top.
  			 self internalPop: 1.
  			 self fetchNextBytecode]!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primAddressFieldPut (in category 'primitives-accessing') -----
  primAddressFieldPut
  	"Store an unsigned integer into the size field (the second 32 bit field; little endian)."
  	"<Alien> addressFieldPut: value <Integer> ^<Integer>
  		<primitive: 'primAddressFieldPut' error: errorCode module: 'IA32ABI'>"
  	| rcvr value valueOop |
  	<export: true>
  	valueOop := interpreterProxy stackValue: 0.
  	rcvr := interpreterProxy stackValue: 1.
  	value := interpreterProxy positive32BitValueOf: valueOop.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	self longAt: rcvr + BaseHeaderSize + BytesPerOop put: value.
  	^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primAlienReplace (in category 'primitives-accessing') -----
  primAlienReplace
  	"Copy some number of bytes from some source object starting at the index
  	 into the receiver destination object  from startIndex to stopIndex .  The  source
  	 and destination may be Aliens or byte-indexable objects.  The primitive wll have either
  	of the following signatures:
  	<Alien | indexableByteSubclass | indexableWordSubclass>
  		primReplaceFrom: start <Integer>
  		to: stop <Integer>
  		with: replacement <Alien | indexableByteSubclass | indexableWordSubclass | Integer>
  		startingAt: repStart <Integer> ^<self>
  		<primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'>
  	<Anywhere>
  		primReplaceIn: dest <Alien | indexableByteSubclass | indexableWordSubclass>
  		from: start <Integer>
  		to: stop <Integer>
  		with: replacement <Alien | indexableByteSubclass | indexableWordSubclass | Integer>
  		startingAt: repStart <Integer> ^<self>
  		<primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'>
  	"
  	| array start stop repl replStart dest src totalLength count |
  	<export: true>
  	array := interpreterProxy stackValue: 4.
  	start := interpreterProxy stackIntegerValue: 3.
  	stop := interpreterProxy stackIntegerValue: 2.
  	repl := interpreterProxy stackValue: 1.
  	replStart := interpreterProxy stackIntegerValue: 0.
  
  	(interpreterProxy failed
  	 or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
  	(self isAlien: array)
  		ifTrue:
  			[totalLength := self sizeField: array.
  			 dest := (self startOfData: array withSize: totalLength) + start - 1.
  			 totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens"
  				ifTrue: [totalLength := stop]
  				ifFalse: [totalLength := totalLength abs]]
  		ifFalse:
  			[totalLength := interpreterProxy byteSizeOf: array.
  			 dest := (self startOfByteData: array) + start - 1].
  	(start >= 1 and: [start - 1 <= stop and: [stop <= totalLength]])
  		ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  
  	(interpreterProxy isIntegerObject: repl)
  		ifTrue:
  			[(interpreterProxy integerValueOf: repl) <= 0 ifTrue:
  				[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  			src := (interpreterProxy integerValueOf: repl) + replStart - 1]
  		ifFalse:
  			[(interpreterProxy fetchClassOf: repl) ==  interpreterProxy classLargePositiveInteger
  				ifTrue:
  					[src := (interpreterProxy positive32BitValueOf: repl) + replStart - 1.
  					 interpreterProxy failed ifTrue:
  						[^interpreterProxy primitiveFailFor: PrimErrBadArgument]]
  				ifFalse:
  					[(self isAlien: repl)
  						ifTrue:
  							[totalLength := self sizeField: repl.
  							 src := (self startOfData: repl withSize: totalLength) + replStart - 1.
  							 totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens"
  								ifTrue: [totalLength := stop - start + replStart]
  								ifFalse: [totalLength := totalLength abs]]
  						ifFalse:
  							[(interpreterProxy isWordsOrBytes: repl) ifFalse:
  								[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  							 totalLength := interpreterProxy byteSizeOf: repl.
  							 src := (self startOfByteData: repl) + replStart - 1].
  					(replStart >= 1 and: [stop - start + replStart <= totalLength]) ifFalse:
  						[^interpreterProxy primitiveFailFor: PrimErrBadIndex]]].
  
+ 	(interpreterProxy isOopImmutable: array) ifTrue:
- 	(interpreterProxy internalIsImmutable: array) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  
  	count := stop - start + 1.
  	self cCode: 'memmove((void *)dest,(void *)src,count)'
  		inSmalltalk:
  			[count := count + src + dest. "squash unused var compiler warnings"
  			 self error: 'not implemented'].
  
  	interpreterProxy pop: interpreterProxy methodArgumentCount!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primDoubleAtPut (in category 'primitives-accessing') -----
  primDoubleAtPut
  	"Store a double into 64 bits starting at the given byte offset (little endian)."
  	"<Alien> doubleAt: index <Integer> put: value <Float | Integer> ^<Float | Integer>
  		<primitive: 'primDoubleAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr valueOop floatValue |
  	<export: true>
  	<var: #floatValue type: #double>
  
  	valueOop := interpreterProxy stackValue: 0.
  	(interpreterProxy isIntegerObject: valueOop)
  		ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #double]
  		ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #double].
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 8 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
  	self cCode:'((int*)addr)[0] = ((int*)(&floatValue))[0]'.
  	self cCode:'((int*)addr)[1] = ((int*)(&floatValue))[1]'.
  	interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primFloatAtPut (in category 'primitives-accessing') -----
  primFloatAtPut
  	"Store a float into 32 bits starting at the given byte offset (little endian)."
  	"<Alien> floatAt: index <Integer> put: value <Float | Integer> ^<Float | Integer>
  		<primitive: 'primFloatAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr valueOop floatValue |
  	<export: true>
  	<var: #floatValue type: #float>
  
  	valueOop := interpreterProxy stackValue: 0.
  	(interpreterProxy isIntegerObject: valueOop)
  		ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #double]
  		ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #double].
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 4 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
  	self cCode:'((long *)addr)[0] = ((long *)(&floatValue))[0]'.
  	interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primSignedByteAtPut (in category 'primitives-accessing') -----
  primSignedByteAtPut
  	"Store a signed integer into 8 bits starting at the given byte offset (little endian)."
  	"<Alien> signedByteAt: index <Integer> put: value <Integer> ^<Integer>
  		<primitive: 'primSignedByteAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr value valueOop |
  	<export: true>
  
  	valueOop := interpreterProxy stackValue: 0.
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	value := interpreterProxy signed32BitValueOf: valueOop.
  	(interpreterProxy failed
  	or: [value < -128
  	or: [value > 127]]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 1 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
  	self byteAt: addr put: value.
  	^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primSignedLongAtPut (in category 'primitives-accessing') -----
  primSignedLongAtPut
  	"Store a signed integer into 32 bits starting at the given byte offset (little endian)."
  	"<Alien> signedLongAt: index <Integer> put: value <Integer> ^<Integer>
  		<primitive: 'primSignedLongAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr value valueOop |
  	<export: true>
  
  	valueOop := interpreterProxy stackValue: 0.
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	value := interpreterProxy signed32BitValueOf: valueOop.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 4 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
  	self longAt: addr put: value.
  	^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primSignedLongLongAtPut (in category 'primitives-accessing') -----
  primSignedLongLongAtPut
  	"Store a signed integer into 64 bits starting at the given byte offset (little endian)."
  	"<Alien> signedLongLongAt: index <Integer> put: value <Integer> ^<Integer>
  		<primitive: 'primSignedLongLongAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr valueOop signedlonglongvalue signedlonglongvaluePtr |
  	<export: true>
  	<var: 'signedlonglongvalue' declareC: 'long long signedlonglongvalue'>
  	<var: 'signedlonglongvaluePtr' declareC: 'long long *signedlonglongvaluePtr'>
  
  	signedlonglongvaluePtr := 0.
  	self touch: signedlonglongvaluePtr.
  	valueOop := interpreterProxy stackValue: 0.
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	signedlonglongvalue := interpreterProxy signed64BitValueOf: valueOop.
  	self touch: signedlonglongvalue.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 8 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
  	signedlonglongvaluePtr := self cCoerce: addr to: 'long long*'.
  	self cCode: '*signedlonglongvaluePtr = signedlonglongvalue'.
  	^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primSignedShortAtPut (in category 'primitives-accessing') -----
  primSignedShortAtPut
  	"Store a signed integer into 16 bits starting at the given byte offset (little endian)."
  	"<Alien> signedShortAt: index <Integer> put: value <Integer> ^<Integer>
  		<primitive: 'primSignedShortAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr value valueOop |
  	<export: true>
  
  	valueOop := interpreterProxy stackValue: 0.
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	value := interpreterProxy signed32BitValueOf: valueOop.
  	(interpreterProxy failed
  	or: [value < -32768
  	or: [value > 32767]]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 2 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
  	self shortAt: addr put: value.
  	^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primSizeFieldPut (in category 'primitives-accessing') -----
  primSizeFieldPut
  	"Store a signed integer into the size field (the first 32 bit field; little endian)."
  	"<Alien> sizeFieldPut: value <Integer> ^<Integer>
  		<primitive: 'primSizeFieldPut' error: errorCode module: 'IA32ABI'>"
  	| rcvr value valueOop |
  	<export: true>
  
  	valueOop := interpreterProxy stackValue: 0.
  	rcvr := interpreterProxy stackValue: 1.
  	value := interpreterProxy signed32BitValueOf: valueOop.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	self longAt: rcvr + BaseHeaderSize put: value.
  	^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primUnsignedByteAtPut (in category 'primitives-accessing') -----
  primUnsignedByteAtPut
  	"Store an unsigned integer into 8 bits starting at the given byte offset (little endian)."
  	"<Alien> unsignedByteAt: index <Integer> put: value <Integer> ^<Integer>
  		<primitive: 'primUnsignedByteAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr value valueOop |
  	<export: true>
  
  	valueOop := interpreterProxy stackValue: 0.
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	value := interpreterProxy positive32BitValueOf: valueOop.
  	(interpreterProxy failed
  	or: [value > 255]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 1 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
  	self byteAt: addr put: value.
  	^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primUnsignedLongAtPut (in category 'primitives-accessing') -----
  primUnsignedLongAtPut
  	"Store an unsigned integer into 32 bits starting at the given byte offset (little endian)."
  	"<Alien> unsignedLongAt: index <Integer> put: value <Integer> ^<Integer>
  		<primitive: 'primUnsignedLongAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr value valueOop |
  	<export: true>
  
  	valueOop := interpreterProxy stackValue: 0.
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	value := interpreterProxy positive32BitValueOf: valueOop.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 4 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
  	self longAt: addr put: value.
  	^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primUnsignedLongLongAtPut (in category 'primitives-accessing') -----
  primUnsignedLongLongAtPut
  	"Store a signed integer into 64 bits starting at the given byte offset (little endian)."
  	"<Alien> unsignedLongLongAt: index <Integer> put: value <Integer> ^<Integer>
  		<primitive: 'primUnSignedLongLongAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr valueOop unsignedlonglongvalue unsignedlonglongvaluePtr |
  	<export: true>
  	<var: 'unsignedlonglongvalue' declareC: 'unsigned long long unsignedlonglongvalue'>
  	<var: 'unsignedlonglongvaluePtr' declareC: 'unsigned long long *unsignedlonglongvaluePtr'>
  
  	unsignedlonglongvaluePtr := 0.
  	self touch: unsignedlonglongvaluePtr.
  
  	valueOop := interpreterProxy stackValue: 0.
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	unsignedlonglongvalue := interpreterProxy positive64BitValueOf: valueOop.
  	self touch: unsignedlonglongvalue.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 8 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
  	unsignedlonglongvaluePtr := self cCoerce: addr to: 'unsigned long long*'.
  	self cCode: '*unsignedlonglongvaluePtr = unsignedlonglongvalue'.
  	^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primUnsignedShortAtPut (in category 'primitives-accessing') -----
  primUnsignedShortAtPut
  	"Store an unsigned integer into 16 bits starting at the given byte offset (little endian)."
  	"<Alien> unsignedShortAt: index <Integer> put: value <Integer> ^<Integer>
  		<primitive: 'primUnsignedShortAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr value valueOop |
  	<export: true>
  
  	valueOop := interpreterProxy stackValue: 0.
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	value := interpreterProxy positive32BitValueOf: valueOop.
  	(interpreterProxy failed
  	or: [value > 65535]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 2 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 	(interpreterProxy isOopImmutable: rcvr) ifTrue:
- 	(interpreterProxy internalIsImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
  	self shortAt: addr put: value.
  	^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: ObjectMemory>>containOnlyMutableOops:and: (in category 'become') -----
  containOnlyMutableOops: array1 and: array2 
  	"Return true if neither array contains an immutable.
  	 You may not be allowed to become: immutables."
  	| fieldOffset |
  	fieldOffset := self lastPointerOf: array1.
  	"same size as array2"
  	[fieldOffset >= BaseHeaderSize] whileTrue:
+ 		[(self isOopImmutable: (self longAt: array1 + fieldOffset)) ifTrue: [^false].
+ 		 (self isOopImmutable: (self longAt: array2 + fieldOffset)) ifTrue: [^false].
- 		[(self internalIsImmutable: (self longAt: array1 + fieldOffset)) ifTrue: [^ false].
- 		 (self internalIsImmutable: (self longAt: array2 + fieldOffset)) ifTrue: [^ false].
  		 fieldOffset := fieldOffset - BytesPerWord].
+ 	^true!
- 	^ true!

Item was added:
+ ----- Method: ObjectMemory>>isObjImmutable: (in category 'header access') -----
+ isObjImmutable: anOop
+ 	<inline: true>
+ 	^self cppIf: IMMUTABILITY
+ 		ifTrue: [((self baseHeader: anOop) bitAnd: ImmutabilityBit hex) ~= 0]
+ 		ifFalse: [false]!

Item was added:
+ ----- Method: ObjectMemory>>isObjMutable: (in category 'header access') -----
+ isObjMutable: anOop
+ 	<inline: true>
+ 	^(self isObjImmutable: anOop) not!

Item was added:
+ ----- Method: ObjectMemory>>isOopImmutable: (in category 'header access') -----
+ isOopImmutable: anOop
+ 	<api>
+ 	^(self isIntegerObject: anOop)
+ 	  or: [self isObjImmutable: anOop]!

Item was added:
+ ----- Method: ObjectMemory>>isOopMutable: (in category 'header access') -----
+ isOopMutable: anOop
+ 	<api>
+ 	^(self isIntegerObject: anOop) not
+ 	  and: [(self isObjImmutable: anOop) not]!

Item was changed:
  ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)

Item was removed:
- ----- Method: StackInterpreter>>internalIsImmutable: (in category 'object format') -----
- internalIsImmutable: oop
- 	<option: #NewspeakVM>
- 	<inline: true>
- 	<export: true>
- 	^((objectMemory baseHeader: oop) bitAnd: ImmutabilityBit) ~= 0!



More information about the Vm-dev mailing list