[Vm-dev] VM Maker: VMMaker.oscog-eem.510.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Nov 13 21:58:34 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.510.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.510
Author: eem
Time: 13 November 2013, 1:55:19.338 pm
UUID: 70117c0d-28a7-4703-a044-cab26cfffe83
Ancestors: VMMaker.oscog-eem.509
Reduce C compilation warnings for the Spur Stack VM.
Fix bug in SpurMemMgr>>countMarkedAndUnmarkdObjects:.
=============== Diff against VMMaker.oscog-eem.509 ===============
Item was changed:
----- Method: CoInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
followForwardingPointersInStackZone: theBecomeEffectsFlags
"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
The read-barrier is minimised by arranging that forwarding pointers will fail a method cache probe,
since notionally objects' internals are accessed only via sending messages to them (the exception
is primitives that access the internals of the non-receiver argument(s).
To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and methods
in the stack zone and follow any forwarded ones. This is of course way cheaper than scanning all
of memory as in the old become."
| theIPPtr |
<inline: false>
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
+ <var: #theIPPtr type: #usqInt>
- <var: #theIPPtr type: #'char *'>
(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
[(objectMemory isForwarded: method) ifTrue:
[theIPPtr := instructionPointer - method.
method := objectMemory followForwarded: method.
instructionPointer := method + theIPPtr].
(objectMemory isForwarded: newMethod) ifTrue:
[newMethod := objectMemory followForwarded: newMethod]].
self assert: stackPage ~= 0.
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP callerFP oop offset |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage
ifTrue: [theIPPtr := 0]
ifFalse:
+ [theIPPtr := theSP asUnsignedInteger.
- [theIPPtr := theSP.
theSP := theSP + BytesPerWord].
[self assert: (thePage addressIsInPage: theFP).
+ self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
- self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
offset := theFP + (self frameStackedReceiverOffset: theFP).
oop := stackPages longAt: offset.
((objectMemory isNonImmediate: oop)
and: [(objectMemory isForwarded: oop)]) ifTrue:
[stackPages
longAt: offset
put: (objectMemory followForwarded: oop)].
((self frameHasContext: theFP)
and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
[stackPages
longAt: theFP + FoxThisContext
put: (objectMemory followForwarded: (self frameContext: theFP))].
(self isMachineCodeFrame: theFP)
ifTrue:
[oop := stackPages longAt: theFP + FoxIFReceiver.
((objectMemory isNonImmediate: oop)
and: [(objectMemory isForwarded: oop)]) ifTrue:
[stackPages
longAt: theFP + FoxIFReceiver
put: (objectMemory followForwarded: oop)].
self assert: (objectMemory isForwarded: (self frameMethodObject: theFP)) not]
ifFalse:
[oop := stackPages longAt: theFP + FoxIFReceiver.
((objectMemory isNonImmediate: oop)
and: [(objectMemory isForwarded: oop)]) ifTrue:
[stackPages
longAt: theFP + FoxIFReceiver
put: (objectMemory followForwarded: oop)].
oop := self frameMethod: theFP.
(objectMemory isForwarded: oop) ifTrue:
[| delta |
delta := (objectMemory followForwarded: oop) - oop.
(theIPPtr ~= 0
and: [(stackPages longAt: theIPPtr) > (self frameMethod: theFP)]) ifTrue:
[stackPages
longAt: theIPPtr
put: (stackPages longAt: theIPPtr) + delta].
stackPages
longAt: theFP + FoxIFSavedIP
put: (stackPages longAt: theFP + FoxIFSavedIP) + delta.
stackPages
longAt: theFP + FoxMethod
put: (objectMemory followForwarded: oop)]].
self followNecessaryForwardingInMethod: (self frameMethod: theFP).
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ [theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
- [theIPPtr := theFP + FoxCallerSavedIP.
theFP := callerFP]]]!
Item was changed:
----- Method: ObjectMemory>>readHeapFromImageFile:dataBytes: (in category 'image save/restore') -----
readHeapFromImageFile: f dataBytes: numBytes
"Read numBytes of image data from f into memory at memoryBaseForImageRead.
Answer the number of bytes written."
+ <var: #f type: #sqImageFile>
^self cCode:
[self
sq: (self pointerForOop: self memoryBaseForImageRead)
Image: (self sizeof: #char)
File: numBytes
Read: f]
inSmalltalk:
[(f readInto: memory
startingAt: self memoryBaseForImageRead // 4 + 1
count: numBytes // 4)
* 4]!
Item was changed:
----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceLimit pastSpaceStart
lowSpaceThreshold freeOldSpaceStart startOfMemory endOfMemory sortedFreeChunks)
in: aCCodeGenerator.
self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs'])
in: aCCodeGenerator.
aCCodeGenerator
var: #freeListsMask type: #usqInt;
var: #freeLists type: #'sqInt *';
var: #classTableBitmap type: #'unsigned char *';
+ var: #objStackInvalidBecause type: #'char *';
var: #highestObjects type: #SpurCircularBuffer;
var: #unscannedEphemerons type: #SpurContiguousObjStack.
aCCodeGenerator
var: #remapBuffer
declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
aCCodeGenerator
var: #extraRoots
+ declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'!
- declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.!
Item was changed:
----- Method: SpurMemoryManager>>countMarkedAndUnmarkdObjects: (in category 'debug support') -----
countMarkedAndUnmarkdObjects: printFlags
"print the count of marked and unmarked objects.
In addition if 1 is set in printFlags, short-print marked objects,
and/or if 2 is set, short-print unmarked obejcts."
<api>
| nm nu |
nm := nu := 0.
self allObjectsDo:
[:o|
(self isMarked: o)
ifTrue:
[nm := nm + 1.
(printFlags anyMask: 1) ifTrue:
[coInterpreter shortPrintOop: o]]
ifFalse:
[nu := nu + 1.
(printFlags anyMask: 2) ifTrue:
[coInterpreter shortPrintOop: o]]].
+ self print: 'n marked: '; printNum: nm; cr.
+ self print: 'n unmarked: '; printNum: nu; cr!
- self print: 'n marked: '; print: nm; cr.
- self print: 'n unmarked: '; print: nu; cr!
Item was changed:
----- Method: SpurMemoryManager>>isValidObjStackPage:myIndex: (in category 'obj stacks') -----
isValidObjStackPage: objStackPage myIndex: myx
"Just check the page itself."
<inline: false>
(self classIndexOf: objStackPage) = self wordSizeClassIndexPun ifFalse:
+ [objStackInvalidBecause := 'wrong class index'.
- [objStackInvalidBecause := 'wong class index'.
invalidObjStackPage := objStackPage.
^false].
(self formatOf: objStackPage) = self wordIndexableFormat ifFalse:
+ [objStackInvalidBecause := 'wrong format'.
- [objStackInvalidBecause := 'wong format'.
invalidObjStackPage := objStackPage.
^false].
(self numSlotsOfAny: objStackPage) = ObjStackPageSlots ifFalse:
+ [objStackInvalidBecause := 'wrong num slots'.
- [objStackInvalidBecause := 'wong num slots'.
invalidObjStackPage := objStackPage.
^false].
myx = (self fetchPointer: ObjStackMyx ofObject: objStackPage) ifFalse:
+ [objStackInvalidBecause := 'wrong myx'.
- [objStackInvalidBecause := 'wong myx'.
invalidObjStackPage := objStackPage.
^false].
(marking and: [(self isMarked: objStackPage) not]) ifTrue:
[objStackInvalidBecause := 'marking but page is unmarked'.
invalidObjStackPage := objStackPage.
^false].
^true!
Item was changed:
----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') -----
addSegmentOfSize: ammount
<returnTypeC: #'SpurSegmentInfo *'>
<inline: false>
| allocatedSize |
<var: #newSeg type: #'SpurSegmentInfo *'>
<var: #segAddress type: #'void *'>
self cCode: [] inSmalltalk: [segments ifNil: [^nil]]. "bootstrap"
(manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
sqAllocateMemorySegmentOfSize: ammount
Above: (segments at: 0) segLimit asVoidPointer
AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
[:segAddress| | newSegIndex newSeg |
newSegIndex := self insertSegmentFor: segAddress asUnsignedLong.
newSeg := self addressOf: (segments at: newSegIndex).
newSeg
+ segStart: segAddress asUnsignedLong;
- segStart: segAddress;
segSize: allocatedSize.
self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg.
self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse:
[self addressOf: (segments at: newSegIndex + 1)]).
"and add the new free chunk to the free list; done here
instead of in assimilateNewSegment: for the assert"
manager addFreeChunkWithBytes: allocatedSize - manager bridgeSize at: newSeg segStart.
self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart))
= (newSeg segLimit - manager bridgeSize).
+ "test isInMemory:"
+ 0 to: numSegments - 1 do:
+ [:i|
+ self assert: (manager isInMemory: (segments at: i) segStart).
+ self assert: (manager isInMemory: (segments at: i) segLimit - manager wordSize).
+ self assert: (manager isInMemory: (segments at: i) segLimit) not.
+ (i between: 1 and: numSegments - 2) ifTrue:
+ [self assert: (manager isInMemory: (segments at: i) segStart - manager wordSize) not]].
^newSeg].
^nil!
Item was changed:
----- Method: SpurSegmentManager>>readHeapFromImageFile:dataBytes: (in category 'snapshot') -----
readHeapFromImageFile: f dataBytes: numBytes
"Read numBytes of image data from f into memory at memoryBaseForImageRead.
Answer the number of bytes written. In addition, read each segment, build up the
segment info, while eliminating the bridge objects that end each segment and
give the size of the subsequent segment."
+ <var: #f type: #sqImageFile>
<inline: false>
| bytesRead totalBytesRead bridge nextSegmentSize oldBase newBase segInfo bridgeSpan |
<var: 'segInfo' type: 'SpurSegmentInfo *'>
self allocateOrExtendSegmentInfos.
"segment sizes include the two-header-word bridge at the end of each segment."
numSegments := totalBytesRead := 0.
oldBase := 0. "N.B. still must be adjusted by oldBaseAddr."
newBase := manager newSpaceLimit.
nextSegmentSize := firstSegmentSize.
bridge := firstSegmentSize + manager newSpaceLimit - manager baseHeaderSize.
[segInfo := self addressOf: (segments at: numSegments).
segInfo
segStart: oldBase; "N.B. still must be adjusted by oldBaseAddr."
segSize: nextSegmentSize;
swizzle: newBase - oldBase. "N.B. still must be adjusted by oldBaseAddr."
bytesRead := self readHeapFrom: f at: newBase dataBytes: nextSegmentSize.
bytesRead > 0 ifTrue:
[totalBytesRead := totalBytesRead + bytesRead].
bytesRead ~= nextSegmentSize ifTrue:
[^totalBytesRead].
numSegments := numSegments + 1.
bridgeSpan := manager bytesPerSlot * (manager rawOverflowSlotsOf: bridge).
oldBase := oldBase + nextSegmentSize + bridgeSpan.
newBase := newBase + nextSegmentSize - manager bridgeSize.
nextSegmentSize := manager longLongAt: bridge.
nextSegmentSize ~= 0] whileTrue:
[bridge := bridge - manager bridgeSize + nextSegmentSize].
"newBase should point just past the last bridge. all others should have been eliminated."
self assert: newBase - manager newSpaceLimit
= (totalBytesRead - (numSegments * manager bridgeSize)).
"set freeOldSpaceStart now for adjustAllOopsBy:"
manager setFreeOldSpaceStart: newBase.
^totalBytesRead!
Item was changed:
----- Method: SpurSegmentManager>>writeSegment:nextSegmentSize:toFile: (in category 'snapshot') -----
writeSegment: aSpurSegmentInfo nextSegmentSize: nextSegSize toFile: aBinaryStream
<var: 'aSpurSegmentInfo' type: #'SpurSegmentInfo *'>
<var: 'aBinaryStream' type: #'FILE *'>
| bridge savedHeader nWritten |
<var: 'savedHeader' type: #usqLong>
bridge := aSpurSegmentInfo segLimit - manager baseHeaderSize.
"last seg may be beyond endOfMemory/freeOldSpaceStart"
self assert: ((manager isValidSegmentBridge: bridge) or: [nextSegSize = 0]).
savedHeader := manager longLongAt: bridge.
manager longLongAt: bridge put: nextSegSize.
nWritten := self cCode:
[self
+ sq: aSpurSegmentInfo segStart asVoidPointer
- sq: aSpurSegmentInfo segStart
Image: 1
File: aSpurSegmentInfo segSize
Write: aBinaryStream]
inSmalltalk:
[aBinaryStream
next: aSpurSegmentInfo segSize / 4
putAll: manager memory
startingAt: aSpurSegmentInfo segStart / 4 + 1.
aSpurSegmentInfo segSize].
manager longLongAt: bridge put: savedHeader.
^nWritten!
Item was changed:
----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
followForwardingPointersInStackZone: theBecomeEffectsFlags
"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
The read-barrier is minimised by arranging that forwarding pointers will fail a method cache probe,
since notionally objects' internals are accessed only via sending messages to them (the exception
is primitives that access the internals of the non-receiver argument(s).
To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and methods
in the stack zone and follow any forwarded ones. This is of course way cheaper than scanning all
of memory as in the old become."
| theIPPtr |
<inline: false>
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
+ <var: #theIPPtr type: #usqInt>
- <var: #theIPPtr type: #'char *'>
(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
[(objectMemory isForwarded: method) ifTrue:
[theIPPtr := instructionPointer - method.
method := objectMemory followForwarded: method.
instructionPointer := method + theIPPtr].
(objectMemory isForwarded: newMethod) ifTrue:
[newMethod := objectMemory followForwarded: newMethod]].
self assert: stackPage ~= 0.
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP callerFP theIP oop |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage
ifTrue: [theIPPtr := 0]
ifFalse:
+ [theIPPtr := theSP asUnsignedInteger.
- [theIPPtr := theSP.
theSP := theSP + BytesPerWord].
[self assert: (thePage addressIsInPage: theFP).
+ self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
- self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
oop := stackPages longAt: theFP + FoxReceiver.
((objectMemory isNonImmediate: oop)
and: [(objectMemory isForwarded: oop)]) ifTrue:
[stackPages
longAt: theFP + FoxReceiver
put: (objectMemory followForwarded: oop)].
+ theIP := (theFP + (self frameStackedReceiverOffset: theFP)) asUnsignedInteger. "reuse theIP; its just an offset here"
- theIP := theFP + (self frameStackedReceiverOffset: theFP). "reuse theIP; its just an offset here"
oop := stackPages longAt: theIP.
((objectMemory isNonImmediate: oop)
and: [(objectMemory isForwarded: oop)]) ifTrue:
[stackPages
longAt: theIP
put: (objectMemory followForwarded: oop)].
((self frameHasContext: theFP)
and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
[stackPages
longAt: theFP + FoxThisContext
put: (objectMemory followForwarded: (self frameContext: theFP))].
oop := self frameMethod: theFP.
(objectMemory isForwarded: oop) ifTrue:
[| delta |
theIPPtr ~= 0 ifTrue:
[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
delta := (objectMemory followForwarded: oop) - oop.
stackPages
longAt: theIPPtr
put: (stackPages longAt: theIPPtr) + delta].
stackPages
longAt: theFP + FoxMethod
put: (objectMemory followForwarded: oop)].
self followNecessaryForwardingInMethod: (self frameMethod: theFP).
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ [theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
- [theIPPtr := theFP + FoxCallerSavedIP.
theFP := callerFP]]]!
Item was changed:
----- Method: StackInterpreter>>printFrameThing:andFrame:at: (in category 'debug printing') -----
printFrameThing: name andFrame: theFP at: address
<var: #theFP type: #'char *'>
| it len |
<inline: false>
<var: #name type: #'char *'>
<var: #address type: #'char *'>
it := stackPages longAt: address.
self printHexPtr: address;
printChar: $:.
len := self strlen: name.
1 to: 12 - len do: [:i| self space].
self print: name;
print: ': ';
printHex: it.
it ~= 0 ifTrue:
[self printChar: $=.
it = objectMemory nilObject
ifTrue: [self print: 'nil']
ifFalse:
[self printNum: it]].
+ self print: ' frame: '; printHexPtr: theFP; cr!
- self print: ' frame: '; printHex: theFP; cr!
Item was changed:
----- Method: StackInterpreter>>printStackCallStack (in category 'debug printing') -----
printStackCallStack
<doNotGenerate>
+ self printStackCallStackOf: localFP!
- | theFP context |
- theFP := localFP.
- [context := self shortReversePrintFrameAndCallers: theFP.
- ((self isMarriedOrWidowedContext: context)
- and: [self checkIsStillMarriedContext: context currentFP: localFP]) ifFalse:
- [^nil].
- theFP := self frameOfMarriedContext: context] repeat!
Item was added:
+ ----- Method: StackInterpreter>>printStackCallStackOf: (in category 'debug printing') -----
+ printStackCallStackOf: aFramePointer
+ <var: #aFramePointer type: #'char *'>
+ <api>
+ | theFP context |
+ <var: #theFP type: #'char *'>
+ theFP := aFramePointer.
+ [context := self shortReversePrintFrameAndCallers: theFP.
+ ((self isMarriedOrWidowedContext: context)
+ and:
+ [theFP := self frameOfMarriedContext: context.
+ self checkIsStillMarriedContext: context currentFP: theFP]) ifFalse:
+ [^nil]] repeat!
Item was changed:
----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') -----
shortPrintOop: oop
<inline: false>
self printHexnp: oop.
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[^self
+ cCode: 'printf("=$%ld ($%lc)\n", (long)characterValueOf(oop), (wint_t)characterValueOf(oop))'
- cCode: 'printf("=$%ld ($%c)\n", (long)characterValueOf(oop), (long)characterValueOf(oop))'
inSmalltalk: [self print: (self shortPrint: oop); cr]].
^self
cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
inSmalltalk: [self print: (self shortPrint: oop); cr]].
(objectMemory addressCouldBeObj: oop) ifFalse:
[self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [' is not on the heap']); cr.
^nil].
((objectMemory isFreeObject: oop)
or: [objectMemory isForwarded: oop]) ifTrue:
[^self printOop: oop].
self print: ': a(n) '.
self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5.
self cr!
More information about the Vm-dev
mailing list