[Vm-dev] VM Maker: VMMaker.oscog-eem.2056.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Dec 29 16:54:40 UTC 2016
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2056.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2056
Author: eem
Time: 29 December 2016, 8:54:25.129752 am
UUID: 36772c61-cd8d-48cf-addb-26a0ba374f3a
Ancestors: VMMaker.oscog-eem.2055
Simulator:
Fix firstIndexableField: in the Spur MM sims.
Have plugins be closed whenever the VM is closed. Properly implement close to send close to any plugin that wants it.
=============== Diff against VMMaker.oscog-eem.2055 ===============
Item was changed:
----- Method: CogVMSimulator>>close (in category 'initialization') -----
+ close "close any files that ST may have opened, etc"
+ pluginList do: [:plugin| (plugin ~~ self and: [plugin respondsTo: #close]) ifTrue: [plugin close]]!
- close "close any files that ST may have opened"
- (self loadNewPlugin: 'FilePlugin') ifNotNil:
- [:filePlugin| filePlugin close]!
Item was changed:
----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the CogVMSimulator when running the interpreter inside Smalltalk. The
primary responsibility of this method is to allocate Smalltalk Arrays for variables
that will be declared as statically-allocated global arrays in the translated code."
super initialize.
transcript := Transcript.
objectMemory ifNil:
[objectMemory := self class objectMemoryClass simulatorClass new].
cogit ifNil:
[cogit := self class cogitClass new setInterpreter: self].
objectMemory coInterpreter: self cogit: cogit.
cogit numRegArgs > 0 ifTrue:
[debugStackDepthDictionary := Dictionary new].
cogThreadManager ifNotNil:
[super initialize].
self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
enableCog := true.
methodCache := Array new: MethodCacheSize.
nsMethodCache := Array new: NSMethodCacheSize.
atCache := nil.
self flushMethodCache.
cogCompiledCodeCompactionCalledFor := false.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
mappedPluginEntries := OrderedCollection new.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[primitiveAccessorDepthTable := Array new: primitiveTable size.
pluginList := {}.
self loadNewPlugin: '']
ifFalse:
[pluginList := {'' -> self }].
desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
"This is initialized on loading the image, but convenient for testing stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := self ioUTCStartMicroseconds.
maxLiteralCountForCompile := MaxLiteralCountForCompile.
minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
flagInterpretedMethods := false.
"initialize InterpreterSimulator variables used for debugging"
byteCount := lastPollCount := sendCount := lookupCount := 0.
+ quitBlock := [^self close].
- quitBlock := [^ self].
traceOn := true.
printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
eventQueue := SharedQueue new.
suppressHeartbeatFlag := deferSmash := deferredSmash := false.
systemAttributes := Dictionary new.
primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
primTraceLogIndex := 0.
traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
traceLogIndex := 0.
traceSources := TraceSources.
statCodeCompactionCount := 0.
statCodeCompactionUsecs := 0.
extSemTabSize := 256!
Item was changed:
----- Method: CogVMSimulator>>logOfBytesVerify:fromFileNamed:fromStart: (in category 'testing') -----
logOfBytesVerify: nBytes fromFileNamed: fileName fromStart: loggingStart
"Verify a questionable interpreter against a successful run"
"self logOfBytesVerify: 10000 fromFileNamed: 'clone32Bytecodes.log' "
| logFile rightWord prevCtxt |
logFile := (FileStream readOnlyFileNamed: fileName) binary.
transcript clear.
byteCount := 0.
+ quitBlock := [^self close].
- quitBlock := [^ self].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
prevCtxt := 0. prevCtxt := prevCtxt.
[byteCount < nBytes] whileTrue:
[
"
byteCount > 14560 ifTrue:
[self externalizeIPandSP.
prevCtxt = activeContext ifFalse:
[prevCtxt := activeContext.
transcript cr; nextPutAll: (self printTop: 2); endEntry].
transcript cr; print: byteCount; nextPutAll: ': ' , (activeContext hex); space;
print: (instructionPointer - method - (BaseHeaderSize - 2));
nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space;
nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space;
print: (self stackPointerIndex - TempFrameStart + 1); endEntry.
byteCount = 14590 ifTrue: [self halt]].
"
loggingStart >= byteCount ifTrue:
[rightWord := logFile nextWord.
currentBytecode = rightWord ifFalse:
[self halt: 'halt at ', byteCount printString]].
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
self externalizeIPandSP.
logFile close.
self inform: nBytes printString , ' bytecodes verfied.'!
Item was changed:
----- Method: CogVMSimulator>>logOfBytesWrite:toFileNamed:fromStart: (in category 'testing') -----
logOfBytesWrite: nBytes toFileNamed: fileName fromStart: loggingStart
"Write a log file for testing a flaky interpreter on the same image"
"self logOfBytesWrite: 10000 toFileNamed: 'clone32Bytecodes.log' "
| logFile |
logFile := (FileStream newFileNamed: fileName) binary.
transcript clear.
byteCount := 0.
+ quitBlock := [^self close].
- quitBlock := [^ self].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[byteCount < nBytes] whileTrue:
[byteCount >= loggingStart ifTrue:
[logFile nextWordPut: currentBytecode].
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
self externalizeIPandSP.
logFile close!
Item was changed:
----- Method: CogVMSimulator>>logOfSendsVerify:fromFileNamed:fromStart: (in category 'testing') -----
logOfSendsVerify: nSends fromFileNamed: fileName fromStart: loggingStart
"Write a log file for testing a flaky interpreter on the same image"
"self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' "
| logFile priorFrame rightSelector prevCtxt |
logFile := FileStream readOnlyFileNamed: fileName.
transcript clear.
byteCount := 0.
sendCount := 0.
priorFrame := localFP.
+ quitBlock := [^self close].
- quitBlock := [^ self].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
prevCtxt := 0. prevCtxt := prevCtxt.
[sendCount < nSends] whileTrue:
[
"
byteCount>500 ifTrue:
[byteCount>550 ifTrue: [self halt].
self externalizeIPandSP.
prevCtxt = localFP ifFalse:
[prevCtxt := localFP.
transcript cr; nextPutAll: (self printTop: 2); endEntry].
transcript cr; print: byteCount; nextPutAll: ': ' , (localFP hex); space;
print: (instructionPointer - method - (BaseHeaderSize - 2));
nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space;
nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space;
print: (self stackPointerIndex - TempFrameStart + 1); endEntry.
].
"
self dispatchOn: currentBytecode in: BytecodeTable.
localFP = priorFrame ifFalse:
[sendCount := sendCount + 1.
loggingStart >= sendCount ifTrue:
[rightSelector := logFile nextLine.
(self stringOf: messageSelector) = rightSelector ifFalse:
[self halt: 'halt at ', sendCount printString]].
priorFrame := localFP].
self incrementByteCount].
self externalizeIPandSP.
logFile close.
self inform: nSends printString , ' sends verfied.'!
Item was changed:
----- Method: CogVMSimulator>>logOfSendsWrite:toFileNamed:fromStart: (in category 'testing') -----
logOfSendsWrite: nSends toFileNamed: fileName fromStart: loggingStart
"Write a log file for testing a flaky interpreter on the same image"
"self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' fromStart: 2500"
| logFile priorFrame |
logFile := FileStream newFileNamed: fileName.
transcript clear.
byteCount := 0.
sendCount := 0.
priorFrame := localFP.
+ quitBlock := [^self close].
- quitBlock := [^ self].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[sendCount < nSends] whileTrue:
[self dispatchOn: currentBytecode in: BytecodeTable.
localFP == priorFrame ifFalse:
[sendCount >= loggingStart ifTrue:
[sendCount := sendCount + 1.
logFile nextPutAll: (self stringOf: messageSelector); cr].
priorFrame := localFP].
self incrementByteCount].
self externalizeIPandSP.
logFile close!
Item was changed:
----- Method: CogVMSimulator>>run (in category 'testing') -----
run
"Just run"
quitBlock := [displayView ifNotNil:
[displayView containingWindow ifNotNil:
[:topWindow|
((World submorphs includes: topWindow)
and: [UIManager default confirm: 'close?']) ifTrue:
[topWindow delete]]].
+ ^self close].
- ^self].
self initStackPages.
self loadInitialContext.
self initialEnterSmalltalkExecutive!
Item was changed:
----- Method: CogVMSimulator>>runWithBreakCount: (in category 'testing') -----
runWithBreakCount: theBreakCount
"Just run, halting when byteCount is reached"
quitBlock := [displayView ifNotNil:
[displayView containingWindow ifNotNil:
[:topWindow|
((World submorphs includes: topWindow)
and: [UIManager default confirm: 'close?']) ifTrue:
[topWindow delete]]].
+ ^self close].
- ^self].
breakCount := theBreakCount.
self initStackPages.
self loadInitialContext.
self initialEnterSmalltalkExecutive!
Item was changed:
----- Method: CogVMSimulator>>testBreakCount:printSends:printFrames:printBytecodes: (in category 'testing') -----
testBreakCount: breakCount printSends: shouldPrintSends printFrames: shouldPrintFrames printBytecodes: shouldPrintBytecodes
self initStackPages.
self loadInitialContext.
transcript clear.
+ quitBlock := [^self close].
- quitBlock := [^self].
printSends := true & shouldPrintSends. "true & foo allows evaluating printFoo := true in the debugger"
printFrameAtEachStep := true & shouldPrintFrames.
printBytecodeAtEachStep := true & shouldPrintBytecodes.
self ensureDebugAtEachStepBlock.
self initialEnterSmalltalkExecutive!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
to: #'oop *'].
+ ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
- ^self cCoerce: (self pointerForOop: objOop
- + self baseHeaderSize
- + ((self numSlotsOf: objOop) << self shiftForWord))
to: #'oop *'].
"All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
Item was changed:
----- Method: Spur32BitMMLESimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
to: #'oop *'].
+ ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
- ^self cCoerce: (self pointerForOop: objOop
- + self baseHeaderSize
- + ((self numSlotsOf: objOop) << self shiftForWord))
to: #'oop *'].
"All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
Item was changed:
----- Method: Spur64BitMMLECoSimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
to: #'oop *'].
+ ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
- ^self cCoerce: (self pointerForOop: objOop
- + self baseHeaderSize
- + ((self numSlotsOf: objOop) << self shiftForWord))
to: #'oop *'].
"All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
Item was changed:
----- Method: Spur64BitMMLESimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
to: #'oop *'].
+ ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
- ^self cCoerce: (self pointerForOop: objOop
- + self baseHeaderSize
- + ((self numSlotsOf: objOop) << self shiftForWord))
to: #'oop *'].
"All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
Item was changed:
----- Method: StackInterpreterSimulator>>close (in category 'initialization') -----
+ close "close any files that ST may have opened, etc"
+ pluginList do: [:plugin| (plugin ~~ self and: [plugin respondsTo: #close]) ifTrue: [plugin close]]!
- close "close any files that ST may have opened"
- (self loadNewPlugin: 'FilePlugin') ifNotNil:
- [:filePlugin| filePlugin close]!
Item was changed:
----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the StackInterpreterSimulator when running the interpreter
inside Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
super initialize.
bootstrapping := false.
transcript := Transcript.
objectMemory ifNil:
[objectMemory := self class objectMemoryClass simulatorClass new].
objectMemory coInterpreter: self.
self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
methodCache := Array new: MethodCacheSize.
nsMethodCache := Array new: NSMethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
mappedPluginEntries := OrderedCollection new.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[primitiveAccessorDepthTable := Array new: primitiveTable size.
pluginList := {}.
self loadNewPlugin: '']
ifFalse:
[pluginList := {'' -> self }].
desiredNumStackPages := desiredEdenBytes := 0.
"This is initialized on loading the image, but convenient for testing stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := self ioUTCStartMicroseconds.
"initialize InterpreterSimulator variables used for debugging"
byteCount := sendCount := lookupCount := 0.
+ quitBlock := [^self close].
- quitBlock := [^self].
traceOn := true.
printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
eventQueue := SharedQueue new.
suppressHeartbeatFlag := false.
systemAttributes := Dictionary new.
extSemTabSize := 256.
disableBooleanCheat := false.
assertVEPAES := true. "a flag so the assertValidExecutionPointers can be disabled for simulation speed"!
Item was changed:
----- Method: StackInterpreterSimulator>>logOfBytesVerify:fromFileNamed:fromStart: (in category 'testing') -----
logOfBytesVerify: nBytes fromFileNamed: fileName fromStart: loggingStart
"Verify a questionable interpreter against a successful run"
"self logOfBytesVerify: 10000 fromFileNamed: 'clone32Bytecodes.log' "
| logFile rightWord prevCtxt |
logFile := (FileStream readOnlyFileNamed: fileName) binary.
transcript clear.
byteCount := 0.
+ quitBlock := [^self close].
- quitBlock := [^ self].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
prevCtxt := 0. prevCtxt := prevCtxt.
[byteCount < nBytes] whileTrue:
[
"
byteCount > 14560 ifTrue:
[self externalizeIPandSP.
prevCtxt = activeContext ifFalse:
[prevCtxt := activeContext.
transcript cr; nextPutAll: (self printTop: 2); endEntry].
transcript cr; print: byteCount; nextPutAll: ': ' , (activeContext hex); space;
print: (instructionPointer - method - (BaseHeaderSize - 2));
nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space;
nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space;
print: (self stackPointerIndex - TempFrameStart + 1); endEntry.
byteCount = 14590 ifTrue: [self halt]].
"
loggingStart >= byteCount ifTrue:
[rightWord := logFile nextWord.
currentBytecode = rightWord ifFalse:
[self halt: 'halt at ', byteCount printString]].
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
self externalizeIPandSP.
logFile close.
self inform: nBytes printString , ' bytecodes verfied.'!
Item was changed:
----- Method: StackInterpreterSimulator>>logOfBytesWrite:toFileNamed:fromStart: (in category 'testing') -----
logOfBytesWrite: nBytes toFileNamed: fileName fromStart: loggingStart
"Write a log file for testing a flaky interpreter on the same image"
"self logOfBytesWrite: 10000 toFileNamed: 'clone32Bytecodes.log' "
| logFile |
logFile := (FileStream newFileNamed: fileName) binary.
transcript clear.
byteCount := 0.
+ quitBlock := [^self close].
- quitBlock := [^ self].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[byteCount < nBytes] whileTrue:
[byteCount >= loggingStart ifTrue:
[logFile nextWordPut: currentBytecode].
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
self externalizeIPandSP.
logFile close!
Item was changed:
----- Method: StackInterpreterSimulator>>logOfSendsVerify:fromFileNamed:fromStart: (in category 'testing') -----
logOfSendsVerify: nSends fromFileNamed: fileName fromStart: loggingStart
"Write a log file for testing a flaky interpreter on the same image"
"self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' "
| logFile priorFrame rightSelector prevCtxt |
logFile := FileStream readOnlyFileNamed: fileName.
transcript clear.
byteCount := 0.
sendCount := 0.
priorFrame := localFP.
+ quitBlock := [^self close].
- quitBlock := [^ self].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
prevCtxt := 0. prevCtxt := prevCtxt.
[sendCount < nSends] whileTrue:
[
"
byteCount>500 ifTrue:
[byteCount>550 ifTrue: [self halt].
self externalizeIPandSP.
prevCtxt = localFP ifFalse:
[prevCtxt := localFP.
transcript cr; nextPutAll: (self printTop: 2); endEntry].
transcript cr; print: byteCount; nextPutAll: ': ' , (localFP hex); space;
print: (instructionPointer - method - (BaseHeaderSize - 2));
nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space;
nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space;
print: (self stackPointerIndex - TempFrameStart + 1); endEntry.
].
"
self dispatchOn: currentBytecode in: BytecodeTable.
localFP = priorFrame ifFalse:
[sendCount := sendCount + 1.
loggingStart >= sendCount ifTrue:
[rightSelector := logFile nextLine.
(self stringOf: messageSelector) = rightSelector ifFalse:
[self halt: 'halt at ', sendCount printString]].
priorFrame := localFP].
self incrementByteCount].
self externalizeIPandSP.
logFile close.
self inform: nSends printString , ' sends verfied.'!
Item was changed:
----- Method: StackInterpreterSimulator>>logOfSendsWrite:toFileNamed:fromStart: (in category 'testing') -----
logOfSendsWrite: nSends toFileNamed: fileName fromStart: loggingStart
"Write a log file for testing a flaky interpreter on the same image"
"self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' "
| logFile priorFrame |
logFile := FileStream newFileNamed: fileName.
transcript clear.
byteCount := 0.
sendCount := 0.
priorFrame := localFP.
+ quitBlock := [^self close].
- quitBlock := [^ self].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[sendCount < nSends] whileTrue:
[self dispatchOn: currentBytecode in: BytecodeTable.
localFP = priorFrame ifFalse:
[sendCount >= loggingStart ifTrue:
[sendCount := sendCount + 1.
logFile nextPutAll: (self stringOf: messageSelector); cr].
priorFrame := localFP].
self incrementByteCount].
self externalizeIPandSP.
logFile close!
Item was changed:
----- Method: StackInterpreterSimulator>>run (in category 'testing') -----
run
"Just run"
quitBlock := [displayView ifNotNil:
[displayView containingWindow ifNotNil:
[:topWindow|
((World submorphs includes: topWindow)
and: [UIManager default confirm: 'close?']) ifTrue:
[topWindow delete]]].
+ ^self close].
- ^self].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
[self assertValidExecutionPointers.
atEachStepBlock value. "N.B. may be nil"
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
localIP := localIP - 1.
"undo the pre-increment of IP before returning"
self externalizeIPandSP!
Item was changed:
----- Method: StackInterpreterSimulator>>runWithBreakCount: (in category 'testing') -----
runWithBreakCount: theBreakCount
"Just run, halting when byteCount is reached"
quitBlock := [displayView ifNotNil:
[displayView containingWindow ifNotNil:
[:topWindow|
((World submorphs includes: topWindow)
and: [UIManager default confirm: 'close?']) ifTrue:
[topWindow delete]]].
+ ^self close].
- ^self].
breakCount := theBreakCount.
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
[self assertValidExecutionPointers.
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
localIP := localIP - 1.
"undo the pre-increment of IP before returning"
self externalizeIPandSP!
Item was changed:
----- Method: StackInterpreterSimulator>>test (in category 'testing') -----
test
self initStackPages.
self loadInitialContext.
transcript clear.
byteCount := 0.
breakCount := -1.
+ quitBlock := [^self close].
- quitBlock := [^self].
printSends := printReturns := true.
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
[self assertValidExecutionPointers.
printFrameAtEachStep ifTrue:
[self printFrame: localFP WithSP: localSP].
printBytecodeAtEachStep ifTrue:
[self printCurrentBytecodeOn: Transcript.
Transcript cr; flush].
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount.
byteCount = breakCount ifTrue:
["printFrameAtEachStep :=" printBytecodeAtEachStep := true.
self halt: 'hit breakCount break-point']].
self externalizeIPandSP!
Item was changed:
----- Method: StackInterpreterSimulator>>test1 (in category 'testing') -----
test1
self initStackPages.
self loadInitialContext.
transcript clear.
byteCount := 0.
breakCount := -1.
self setBreakSelector: #blockCopy:.
+ quitBlock := [^self close].
- quitBlock := [^self].
printSends := printReturns := true.
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
[self assertValidExecutionPointers.
"byteCount >= 22283 ifTrue:
[(self checkIsStillMarriedContext: 22186072 currentFP: localFP) ifFalse:
[self halt]]."
(printBytecodeAtEachStep
"and: [self isMarriedOrWidowedContext: 22189568]") ifTrue:
["| thePage |
thePage := stackPages stackPageFor: (self frameOfMarriedContext: 22189568).
thePage == stackPage
ifTrue: [self shortPrintFrameAndCallers: localFP SP: localSP]
ifFalse: [self shortPrintFrameAndCallers: thePage headFrameFP SP: thePage headFrameSP]."
self printCurrentBytecodeOn: Transcript.
Transcript cr; flush].
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount.
byteCount = breakCount ifTrue:
["printFrameAtEachStep := true."
printSends := printBytecodeAtEachStep := true.
self halt: 'hit breakCount break-point']].
self externalizeIPandSP!
Item was changed:
----- Method: StackInterpreterSimulator>>testBreakCount:printSends:printFrames:printBytecodes: (in category 'testing') -----
testBreakCount: breakCount printSends: shouldPrintSends printFrames: shouldPrintFrames printBytecodes: shouldPrintBytecodes
self initStackPages.
self loadInitialContext.
transcript clear.
byteCount := 0.
+ quitBlock := [^self close].
- quitBlock := [^self].
printSends := true & shouldPrintSends. "true & foo allows evaluating printFoo := true in the debugger"
printFrameAtEachStep := true & shouldPrintFrames.
printBytecodeAtEachStep := true & shouldPrintBytecodes.
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
[self assertValidExecutionPointers.
printFrameAtEachStep ifTrue:
[self printFrame: localFP WithSP: localSP].
printBytecodeAtEachStep ifTrue:
[self printCurrentBytecodeOn: Transcript.
Transcript cr; flush].
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount.
byteCount = breakCount ifTrue:
["printFrameAtEachStep :=" printBytecodeAtEachStep := true.
self halt: 'hit breakCount break-point']].
self externalizeIPandSP!
More information about the Vm-dev
mailing list