[Vm-dev] VM Maker: Cog-eem.240.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Feb 13 23:24:54 UTC 2015
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.240.mcz
==================== Summary ====================
Name: Cog-eem.240
Author: eem
Time: 13 February 2015, 3:24:44.829 pm
UUID: bcf4a8fb-68ca-4c19-87cf-2f9903bd4b32
Ancestors: Cog-eem.239
Spur Bootstrap:
Adapt to VMMaker.oscog-eem.1048, using
runLeakCheckerForFullGC.
Nuke unused code.
Partial merge with Cog.pharo-EstebanLorenzano.242
=============== Diff against Cog-eem.239 ===============
Item was changed:
----- Method: Context>>ContextPROTOTYPEdoPrimitive:method:receiver:args: (in category '*Cog-method prototypes') -----
ContextPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: aReceiver args: arguments
"Simulate a primitive method whose index is primitiveIndex. The simulated receiver and
arguments are given as arguments to this message. If successful, push result and return
resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
execution needs to be intercepted and simulated to avoid execution running away."
| value |
"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
the debugger from entering various run-away activities such as spawning a new
process, etc. Injudicious use results in the debugger not being able to debug
interesting code, such as the debugger itself. hence use primitive 19 with care :-)"
"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
primitiveIndex = 19 ifTrue:
[ Smalltalk tools debugger
openContext: self
label:'Code simulation error'
contents: nil].
((primitiveIndex between: 201 and: 222)
+ and: [(self objectClass: aReceiver) includesBehavior: BlockClosure]) ifTrue:
- and: [aReceiver class includesBehavior: BlockClosure]) ifTrue:
[((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
[^aReceiver simulateValueWithArguments: arguments caller: self].
primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
[^aReceiver simulateValueWithArguments: arguments first caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
[^self send: arguments first to: aReceiver with: arguments allButFirst super: false].
primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
[^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (self objectClass: aReceiver)].
primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
[^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
"Mutex>>primitiveEnterCriticalSection
Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
[| active effective |
active := Processor activeProcess.
effective := active effectiveProcess.
"active == effective"
value := primitiveIndex = 186
ifTrue: [aReceiver primitiveEnterCriticalSectionOnBehalfOf: effective]
ifFalse: [aReceiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
^(self isPrimFailToken: value)
ifTrue: [value]
ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
[^Context
sender: self
receiver: aReceiver
method: (arguments at: 2)
arguments: (arguments at: 1)].
"Closure primitives"
(primitiveIndex = 200 and: [self == aReceiver]) ifTrue:
"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
[^self push: (BlockClosure
outerContext: aReceiver
startpc: pc + 2
numArgs: arguments first
copiedValues: arguments last)].
primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
[(arguments size = 2
and: [arguments first isInteger
and: [(self objectClass: arguments last) == Array]]) ifFalse:
[^Context primitiveFailTokenFor: nil].
^self doPrimitive: arguments first method: meth receiver: aReceiver args: arguments last].
value := primitiveIndex = 120 "FFI method"
ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
ifFalse:
[primitiveIndex = 117 "named primitives"
ifTrue: [self tryNamedPrimitiveIn: meth for: aReceiver withArgs: arguments]
ifFalse: [aReceiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value)
ifTrue: [value]
ifFalse: [self push: value]!
Item was changed:
----- Method: Spur32to64BitBootstrap>>writeSnapshot:headerFlags:screenSize: (in category 'snapshot') -----
writeSnapshot: imageFileName headerFlags: headerFlags screenSize: screenSizeInteger
heap64
checkFreeSpace;
+ runLeakCheckerForFullGC.
- runLeakCheckerForFullGC: true.
interpreter64
setImageHeaderFlagsFrom: headerFlags;
setDisplayForm: nil;
imageName: imageFileName;
writeImageFileIO.
Transcript cr; show: 'Done!!'!
Item was changed:
----- Method: SpurBootstrap>>launch:simulatorClass:headerFlags: (in category 'testing') -----
launch: heap simulatorClass: simulatorClass headerFlags: headerFlags
| sim methodCacheSize |
sim := simulatorClass onObjectMemory: heap.
heap coInterpreter: sim.
(sim class allInstVarNames includes: 'cogCodeSize')
ifTrue:
[sim initializeInterpreter: 0.
methodCacheSize := sim methodCache size * heap wordSize.
sim instVarNamed: 'heapBase' put: heap startOfMemory;
instVarNamed: 'numStackPages' put: 8;
instVarNamed: 'cogCodeSize' put: 1024*1024;
moveMethodCacheToMemoryAt: sim cogCodeSize + sim computeStackZoneSize;
movePrimTraceLogToMemoryAt: sim cogCodeSize + sim computeStackZoneSize + methodCacheSize;
"sendTrace: 1+ 2 + 8 + 16;"
initializeCodeGenerator]
ifFalse:
[sim initializeInterpreter: 0].
heap
initializeNewSpaceVariables;
bootstrapping: false;
assimilateNewSegment: (heap segmentManager segments at: 0).
sim
setImageHeaderFlagsFrom: headerFlags;
imageName: ImageName;
flushExternalPrimitives;
openAsMorph;
transcript: Transcript. "deep copy copies this"
"sim
instVarNamed: 'printSends' put: true;
instVarNamed: 'printReturns' put: true;
instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal." "for now"
heap
setCheckForLeaks: 0;
+ runLeakCheckerForFullGC.
- runLeakCheckerForFullGC: true.
sim halt; run!
Item was changed:
----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') -----
rehashImage
"Rehash all collections in newHeap.
Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags.
Enumerate all objects, rehashing those whose class has a bit set in rehashFlags."
| n sim rehashFlags dotDate rehashSym sizeSym |
rehashSym := map at: (self findSymbol: #rehash).
sizeSym := map at: (self findSymbol: #size).
+ sim := StackInterpreterSimulator
+ onObjectMemory: newHeap
+ options: #(ObjectMemory #Spur32BitMemoryManager).
- sim := StackInterpreterSimulator onObjectMemory: newHeap.
sim
setImageHeaderFlagsFrom: oldInterpreter getImageHeaderFlags;
imageName: 'spur image';
assertValidExecutionPointersAtEachStep: false..
newHeap coInterpreter: sim.
sim bootstrapping: true.
sim initializeInterpreter: 0.
sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal.
+
+ sim redirectTranscriptToHost.
newHeap
setHashBitsOf: newHeap nilObject to: 1;
setHashBitsOf: newHeap falseObject to: 2;
setHashBitsOf: newHeap trueObject to: 3.
rehashFlags := ByteArray new: newHeap numClassTablePages * newHeap classTablePageSize.
n := 0.
newHeap classTableObjectsDo:
[:class| | classIndex |
sim messageSelector: rehashSym.
"Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self."
((sim lookupMethodNoMNUEtcInClass: class) = 0
and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue:
[n := n + 1.
classIndex := newHeap rawHashBitsOf: class.
rehashFlags
at: classIndex >> 3 + 1
put: ((rehashFlags at: classIndex >> 3 + 1)
bitOr: (1 << (classIndex bitAnd: 7)))]].
Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush.
dotDate := Time now asSeconds.
n := 0.
self withExecutableInterpreter: sim
do: [sim setBreakSelector: 'error:'.
"don't rehash twice (actually without limit), so don't rehash any new objects created."
newHeap allExistingOldSpaceObjectsDo:
[:o| | classIndex |
classIndex := newHeap classIndexOf: o.
((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue:
[Time now asSeconds > dotDate ifTrue:
[Transcript nextPut: $.; flush.
dotDate := Time now asSeconds].
"2845 = n ifTrue: [self halt]."
"Rehash an object if its size is > 0.
Symbol implements rehash, but let's not waste time rehashing it; in Squeak
up to 2013 symbols are kept in a set which will get reashed anyway..
Don't rehash empty collections; they may be large for a reason and rehashing will shrink them."
((sim addressCouldBeClassObj: o)
or: [(self interpreter: sim
object: o
perform: sizeSym
withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse:
[self interpreter: sim
object: o
perform: rehashSym
withArguments: #()]]]]!
Item was changed:
----- Method: SpurBootstrap>>validate (in category 'bootstrap image') -----
validate
| p n duplicates maxClassIndex savedEndOfMemory |
self assert: (reverseMap at: newHeap specialObjectsOop) = oldHeap specialObjectsOop.
self assert: (map at: oldHeap specialObjectsOop) = newHeap specialObjectsOop.
self assert: (reverseMap at: newHeap classTableRootObj ifAbsent: []) isNil.
duplicates := { 3. newHeap arrayClassIndexPun. newHeap weakArrayClassIndexPun }.
maxClassIndex := classToIndex inject: 0 into: [:a :b| a max: b].
self assert: ((newHeap arrayClassIndexPun to: maxClassIndex) select:
[:idx| | classObj |
(classObj := newHeap classOrNilAtIndex: idx) ~= newHeap nilObject
and: [(newHeap classIndexOf: classObj) = (newHeap rawHashBitsOf: classObj)]]) isEmpty.
0 to: maxClassIndex do:
[:index| | classObj |
(index <= newHeap tagMask
and: [index > newHeap isForwardedObjectClassIndexPun]) ifTrue:
[(classObj := newHeap classOrNilAtIndex: index) = newHeap nilObject
ifTrue:
[self assert: (classToIndex keyAtValue: index ifAbsent: []) isNil]
ifFalse:
[self assert: (newHeap classIndexOf: classObj) ~= (newHeap rawHashBitsOf: classObj).
(duplicates includes: index) ifFalse:
[self assert: (newHeap rawHashBitsOf: classObj) = index]]]].
classToIndex keysAndValuesDo:
[:oldClass :idx|
self assert: (newHeap rawHashBitsOf: (map at: oldClass)) = idx.
self assert: oldClass = (reverseMap at: (newHeap classAtIndex: idx))].
n := 0.
savedEndOfMemory := newHeap endOfMemory.
newHeap setEndOfMemory: newHeap freeOldSpaceStart.
newHeap allObjectsDo:
[:o|
(o <= newHeap trueObject
or: [o > lastClassTablePage]) ifTrue:
[self assert: (reverseMap includesKey: o).
self assert: (newHeap fetchClassOfNonImm: o) = (map at: (oldHeap fetchClassOfNonImm: (reverseMap at: o)))].
n := n + 1.
p := o].
newHeap setEndOfMemory: savedEndOfMemory.
self touch: p.
self assert: (n between: map size and: map size + ((imageTypes includes: 'squeak')
ifTrue: [6]
+ ifFalse: [10])). "+ 6 or 10 is room for freelists & classTable"
- ifFalse: [8])). "+ 6 or 8 is room for freelists & classTable"
"check some class properties to ensure the format changes are correct"
self assert: (newHeap fixedFieldsOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = 0.
self assert: (newHeap instSpecOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = newHeap arrayFormat!
Item was changed:
----- Method: SpurBootstrap>>writeSnapshot:ofTransformedImage:headerFlags:screenSize: (in category 'testing') -----
writeSnapshot: imageFileName ofTransformedImage: spurHeap headerFlags: headerFlags screenSize: screenSizeInteger
"The bootstrapped image typically contains a few big free chunks and one huge free chunk.
Test snapshot writing and loading by turning the largest non-huge chunks into segment bridges
and saving."
| penultimate ultimate sizes counts barriers sim |
sim := StackInterpreterSimulator onObjectMemory: spurHeap.
sim bootstrapping: true.
spurHeap
coInterpreter: sim;
setEndOfMemory: spurHeap endOfMemory + spurHeap bridgeSize. "hack; initializeInterpreter: cuts it back by bridgeSize"
sim initializeInterpreter: 0;
setImageHeaderFlagsFrom: headerFlags;
setDisplayForm: nil.
spurHeap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
(spurHeap isFreeObject: penultimate) ifTrue: "old, pre-pigCompact segmented save"
[self assert: (spurHeap isSegmentBridge: ultimate).
sizes := Bag new.
spurHeap allObjectsInFreeTree: (spurHeap freeLists at: 0) do:
[:f|
sizes add: (spurHeap bytesInObject: f)].
counts := sizes sortedCounts.
self assert: counts last key = 1. "1 huge chunk"
counts size > 1
ifTrue:
[self assert: ((counts at: counts size - 1) key > 2
and: [(counts at: counts size - 1) value > 1024]).
barriers := (1 to: (counts at: counts size - 1) key) collect:
[:ign| spurHeap allocateOldSpaceChunkOfExactlyBytes: (counts at: counts size - 1) value].
barriers := barriers, {spurHeap allocateOldSpaceChunkOfExactlyBytes: (spurHeap bytesInObject: penultimate)}]
ifFalse:
[barriers := {spurHeap allocateOldSpaceChunkOfExactlyBytes: (spurHeap bytesInObject: penultimate)}].
barriers last ifNotNil:
[:end|
spurHeap setEndOfMemory: end.
spurHeap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
self assert: (spurHeap addressAfter: ultimate) = end]].
spurHeap checkFreeSpace.
+ spurHeap runLeakCheckerForFullGC.
- spurHeap runLeakCheckerForFullGC: true.
barriers ifNotNil: "old, pre-pigCompact segmented save"
[spurHeap segmentManager initializeFromFreeChunks: (barriers sort collect: [:b| spurHeap objectStartingAt: b])].
spurHeap checkFreeSpace.
+ spurHeap runLeakCheckerForFullGC.
- spurHeap runLeakCheckerForFullGC: true.
sim bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: true.
sim imageName: imageFileName.
sim writeImageFileIO.
Transcript cr; show: 'Done!!'!
Item was removed:
- ----- Method: SpurBootstrap>>writeSnapshotOfTransformedImage (in category 'testing') -----
- writeSnapshotOfTransformedImage
- self writeSnapshotOfTransformedImageAs: 'spur.image'!
Item was removed:
- ----- Method: SpurBootstrap>>writeSnapshotOfTransformedImageAs: (in category 'testing') -----
- writeSnapshotOfTransformedImageAs: imageFileName
- "The bootstrapped image typically contains a few big free chunks and one huge free chunk.
- Test snapshot writing and loading by turning the largest non-huge chunks into segment bridges
- and saving."
- | penultimate ultimate heap sizes counts barriers sim |
- heap := TransformedImage veryDeepCopy.
- sim := StackInterpreterSimulator onObjectMemory: heap.
- sim bootstrapping: true.
- heap coInterpreter: sim.
- sim initializeInterpreter: 0;
- setImageHeaderFlagsFrom: ImageHeaderFlags;
- setDisplayForm: nil;
- setSavedWindowSize: ImageScreenSize >> 16 @ (ImageScreenSize bitAnd: 16rFFFF).
- heap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
- self assert: (heap isFreeObject: penultimate).
- self assert: (heap isSegmentBridge: ultimate).
- sizes := Bag new.
- heap allObjectsInFreeTree: (heap freeLists at: 0) do:
- [:f|
- sizes add: (heap bytesInObject: f)].
- counts := sizes sortedCounts.
- self assert: counts last key = 1. "1 huge chunk"
- counts size > 1
- ifTrue:
- [self assert: ((counts at: counts size - 1) key > 2
- and: [(counts at: counts size - 1) value > 1024]).
- barriers := (1 to: (counts at: counts size - 1) key) collect:
- [:ign| heap allocateOldSpaceChunkOfExactlyBytes: (counts at: counts size - 1) value].
- barriers := barriers, {heap allocateOldSpaceChunkOfExactlyBytes: (heap bytesInObject: penultimate)}]
- ifFalse:
- [barriers := {heap allocateOldSpaceChunkOfExactlyBytes: (heap bytesInObject: penultimate)}].
- heap setEndOfMemory: barriers last.
- heap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
- self assert: (heap addressAfter: ultimate) = barriers last.
- heap checkFreeSpace.
- heap runLeakCheckerForFullGC: true.
- heap segmentManager initializeFromFreeChunks: (barriers sort collect: [:b| heap objectStartingAt: b]).
- heap checkFreeSpace.
- heap runLeakCheckerForFullGC: true.
- sim bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: true.
- sim imageName: imageFileName.
- sim writeImageFileIO!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>VirtualMachinePROTOTYPEisSpur (in category 'method prototypes') -----
+ VirtualMachinePROTOTYPEisSpur
+ "this value is always true but is here for backward compatibility (non Spur images should return false)"
+ ^ true!
More information about the Vm-dev
mailing list