[Vm-dev] VM Maker: Cog-eem.224.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Nov 27 23:42:01 UTC 2014

Eliot Miranda uploaded a new version of Cog to project VM Maker:

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

Name: Cog-eem.224
Author: eem
Time: 26 November 2014, 10:48:13.13 am
UUID: f6019ed0-a399-4ad7-9d02-db0e691b39f3
Ancestors: Cog-eem.223

Fix SpurBootstrap>>allMethodPrototypes given
Esteban's reorganization.

Make fillInPointerObjectWithPC:from: tolerate a nil
method (for the MethodContext prototype).

64-bit-ize the bootstrap, which involves:
Fix findRequiredGlobals for the potentially
Undeclared BoxedFloat64.

Fix installableMethodFor:selector:className:isMeta:
for up-to 64-bit Integer literals.

Map SmallFloat64 to an immediateSubclass:.

Make the prototype for fromIEEE32Bit: multiply by
1.0 to reduce result to a SmallFloat64 if possible.

Make recreateSpecialObjectsArray install
BoxedFloat64 in place of Float.

=============== Diff against Cog-eem.223 ===============

Item was changed:
  ----- Method: SpurBootstrap>>allMethodPrototypes (in category 'method prototypes') -----
  	"Answer all prototype selectors, including those marked <remove>"
+ 		inject: (IdentitySet withAll: SpurBootstrapPrototypes allMethodPrototypes)
- 		inject: (IdentitySet withAll: SpurBootstrapPrototypes new allMethodPrototypes)
  		into: [:allPrototypes :type | | prototypes |
+ 			prototypes := (SpurBootstrapPrototypes prototypeClassFor: type) allMethodPrototypes.
- 			prototypes := (SpurBootstrapPrototypes prototypesFor: type) allMethodPrototypes.
  				removeAllSuchThat: [:existing| prototypes anySatisfy: [:new| existing selector == new selector]];
  				addAll: prototypes;
  		asArray sort: [:ma :mb| ma selector <= mb selector]!

Item was changed:
  ----- Method: SpurBootstrap>>fillInPointerObjectWithPC:from: (in category 'bootstrap image') -----
  fillInPointerObjectWithPC: newObj from: oldObj
  	"Fill-in a newObj with appropriately mapped contents from oldObj.
  	 If the object has a pc and its method has a primitive, increment the
  	 pc by the size of the callPrimitive: bytecode."
  	| method |
  	self fillInPointerObject: newObj from: oldObj.
  	(newHeap classIndexOf: newObj) = classBlockClosureIndex ifTrue:
  		[method := oldHeap
  						fetchPointer: MethodIndex
  						ofObject: (oldHeap
  									fetchPointer: ClosureOuterContextIndex
  									ofObject: oldObj).
  		 (oldInterpreter primitiveIndexOf: method) > 0 ifTrue:
  			[self incrementPCField: ClosureStartPCIndex ofObject: newObj by: 3]].
  	(newHeap classIndexOf: newObj) = classMethodContextIndex ifTrue:
  		[method := oldHeap
  						fetchPointer: MethodIndex
  						ofObject: oldObj.
+ 		 (method ~= oldHeap nilObject
+ 		  and: [(oldInterpreter primitiveIndexOf: method) > 0]) ifTrue:
- 		 (oldInterpreter primitiveIndexOf: method) > 0 ifTrue:
  			[self incrementPCField: InstructionPointerIndex ofObject: newObj by: 3]].!

Item was changed:
  ----- Method: SpurBootstrap>>findRequiredGlobals (in category 'bootstrap image') -----
  	"Look for the necessary gobal bindings in the prototype methods in the old image.
  	 This has to be done early by sending bindingOf: to Smalltalk.  Collect the class
  	 hierarchy of all prototypes that access inst vars (non-local prototypes) to check
  	 their shapes.  Also find out Metaclass, needed for identifying classes."
  	| globals ourMethodClasses classVars bindingOfSym |
  	globals := Set new.
  	ourMethodClasses := Set new.
  	classVars := Dictionary new.
  	self prototypeClassNameMetaSelectorMethodDo:
  		[:c :m :s :method| | allNonMetaSupers |
  		(Smalltalk classNamed: c) ifNotNil:
  			allNonMetaSupers := nonMetaClass withAllSuperclasses.
  			(method methodClass includesBehavior: SpurBootstrapPrototypes) ifFalse:
  				[ourMethodClasses addAll: allNonMetaSupers.
  				 globals addAll: (allNonMetaSupers collect: [:sc| sc binding])].
  			method literals do:
  				(l isVariableBinding
  				 and: [l key isSymbol
  				 and: [SpurBootstrapPrototypes withAllSubclasses noneSatisfy: [:sbpc| sbpc name == l key]]]) ifTrue:
+ 					[((Smalltalk bindingOf: l key) == l
+ 					  or: [(Undeclared bindingOf: l key) == l])
- 					[(Smalltalk bindingOf: l key) == l
  						ifTrue: [globals add: l]
  							[self assert: (nonMetaClass bindingOf: l key) == l.
  							classVars at: l put: nonMetaClass]]]]].
  	globals add: Compiler binding. "For potential reshaping in checkReshapeOf:"
  	bindingOfSym := self findSymbol: #bindingOf:.
  	self withExecutableInterpreter: oldInterpreter
  		do:	[| toBeAdded |
  			globals do:
  				[:global| | bindingOop |
  				(self findSymbol: global key) ifNotNil:
  					bindingOop := self interpreter: oldInterpreter
  										object: (oldHeap splObj: 8) "Smalltalk"
  										perform: bindingOfSym
  										withArguments: {self findSymbol: global key}.
  					bindingOop ~= oldHeap nilObject ifTrue:
  						[literalMap at: global put: bindingOop]]].
  			 toBeAdded := Dictionary new.
  			 classVars keysAndValuesDo:
  				[:var :class| | val |
  				(self findSymbol: var key) "New class inst vars may not yet be interned."
  					ifNil: [toBeAdded at: var put: class]
  						val := self interpreter: oldInterpreter
  									object: (self oldClassOopFor: class)
  									perform: bindingOfSym
  									withArguments: {varName}.
  						val ~= oldHeap nilObject
  							ifTrue: [literalMap at: var put: val]
  							ifFalse: [toBeAdded at: var put: class]]].
  			"May have to redefine to add missing inst vars and/or add any missing class vars."
  			self checkReshapeOf: ourMethodClasses.
  			self addMissingClassVars: toBeAdded]!

Item was changed:
  ----- Method: SpurBootstrap>>installableMethodFor:selector:className:isMeta: (in category 'bootstrap methods') -----
  installableMethodFor: aCompiledMethod selector: selector className: className isMeta: isMeta
  	"Create a sourceless method to install in the bootstrapped image.  It will allow the
  	 bootstrap to limp along until the relevant transformed Monticello package is loaded."
  	| compiledMethodClass methodClassBinding methodClass sourcelessMethod bytes newMethod delta initialPC |
  	compiledMethodClass := self findClassNamed: (self findSymbol: #CompiledMethod).
  	methodClassBinding := self methodClassBindingForClassName: className isMeta: isMeta.
  	methodClass := oldHeap fetchPointer: ValueIndex ofObject: methodClassBinding.
  	"the prototypes have source pointers.  the Character methods to be replaced don't."
  	sourcelessMethod := aCompiledMethod trailer hasSourcePointer
  							ifTrue: [aCompiledMethod copyWithTempsFromMethodNode: aCompiledMethod methodNode]
  							ifFalse: [aCompiledMethod].
  	initialPC := sourcelessMethod initialPC.
  	bytes := sourcelessMethod size - initialPC + 1.
  	"Ugh, this is complicated.  We could be running on Spur with the new method format
  	 or on non-Spur with the old format.  Make both work."
  	delta := (sourcelessMethod primitive > 0
  			 and: [(sourcelessMethod at: initialPC) = sourcelessMethod encoderClass callPrimitiveCode])
  				ifTrue: [3]
  				ifFalse: [0].
  	newMethod := self
  					interpreter: oldInterpreter
  					object: compiledMethodClass
  					perform: (self findSymbol: #newMethod:header:)
  					withArguments: { oldHeap integerObjectOf: bytes - delta.
  									   oldHeap integerObjectOf: (self oldFormatHeaderFor: sourcelessMethod) }.
  	1 to: sourcelessMethod numLiterals - 2 do:
  		[:i| | literal oop |
  		literal := sourcelessMethod literalAt: i.
  		oop := (literal isLiteral or: [literal isVariableBinding])
  						[literal isInteger
+ 							ifTrue: [oldInterpreter signed64BitIntegerFor: literal]
- 							ifTrue: [oldHeap integerObjectOf: literal]
  							ifFalse: [literalMap
  										at: literal
  										ifAbsent: [self findLiteral: literal
  														inClass: methodClass]]]
  					ifFalse: "should be a VMObjectProxy"
  						[literal oop].
  		oldHeap storePointer: i ofObject: newMethod withValue: oop].
  		storePointer: sourcelessMethod numLiterals - 1
  		ofObject: newMethod
  		withValue: (selector isSymbol
  						ifTrue: [self findSymbol: selector]
  						ifFalse: [selector oop]);
  		storePointer: sourcelessMethod numLiterals
  		ofObject: newMethod
  		withValue: methodClassBinding.
  	initialPC to: sourcelessMethod size - delta do:
  		oldHeap storeByte: i - 1 ofObject: newMethod withValue: (sourcelessMethod byteAt: i + delta)].
  	installedMethodOops add: newMethod.

Item was changed:
  ----- Method: SpurBootstrap>>newClassFormatFor: (in category 'bootstrap image') -----
  newClassFormatFor: oldClassObj
  	"OLD: 		<2 bits=instSize//64><5 bits=cClass><4 bits=instSpec><6 bits=instSize\\64><1 bit=0>
  	 NEW: 		<5 bits inst spec><16 bits inst size>"
  	| oldFormat instSize newInstSpec |
  	((oldInterpreter classNameOf: oldClassObj Is: 'SmallInteger')
+ 	 or: [(oldInterpreter classNameOf: oldClassObj Is: 'Character')
+ 	 or: [oldInterpreter classNameOf: oldClassObj Is: 'SmallFloat64']]) ifTrue:
- 	 or: [oldInterpreter classNameOf: oldClassObj Is: 'Character']) ifTrue:
  		[^newHeap integerObjectOf: newHeap instSpecForImmediateClasses << 16].
  	oldFormat := oldHeap formatOfClass: oldClassObj. "N.B. SmallInteger with tag bit cleared"
  	oldFormat := oldFormat >> 1.
  	instSize := ((oldFormat bitShift: -10) bitAnd: 16rC0) + ((oldFormat bitShift: -1) bitAnd: 16r3F) - 1.
  	newInstSpec := #(0 1 2 3 4 nil 10 9 16 16 16 16 24 24 24 24) at: ((oldFormat bitShift: -7) bitAnd: 16rF) + 1.
  	^newHeap integerObjectOf: newInstSpec << 16 + instSize!

Item was added:
+ ----- Method: SpurBootstrapPrototypes class>>allMethodPrototypes (in category 'accessing method dictionary') -----
+ allMethodPrototypes
+ 	^(self canUnderstand: #allMethods)
+ 		ifTrue: "Pharo"
+ 			[self allMethods select:
+ 				[:each| each category = 'method prototypes']]
+ 		ifFalse: "Squeak"
+ 			[false
+ 				ifTrue: "%$#@*!! collect: on IdentitySet answers a *Set*, not an IdentitySet %$#@*!!"
+ 					[self allSelectors
+ 						collect: [:s| self lookupSelector: s]
+ 						thenSelect: [:m| m protocol = 'method prototypes']]
+ 				ifFalse: "...hence: "
+ 					[self allSelectors
+ 						inject: IdentitySet new
+ 						into: [:methods :sel| | method |
+ 							method := self lookupSelector: sel.
+ 							method protocol = 'method prototypes' ifTrue:
+ 								[methods add: method].
+ 							methods]]]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes class>>prototypeClassFor: (in category 'instance creation') -----
+ prototypeClassFor: type 
+ 	| deepest |
+ 	deepest := nil.
+ 	self allSubclassesDo:
+ 		[:aClass | aClass imageType = type ifTrue: [deepest := aClass]].
+ 	^deepest!

Item was removed:
- ----- Method: SpurBootstrapPrototypes class>>prototypesFor: (in category 'instance creation') -----
- prototypesFor: type 
- 	^ (self allSubclasses 
- 		detect: [ :aClass | aClass imageType = type ])
- 		new
- 	!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEfromIEEE32Bit: (in category 'method prototypes') -----
+ FloatclassPROTOTYPEfromIEEE32Bit: word
+ 	"Convert the given 32 bit word (which is supposed to be a positive 32-bit value) from
+ 	 a 32 bit IEEE floating point representation into an actual Squeak float object (being
+ 	 64 bits wide). Should only be used for conversion in FloatArrays or likewise objects."
+ 	| sign mantissa exponent delta |
+ 	word <= 0 ifTrue:
+ 		[^word negative
+ 			ifTrue: [self error: 'Cannot deal with negative numbers']
+ 			ifFalse: [self zero]].
+ 	sign := word bitAnd: 16r80000000.
+ 	word = sign ifTrue:
+ 		[^self negativeZero].
+ 	exponent := ((word bitShift: -23) bitAnd: 16rFF) - 127.
+ 	mantissa := word bitAnd:  16r7FFFFF.
+ 	exponent = 128 ifTrue: "Either NAN or INF"
+ 		[^mantissa = 0
+ 			ifTrue:
+ 				[sign = 0 
+ 					ifTrue: [self infinity]
+ 					ifFalse: [self negativeInfinity]]
+ 			ifFalse: [self nan]].
+ 	exponent = -127 ifTrue:
+ 		"gradual underflow (denormalized number)
+ 		 Remove first bit of mantissa and adjust exponent"
+ 		[delta := mantissa highBit.
+ 		 mantissa := (mantissa bitShift: 1) bitAnd: (1 bitShift: delta) - 1.
+ 		 exponent := exponent + delta - 23].
+ 	"Create new float"
+ 	^(self basicNew: 2)
+ 		basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3));
+ 		basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29);
+ 		* 1.0 "reduce to SmallFloat64 if possible"!

Item was removed:
- ----- Method: SpurBootstrapPrototypes>>allMethodPrototypes (in category 'accessing') -----
- allMethodPrototypes 
- 	^[self class allMethods "Pharo"
- 		select: [ :each | each category = 'method prototypes' ]]
- 		on: MessageNotUnderstood
- 		do: [:ex|
- 			ex message selector == #allMethods
- 				ifTrue:
- 					[self class selectors "Squeak"
- 						collect: [:s| self class >> s]
- 						thenSelect: [:m| m protocol = 'method prototypes']]
- 				ifFalse:
- 					[ex pass]]!

Item was added:
+ ----- Method: SpurBootstrapSqueakFamilyPrototypes class>>imageType (in category 'accessing') -----
+ imageType
+ 	^'squeak'!

Item was changed:
  ----- Method: SpurBootstrapSqueakPrototypes>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
  	"Smalltalk recreateSpecialObjectsArray"
  	"To external package developers:
  	If you are writing a plugin and need additional special object(s) for your own use, 
  	use addGCRoot() function and use own, separate special objects registry "
  	"The Special Objects Array is an array of objects used by the Squeak virtual machine.
  	 Its contents are critical and accesses to it by the VM are unchecked, so don't even
  	 think of playing here unless you know what you are doing."
  	| newArray |
  	newArray := Array new: 60.
  	"Nil false and true get used throughout the interpreter"
  	newArray at: 1 put: nil.
  	newArray at: 2 put: false.
  	newArray at: 3 put: true.
  	"This association holds the active process (a ProcessScheduler)"
  	newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
  	"Numerous classes below used for type checking and instantiation"
  	newArray at: 5 put: Bitmap.
  	newArray at: 6 put: SmallInteger.
  	newArray at: 7 put: ByteString.
  	newArray at: 8 put: Array.
  	newArray at: 9 put: Smalltalk.
+ 	newArray at: 10 put: BoxedFloat64.
- 	newArray at: 10 put: Float.
  	newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
  	newArray at: 12 put: nil. "was BlockContext."
  	newArray at: 13 put: Point.
  	newArray at: 14 put: LargePositiveInteger.
  	newArray at: 15 put: Display.
  	newArray at: 16 put: Message.
  	newArray at: 17 put: CompiledMethod.
  	newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
  	newArray at: 19 put: Semaphore.
  	newArray at: 20 put: Character.
  	newArray at: 21 put: #doesNotUnderstand:.
  	newArray at: 22 put: #cannotReturn:.
  	newArray at: 23 put: nil. "This is the process signalling low space."
  	"An array of the 32 selectors that are compiled as special bytecodes,
  	 paired alternately with the number of arguments each takes."
  	newArray at: 24 put: #(	#+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
  							#* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
  							#at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
  							#blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
  	"An array of the 255 Characters in ascii order.
  	 Cog inlines table into machine code at: prim so do not regenerate it.
  	 This is nil in Spur, which has immediate Characters."
  	newArray at: 25 put: (self specialObjectsArray at: 25).
  	newArray at: 26 put: #mustBeBoolean.
  	newArray at: 27 put: ByteArray.
  	newArray at: 28 put: Process.
  	"An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
  	newArray at: 29 put: self compactClassesArray.
  	newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
  	newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
  	"Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
  	newArray at: 32 put: nil. "was the prototype Float"
  	newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
  	newArray at: 34 put: nil. "was the prototype Point"
  	newArray at: 35 put: #cannotInterpret:.
  	newArray at: 36 put: nil. "was the prototype MethodContext"
  	newArray at: 37 put: BlockClosure.
  	newArray at: 38 put: nil. "was the prototype BlockContext"
  	"array of objects referred to by external code"
  	newArray at: 39 put: (self specialObjectsArray at: 39).	"external semaphores"
  	newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
  	newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
  	newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
  	newArray at: 43 put: LargeNegativeInteger.
  	"External objects for callout.
  	 Note: Written so that one can actually completely remove the FFI."
  	newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
  	newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
  	newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
  	newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
  	newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
  	newArray at: 49 put: #aboutToReturn:through:.
  	newArray at: 50 put: #run:with:in:.
  	"51 reserved for immutability message"
  	newArray at: 51 put: #attemptToAssign:withIndex:.
  	newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
  							#'bad argument' #'bad index'
  							#'bad number of arguments'
  							#'inappropriate operation'  #'unsupported operation'
  							#'no modification' #'insufficient object memory'
  							#'insufficient C memory' #'not found' #'bad method'
  							#'internal error in named primitive machinery'
  							#'object may move' #'resource limit exceeded'
  							#'object is pinned' #'primitive write beyond end of object').
  	"53 to 55 are for Alien"
  	newArray at: 53 put: (self at: #Alien ifAbsent: []).
  	newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
  	newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
  	"Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
  	newArray at: 56 put: nil.
  	"reserved for foreign callback process"
  	newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
  	newArray at: 58 put: #unusedBytecode.
  	"59 reserved for Sista counter tripped message"
  	newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
  	"60 reserved for Sista class trap message"
  	newArray at: 60 put: #classTrapFor:.
  	"Now replace the interpreter's reference in one atomic operation"
  	self specialObjectsArray becomeForward: newArray!

More information about the Vm-dev mailing list