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

commits at source.squeak.org commits at source.squeak.org
Sun Jun 24 02:39:36 UTC 2012


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

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

Name: VMMaker.oscog-eem.167
Author: eem
Time: 23 June 2012, 7:36:44.881 pm
UUID: 89fa3b26-2b31-41ee-861c-68062ff3e443
Ancestors: VMMaker.oscog-eem.166

Fix but in changeClassFrom:to: if receiver is a compact class
instance with a large header.
Restore ye olde object printing style.
Use bitClear: instead of wrong-for-64-bits bitInvert32 to clear
several bit fields.

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

Item was changed:
  ----- Method: CoInterpreter>>getImageHeaderFlags (in category 'image save/restore') -----
  getImageHeaderFlags
  	"Answer the flags that are contained in the 7th long of the image header."
  	^fullScreenFlag "0 or 1"
  	+ (VMBIGENDIAN ifTrue: [0] ifFalse: [2]) "this is the imageFloatsLittleEndian flag"
  	+ (processHasThreadId ifTrue: [4] ifFalse: [0])
  	+ (flagInterpretedMethods ifTrue: [8] ifFalse: [0])
  	+ (preemptionYields ifTrue: [0] ifFalse: [16])
  	+ (noThreadingOfGUIThread ifTrue: [32] ifFalse: [0])
+ 	+ (imageHeaderFlags bitClear: 63) "these are any flags we do not recognize"!
- 	+ (imageHeaderFlags bitAnd: 63 bitInvert32) "these are any flags we do not recognize"!

Item was changed:
  ----- Method: Cogit>>alignUptoRoutineBoundary: (in category 'generate machine code') -----
  alignUptoRoutineBoundary: anAddress 
+ 	^anAddress + 7 bitClear: 7!
- 	^anAddress + 7 bitAnd: 7 bitInvert32!

Item was changed:
  ----- Method: Cogit>>generateMapAt:start: (in category 'method map') -----
  generateMapAt: addressOrNull start: startAddress
  	"Generate the method map at addressrNull (or compute it if adressOrNull is null).
  	 Answer the length of the map in byes.  Each entry in the map is in two parts.  In the
  	 least signficant bits are a displacement of how far from the start or previous entry.
  	 In the most signficant bits are the type of annotation at the point reached.  A null
  	 byte ends the map."
  	| length location |
  	<var: #annotation type: #'InstructionAnnotation *'>
  	length := 0.
  	location := startAddress.
  	0 to: annotationIndex - 1 do:
  		[:i| | annotation mcpc delta maxDelta mapEntry |
  		 annotation := self addressOf: (annotations at: i).
  		 mcpc := annotation instruction address + annotation instruction machineCodeSize.
  		 [(delta := mcpc - location) > MaxUnitDisplacement] whileTrue:
+ 			[maxDelta := (delta min: MaxX2NDisplacement) bitClear: DisplacementMask.
- 			[maxDelta := (delta min: MaxX2NDisplacement) bitAnd: DisplacementMask bitInvert32.
  			 self assert: maxDelta >> AnnotationShift <= DisplacementMask.
  			 addressOrNull ~= 0 ifTrue:
  				[objectMemory
  					byteAt: addressOrNull - length
  					put: maxDelta >> AnnotationShift + DisplacementX2N.
  				 self traceMap: IsDisplacementX2N
  					  byte: maxDelta >> AnnotationShift + DisplacementX2N
  					  at: addressOrNull - length
  					  for: mcpc].
  			 location := location + maxDelta.
  			 length := length + 1].
  		 addressOrNull ~= 0 ifTrue:
  			[mapEntry := delta + (annotation annotation << AnnotationShift).
  			 objectMemory byteAt: addressOrNull - length put: mapEntry.
  			 self traceMap: annotation
  				  byte: mapEntry
  				  at: addressOrNull - length
  				  for: mcpc].
  		 location := location + delta.
  		 length := length + 1].
  	addressOrNull ~= 0 ifTrue:
  		[objectMemory byteAt: addressOrNull - length put: MapEnd.
  		 self traceMap: MapEnd
  			  byte: MapEnd
  			  at: addressOrNull - length
  			  for: 0].
  	^length + 1!

Item was changed:
  ----- Method: NewObjectMemory>>sufficientSpaceToAllocate: (in category 'allocation') -----
  sufficientSpaceToAllocate: bytes
  	"Return true if there is enough space to allocate the given number of bytes, perhaps after doing a garbage collection."
  
  	| minFree |
  	<inline: true>
+ 	minFree := (lowSpaceThreshold + bytes + BaseHeaderSize + BytesPerWord - 1) bitClear: BytesPerWord - 1.
- 	minFree := (lowSpaceThreshold + bytes + BaseHeaderSize + BytesPerWord - 1) bitAnd: (BytesPerWord - 1) bitInvert32.
  
  	"check for low-space"
  	(self oop: freeStart + minFree isLessThanOrEqualTo: reserveStart) ifTrue:
  		[^true].
  	^self sufficientSpaceAfterGC: minFree!

Item was changed:
  ----- Method: ObjectMemory>>changeClassOf:to: (in category 'interpreter access') -----
  changeClassOf: rcvr to: argClass
  	"Attempt to change the class of the receiver into the class of the the argument given that the
  	 format of the receiver matches the format of the argument. If successful answer 0, otherwise
  	 answer an error code indicating the reason for failure.  Fail if receiver or argument are
  	 SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when
  	 the format of the receiver is different from the format of the argument's class, or when the
  	 arguments class is fixed and the receiver's size differs from the size that an instance of the
  	 argument's class should have."
  	| classHdr sizeHiBits byteSize argFormat rcvrFormat rcvrHdr ccIndex |
  	"Check what the format of the class says"
  	classHdr := self formatOfClass: argClass. "Low 2 bits are 0"
  
  	"Compute the size of instances of the class (used for fixed field classes only)"
  	sizeHiBits := (classHdr bitAnd: 16r60000) >> 9.
  	classHdr := classHdr bitAnd: 16r1FFFF.
  	byteSize := (classHdr bitAnd: SizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
  
  	"Check the receiver's format against that of the class"
  	argFormat := self formatOfHeader: classHdr.
  	rcvrHdr := self baseHeader: rcvr.
  	rcvrFormat := self formatOfHeader: rcvrHdr.
  	"If the receiver is a byte object we need to clear the number of odd bytes from the format."
  	rcvrFormat > 8 ifTrue:
  		[rcvrFormat := rcvrFormat bitAnd: 16rC].
  	argFormat = rcvrFormat ifFalse:
  		[^PrimErrInappropriate]. "no way"
  
  	"For fixed field classes, the sizes must match.
  	Note: byteSize-4 because base header is included in class size."
  	argFormat < 2
  		ifTrue:
  			[(byteSize - BaseHeaderSize) ~= (self byteSizeOf: rcvr) ifTrue:
  				[^PrimErrBadReceiver]]
  		ifFalse:
  			[argFormat = 3 ifTrue: "For indexable plus fixed fields the receiver must be at least big enough."
  				[(byteSize - BaseHeaderSize) > (self byteSizeOf: rcvr) ifTrue:
  					[^PrimErrBadReceiver]]].
  
  	(self headerTypeOfHeader: rcvrHdr) = HeaderTypeShort
  		ifTrue: "Compact classes. Check if the arg's class is compact and exchange ccIndex"
  			[ccIndex := classHdr bitAnd: CompactClassMask.
  			ccIndex = 0 ifTrue:
  				[^PrimErrInappropriate]. "class is not compact"
  			self cppIf: IMMUTABILITY
  				ifTrue: [(rcvrHdr bitAnd: ImmutabilityBit) ~= 0 ifTrue:
  							[^PrimErrNoModification]].
+ 			self baseHeader: rcvr
+ 				put: (((self longAt: rcvr) bitClear: CompactClassMask) bitOr: ccIndex)]
- 			self longAt: rcvr put:
- 				(((self longAt: rcvr) bitAnd: CompactClassMask bitInvert32) bitOr: ccIndex)]
  		ifFalse: "Exchange the class pointer, which could make rcvr a root for argClass"
  			[self cppIf: IMMUTABILITY
  				ifTrue: [(rcvrHdr bitAnd: ImmutabilityBit) ~= 0 ifTrue:
  							[^PrimErrNoModification]].
+ 			(self compactClassIndexOf: rcvr) ~= 0 ifTrue:
+ 				[self baseHeader: rcvr
+ 					put: ((self baseHeader: rcvr) bitClear: CompactClassMask)].			
  			self longAt: rcvr-BaseHeaderSize put: (argClass bitOr: (self headerType: rcvr)).
  			(self oop: rcvr isLessThan: youngStart) ifTrue:
  				[self possibleRootStoreInto: rcvr value: argClass]].
  	"ok"
  	^0!

Item was changed:
  ----- Method: ObjectMemory>>setHashBitsOf:to: (in category 'header access') -----
  setHashBitsOf: oop to: hash
  	self longAt: oop
+ 		put: (((self baseHeader: oop) bitClear: HashBits)
- 		put: (((self baseHeader: oop) bitAnd: HashBits bitInvert32)
  				bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset)!

Item was changed:
  ----- Method: ObjectMemory>>sufficientSpaceToAllocate: (in category 'allocation') -----
  sufficientSpaceToAllocate: bytes
  	"Return true if there is enough space to allocate the given number of bytes, perhaps after doing a garbage collection."
  
  	| minFree |
  	<inline: true>
+ 	minFree := (lowSpaceThreshold + bytes + BaseHeaderSize + BytesPerWord - 1) bitClear: BytesPerWord - 1.
- 	minFree := (lowSpaceThreshold + bytes + BaseHeaderSize + BytesPerWord - 1) bitAnd: (BytesPerWord - 1) bitInvert32.
  
  	"check for low-space"
  	(self oop: (self sizeOfFree: freeBlock) isGreaterThanOrEqualTo: minFree)
  		ifTrue: [^true]
  		ifFalse: [^self sufficientSpaceAfterGC: minFree].!

Item was changed:
  ----- Method: StackInterpreter>>elementsPerPrintOopLine (in category 'debug printing') -----
  elementsPerPrintOopLine
  	^5!

Item was changed:
  ----- Method: StackInterpreter>>getImageHeaderFlags (in category 'image save/restore') -----
  getImageHeaderFlags
  	"Answer the flags that are contained in the 7th long of the image header."
  	^fullScreenFlag "0 or 1"
  	+ (VMBIGENDIAN ifTrue: [0] ifFalse: [2]) "this is the imageFloatsLittleEndian flag"
+ 	+ (preemptionYields ifTrue: [0] ifFalse: [16r10])
+ 	+ (imageHeaderFlags bitClear: 16r13) "these are any flags we do not recognize"!
- 	+ (preemptionYields ifTrue: [0] ifFalse: [16])
- 	+ (imageHeaderFlags bitAnd: 19 bitInvert32) "these are any flags we do not recognize"!

Item was changed:
  ----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
  printOop: oop
+ 	| cls fmt lastIndex startIP bytecodesPerLine |
- 	| cls fmt lastIndex startIP bytecodesPerLine column |
  	<inline: false>
  	self printHex: oop.
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[^self
  			cCode: 'printf("=%ld\n", integerValueOf(oop))'
  			inSmalltalk: [self print: (self shortPrint: oop); cr]].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[self printHex: oop; print: ' is not on the heap'; cr.
  		 ^nil].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[self printHex: oop; print: ' is misaligned'; cr.
  		 ^nil].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[self print: ' free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr.
  		 ^nil].
- "
  	self print: ': a(n) '.
- "
  	self printNameOfClass: (cls := objectMemory fetchClassOfNonInt: oop) count: 5.
  	cls = (objectMemory splObj: ClassFloat) ifTrue:
  		[self cr; printFloat: (self dbgFloatValueOf: oop); cr.
  		 ^nil].
  	fmt := objectMemory formatOf: oop.
  	fmt > 4 ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory byteSizeOf: oop)].
  	self cr.
  	(fmt > 4 and: [fmt < 12]) ifTrue:
  		["This will answer false if splObj: ClassAlien is nilObject"
  		 (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
  			[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
  			self print: ((self isIndirectAlien: oop)
  							ifTrue: [' indirect @ ']
  							ifFalse:
  								[(self isPointerAlien: oop)
  									ifTrue: [' pointer @ ']
  									ifFalse: [' direct @ ']]).
  			 self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr.
  			 ^nil].
  		 (objectMemory isWords: oop) ifTrue:
  			[lastIndex := 64 min: ((objectMemory byteSizeOf: oop) / BytesPerWord).
  			 lastIndex > 0 ifTrue:
  				[1 to: lastIndex do:
  					[:index|
  					self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
  					(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  						[self cr]].
  				(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  					[self cr]].
  			^nil].
  		^self printStringOf: oop; cr].
  	lastIndex := 64 min: (startIP := (objectMemory lastPointerOf: oop) / BytesPerWord).
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:index|
  			self cCode: 'printHex(fetchPointerofObject(index - 1, oop)); putchar('' '')'
  				inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
  							 self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
  			(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  				[self cr]].
  		(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  			[self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * BytesPerWord + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
+ 			 bytecodesPerLine := 10.
- 			 bytecodesPerLine := 8.
- 			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
- 				(column = 1) ifTrue:[
- 					self cCode: 'printf("%08x: ", oop+index-1)'
- 						inSmalltalk: [self print: (oop+index-1) hex; print: ': '].
- 				].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", byte,byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
+ 				((index - startIP + 1) \\ bytecodesPerLine) = 0 ifTrue:
+ 					[self cr]].
+ 			((lastIndex - startIP + 1) \\ bytecodesPerLine) = 0 ifFalse:
- 				column := column + 1.
- 				(column > bytecodesPerLine) ifTrue:
- 					[column := 1. self cr]].
- 			(column = 1) ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs: (in category 'callout support') -----
  ffiCall: externalFunction ArgArrayOrNil: argArrayOrNil NumArgs: nArgs
  	"Generic callout. Does the actual work.  If argArrayOrNil is nil it takes args from the stack
  	 and the spec from the method.  If argArrayOrNil is not nil takes args from argArrayOrNil
  	 and the spec from the receiver."
  	| flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result |
  	<inline: true>
  	<var: #theCalloutState type: #'CalloutState'>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #allocation type: #'char *'>
  
  	(interpreterProxy is: externalFunction KindOfClass: interpreterProxy classExternalFunction) ifFalse:
  		[^self ffiFail: FFIErrorNotFunction].
  	"Load and check the values in the externalFunction before we call out"
  	flags := interpreterProxy fetchInteger: ExternalFunctionFlagsIndex ofObject: externalFunction.
  	interpreterProxy failed ifTrue:
  		[^self ffiFail: FFIErrorBadArgs].
  
  	"This must come early for compatibility with the old FFIPlugin.  Image-level code
  	 may assume the function pointer is loaded eagerly.  Thanks to Nicolas Cellier."
  	address := self ffiLoadCalloutAddress: externalFunction.
  	interpreterProxy failed ifTrue:
  		[^0 "error code already set by ffiLoadCalloutAddress:"].
  	
  	argTypeArray := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: externalFunction.
  	"must be array of arg types"
  	((interpreterProxy isArray: argTypeArray)
  	and: [(interpreterProxy slotSizeOf: argTypeArray) = (nArgs + 1)]) ifFalse:
  		[^self ffiFail: FFIErrorBadArgs].
  	"check if the calling convention is supported"
  	self cppIf: COGMTVM
  		ifTrue:
  			[(self ffiSupportsCallingConvention: (flags bitAnd: FFICallTypesMask)) ifFalse:
  				[^self ffiFail: FFIErrorCallType]]
  		ifFalse: "not masking causes threaded calls to fail, which is as they should if the plugin is not threaded."
  			[(self ffiSupportsCallingConvention: flags) ifFalse:
  				[^self ffiFail: FFIErrorCallType]].
  		
  	requiredStackSize := self externalFunctionHasStackSizeSlot
  							ifTrue: [interpreterProxy
  										fetchInteger: ExternalFunctionStackSizeIndex
  										ofObject: externalFunction]
  							ifFalse: [-1].
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: (argArrayOrNil isNil
  												ifTrue: [PrimErrBadMethod]
  												ifFalse: [PrimErrBadReceiver])].
  	stackSize := requiredStackSize < 0 ifTrue: [DefaultMaxStackSize] ifFalse: [requiredStackSize].
  	self cCode: [] inSmalltalk: [theCalloutState := self class calloutStateClass new].
  	calloutState := self addressOf: theCalloutState.
  	self cCode: [self me: calloutState ms: 0 et: (self sizeof: #CalloutState asSymbol)].
  	calloutState callFlags: flags.
  	"Fetch return type and args"
  	argType := interpreterProxy fetchPointer: 0 ofObject: argTypeArray.
  	argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
  	argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
  	(err := self ffiCheckReturn: argSpec With: argClass in: calloutState) ~= 0 ifTrue:
  		[^self ffiFail: err]. "cannot return"
  	"alloca the outgoing stack frame, leaving room for register args while marshalling, and including space for the return struct, if any."
  	allocation := self alloca: stackSize + calloutState structReturnSize + self registerArgsSlop + self cStackAlignment.
  	self allocaLiesSoUseGetsp ifTrue:
  		[allocation := self getsp].
  	self cStackAlignment ~= 0 ifTrue:
+ 		[allocation := self cCoerce: (allocation asUnsignedInteger bitClear: self cStackAlignment - 1)
- 		[allocation := self cCoerce: (allocation asUnsignedInteger bitAnd: (self cStackAlignment - 1) bitInvert32)
  						to: #'char *'].
  	calloutState
  		argVector: allocation;
  		currentArg: allocation + self registerArgsSlop;
  		limit: allocation + stackSize + self registerArgsSlop.
  	(calloutState structReturnSize > 0
  	 and: [self nonRegisterStructReturnIsViaImplicitFirstArgument
  	 and: [(self returnStructInRegisters: calloutState structReturnSize) not]]) ifTrue:
  		[self ffiPushPointer: calloutState limit in: calloutState].
  	1 to: nArgs do:
  		[:i|
  		argType := interpreterProxy fetchPointer: i ofObject: argTypeArray.
  		argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
  		argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
  		oop := argArrayOrNil isNil
  				ifTrue: [interpreterProxy stackValue: nArgs - i]
  				ifFalse: [interpreterProxy fetchPointer: i - 1 ofObject: argArrayOrNil].
  		err := self ffiArgument: oop Spec: argSpec Class: argClass in: calloutState.
  		err ~= 0 ifTrue:
  			[self cleanupCalloutState: calloutState.
  			 self cppIf: COGMTVM ifTrue:
  			 [err = PrimErrObjectMayMove negated ifTrue:
  				[^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
  			 ^self ffiFail: err]]. "coercion failed or out of stack space"
  	"Failures must be reported back from ffiArgument:Spec:Class:in:.
  	 Should not fail from here on in."
  	self assert: interpreterProxy failed not.
  	self ffiLogCallout: externalFunction.
  	(requiredStackSize < 0
  	 and: [self externalFunctionHasStackSizeSlot]) ifTrue:
  		[stackSize := calloutState currentArg - calloutState argVector.
  		 interpreterProxy storeInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction withValue: stackSize].
  	"Go out and call this guy"
  	result := self ffiCalloutTo: address SpecOnStack: argArrayOrNil notNil in: calloutState.
  	self cleanupCalloutState: calloutState.
  	^result!

Item was changed:
  ----- Method: ThreadedIA32FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
  ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
  	<var: #pointer type: #'void *'>
  	<var: #argSpec type: #'sqInt *'>
  	<var: #calloutState type: #'CalloutState *'>
  	<inline: true>
  	| roundedSize |
+ 	roundedSize := structSize + 3 bitClear: 3.
- 	roundedSize := structSize + 3 bitAnd: 3 bitInvert32.
  	calloutState currentArg + roundedSize > calloutState limit ifTrue:
  		[^FFIErrorCallFrameTooBig].
  	self mem: calloutState currentArg cp: pointer y: structSize.
  	calloutState currentArg: calloutState currentArg + roundedSize.
  	^0!



More information about the Vm-dev mailing list