[Vm-dev] VM Maker: VMMaker.oscog-eem.648.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Mar 19 17:48:19 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.648.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.648
Author: eem
Time: 19 March 2014, 10:45:48.9 am
UUID: fc8c84dd-a94e-452e-afb0-25db6d9a00eb
Ancestors: VMMaker.oscog-eem.647
Fix the regression in VMMaker.oscog-eem.647 which correctly
inferred types for kernel selectors but stopped correctly inferring
types for api methods.
Print (nil) next to the selector for cog methdos with a nil selector.
Prune young referrers in followForwardedMethods.
=============== Diff against VMMaker.oscog-eem.641 ===============
Item was changed:
----- Method: BalloonArray>>at: (in category 'memory access') -----
at: index
| value |
value := simArray at: index+1.
"Debug only..."
value ifNil:
[self error: 'attempt to read an uninitialized field'.
^ super at: index "Maybe it was set in Squeak. Return the raw value"].
(self bitsOf: value) ~= (super at: index) ifTrue:
+ [self error: 'inconsistent values: ', (self bitsOf: value) printString, ' vs ', (super at: index) printString].
+ ^value!
- [self error: 'inconsistent values'].
- ^ value!
Item was changed:
----- Method: BitBltSimulation>>loadColorMap (in category 'interpreter interface') -----
loadColorMap
"ColorMap, if not nil, must be longWords, and
2^N long, where N = sourceDepth for 1, 2, 4, 8 bits,
or N = 9, 12, or 15 (3, 4, 5 bits per color) for 16 or 32 bits."
| cmSize oldStyle oop cmOop |
<inline: true>
cmFlags := cmMask := cmBitsPerColor := 0.
cmShiftTable := nil.
cmMaskTable := nil.
cmLookupTable := nil.
cmOop := interpreterProxy fetchPointer: BBColorMapIndex ofObject: bitBltOop.
cmOop = interpreterProxy nilObject ifTrue:[^true].
cmFlags := ColorMapPresent. "even if identity or somesuch - may be cleared later"
oldStyle := false.
(interpreterProxy isWords: cmOop) ifTrue:[
"This is an old-style color map (indexed only, with implicit RGBA conversion)"
cmSize := interpreterProxy slotSizeOf: cmOop.
cmLookupTable := interpreterProxy firstIndexableField: cmOop.
oldStyle := true.
self cCode: '' inSmalltalk:
[self assert: cmLookupTable unitSize = 4].
] ifFalse: [
"A new-style color map (fully qualified)"
((interpreterProxy isPointers: cmOop)
and:[(interpreterProxy slotSizeOf: cmOop) >= 3]) ifFalse:[^false].
cmShiftTable := self loadColorMapShiftOrMaskFrom:
(interpreterProxy fetchPointer: 0 ofObject: cmOop).
cmMaskTable := self loadColorMapShiftOrMaskFrom:
(interpreterProxy fetchPointer: 1 ofObject: cmOop).
oop := interpreterProxy fetchPointer: 2 ofObject: cmOop.
oop = interpreterProxy nilObject
ifTrue:[cmSize := 0]
ifFalse:[(interpreterProxy isWords: oop) ifFalse:[^false].
cmSize := (interpreterProxy slotSizeOf: oop).
cmLookupTable := interpreterProxy firstIndexableField: oop].
cmFlags := cmFlags bitOr: ColorMapNewStyle.
self cCode: '' inSmalltalk:
+ [self assert: (cmShiftTable isNil or: [cmShiftTable unitSize = 4]).
+ self assert: (cmMaskTable isNil or: [cmMaskTable unitSize = 4]).
+ self assert: (cmLookupTable isNil or: [cmLookupTable unitSize = 4])].
- [self assert: cmShiftTable unitSize = 4.
- self assert: cmMaskTable unitSize = 4.
- self assert: cmLookupTable unitSize = 4].
].
(cmSize bitAnd: cmSize - 1) = 0 ifFalse:[^false].
cmMask := cmSize - 1.
cmBitsPerColor := 0.
cmSize = 512 ifTrue: [cmBitsPerColor := 3].
cmSize = 4096 ifTrue: [cmBitsPerColor := 4].
cmSize = 32768 ifTrue: [cmBitsPerColor := 5].
cmSize = 0
ifTrue:[cmLookupTable := nil. cmMask := 0]
ifFalse:[cmFlags := cmFlags bitOr: ColorMapIndexedPart].
oldStyle "needs implicit conversion"
ifTrue:[ self setupColorMasks].
"Check if colorMap is just identity mapping for RGBA parts"
(self isIdentityMap: cmShiftTable with: cmMaskTable)
ifTrue:[ cmMaskTable := nil. cmShiftTable := nil ]
ifFalse:[ cmFlags := cmFlags bitOr: ColorMapFixedPart].
+ self cCode: [] inSmalltalk:
+ [cmShiftTable ifNotNil:
+ [cmShiftTable := CPluggableAccessor new
+ setObject: cmShiftTable;
+ atBlock: [:obj :idx| obj intAt: idx - 1]
+ atPutBlock: [:obj :idx :val| obj intAt: idx - 1 put: val];
+ yourself]].
^true!
Item was changed:
----- Method: BitBltSimulation>>unlockSurfaces (in category 'surface support') -----
unlockSurfaces
"Unlock the bits of any OS surfaces."
"See the comment in lockSurfaces. Similar rules apply. That is, the area provided in ioUnlockSurface can be used to determine the dirty region after drawing. If a source is unlocked, then the area will be (0,0,0,0) to indicate that no portion is dirty."
| sourceHandle destHandle destLocked fn |
<var: #fn declareC:'sqInt (*fn)(sqInt, sqInt, sqInt, sqInt, sqInt)'>
hasSurfaceLock ifTrue:[
unlockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
fn := self cCoerce: unlockSurfaceFn to: 'sqInt (*)(sqInt, sqInt, sqInt, sqInt, sqInt)'.
destLocked := false.
destHandle := interpreterProxy fetchPointer: FormBitsIndex ofObject: destForm.
(interpreterProxy isIntegerObject: destHandle) ifTrue:[
destHandle := interpreterProxy integerValueOf: destHandle.
"The destBits are always assumed to be dirty"
self cCode:'fn(destHandle, affectedL, affectedT, affectedR-affectedL, affectedB-affectedT)'.
destBits := destPitch := 0.
destLocked := true.
].
noSource ifFalse:[
sourceHandle := interpreterProxy fetchPointer: FormBitsIndex ofObject: sourceForm.
(interpreterProxy isIntegerObject: sourceHandle) ifTrue:[
sourceHandle := interpreterProxy integerValueOf: sourceHandle.
"Only unlock sourceHandle if different from destHandle"
(destLocked and:[sourceHandle = destHandle])
ifFalse:[self cCode: 'fn(sourceHandle, 0, 0, 0, 0)'].
sourceBits := sourcePitch := 0.
].
].
hasSurfaceLock := false.
+ self cCode: [] inSmalltalk:
+ [self touch: fn.
+ interpreterProxy displayObject = destForm ifTrue:
+ [interpreterProxy getDeferDisplayUpdates "for some reason this is true..."
+ ifTrue:
+ [interpreterProxy fullDisplayUpdate]
+ ifFalse:
+ [interpreterProxy fullDisplayUpdate]]].
].!
Item was added:
+ ----- Method: BitBltSimulator>>primitive:parameters:receiver: (in category 'simulation') -----
+ primitive: primitiveName parameters: parameterTypesArray receiver: rcvrType
+ primitiveName caseOf: {
+ ['primitivePixelValueAt'] -> [^self] }!
Item was added:
+ ----- Method: BitBltSimulator>>primitivePixelValueAt (in category 'simulation') -----
+ primitivePixelValueAt
+ self primitivePixelValueAtX: (interpreterProxy stackValue: 1) y: (interpreterProxy stackValue: 0)!
Item was changed:
----- Method: CCodeGenerator>>returnTypeForSend: (in category 'type inference') -----
returnTypeForSend: aTSendNode
"Answer the return type for a send. Absent sends default to #sqInt."
| sel |
+ ^(self anyMethodNamed: (sel := aTSendNode selector))
- ^(methods at: (sel := aTSendNode selector) ifAbsent: nil)
ifNil: [kernelReturnTypes
at: sel
ifAbsent:
[^sel
caseOf: {
[#asVoidPointer] -> [#'void *'].
[#asUnsignedInteger] -> [#usqInt].
[#asLong] -> [#long].
[#asUnsignedLong] -> [#'unsigned long'].
[#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
[#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
[#cCoerce:to:] -> [aTSendNode args last value].
[#cCoerceSimple:to:] -> [aTSendNode args last value] }
otherwise: [#sqInt]]]
ifNotNil:
[:m|
m returnType ifNotNil:
[:type| "map fields to #usqInt"
((type beginsWith: 'unsigned')
and: [(type includes: $:)
and: [type last isDigit]])
ifTrue: [#usqInt]
ifFalse: [type]]]!
Item was changed:
----- Method: CoInterpreter>>ceTraceLinkedSend: (in category 'debug support') -----
ceTraceLinkedSend: theReceiver
| cogMethod |
<api>
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: (self stackTop - cogit traceLinkedSendOffset)
to: #'CogMethod *'.
+ self cCode: [] inSmalltalk:
+ [cogit checkStackDepthOnSend ifTrue:
+ [self maybeCheckStackDepth: (cogMethod cmNumArgs > cogit numRegArgs
+ ifTrue: [cogMethod cmNumArgs + 1]
+ ifFalse: [0])
+ sp: stackPointer + BytesPerWord
+ pc: (self stackValue: 1)]].
"cogit recordSendTrace ifTrue: is implicit; wouldn't compile the call otherwise."
self recordTrace: (objectMemory fetchClassOf: theReceiver)
thing: cogMethod selector
source: TraceIsFromMachineCode.
cogit printOnTrace ifTrue:
[self printActivationNameFor: cogMethod methodObject
receiver: theReceiver
isBlock: false
firstTemporary: nil;
cr].
self sendBreakpoint: cogMethod selector receiver: theReceiver!
Item was changed:
----- Method: CoInterpreter>>printCogMethod: (in category 'debug printing') -----
printCogMethod: cogMethod
<api>
<var: #cogMethod type: #'CogMethod *'>
| address primitive |
self cCode: ''
inSmalltalk:
[self transcript ensureCr.
cogMethod isInteger ifTrue:
[^self printCogMethod: (self cCoerceSimple: cogMethod to: #'CogMethod *')]].
address := cogMethod asInteger.
self printHex: address;
print: ' <-> ';
printHex: address + cogMethod blockSize.
cogMethod cmType = CMMethod ifTrue:
[self print: ': method: ';
printHex: cogMethod methodObject.
primitive := self primitiveIndexOfMethod: cogMethod methodObject
header: cogMethod methodHeader.
primitive ~= 0 ifTrue:
[self print: ' prim '; printNum: primitive]].
cogMethod cmType = CMBlock ifTrue:
[self print: ': block home: ';
printHex: (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod asUnsignedInteger].
cogMethod cmType = CMClosedPIC ifTrue:
[self print: ': Closed PIC N: ';
printHex: cogMethod cPICNumCases].
cogMethod cmType = CMOpenPIC ifTrue:
[self print: ': Open PIC '].
+ self print: ' selector: '; printHex: cogMethod selector.
+ cogMethod selector = objectMemory nilObject
+ ifTrue: [self print: ' (nil)']
+ ifFalse: [self space; printStringOf: cogMethod selector].
+ self cr!
- self print: ' selector: ';
- printHex: cogMethod selector;
- print: ' ';
- printStringOf: cogMethod selector;
- cr!
Item was changed:
----- Method: CoInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
printFrame: theFP WithSP: theSP
<api>
| theMethod theMethodEnd numArgs numTemps rcvrAddress topThing |
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #addr type: #'char *'>
<var: #rcvrAddress type: #'char *'>
<var: #cogMethod type: #'CogBlockMethod *'>
<var: #homeMethod type: #'CogMethod *'>
self cCode: '' inSmalltalk: [self transcript ensureCr].
(self isMachineCodeFrame: theFP)
ifTrue:
[| cogMethod homeMethod |
cogMethod := self mframeCogMethod: theFP.
homeMethod := self mframeHomeMethod: theFP.
theMethod := homeMethod asInteger.
theMethodEnd := homeMethod asInteger + homeMethod blockSize.
numArgs := cogMethod cmNumArgs.
numTemps := self temporaryCountOfMethodHeader: homeMethod methodHeader]
ifFalse:
[theMethod := self frameMethodObject: theFP.
theMethodEnd := theMethod + (objectMemory sizeBitsOfSafe: theMethod).
numArgs := self iframeNumArgs: theFP.
numTemps := self tempCountOf: theMethod].
(self frameIsBlockActivation: theFP) ifTrue:
[| rcvrOrClosure |
+ "No BlockLocalTempCounter in the Cogit's C code, so quick hack is to use numCopied + numArgs"
rcvrOrClosure := self pushedReceiverOrClosureOfFrame: theFP.
((objectMemory isNonImmediate: rcvrOrClosure)
and: [(objectMemory addressCouldBeObj: rcvrOrClosure)
and: [(objectMemory fetchClassOfNonImm: rcvrOrClosure) = (objectMemory splObj: ClassBlockClosure)]])
ifTrue: [numTemps := numArgs + (self stSizeOf: rcvrOrClosure)]
+ ifFalse: [numTemps := numArgs]].
- ifFalse: [numTemps := 0]].
self shortPrintFrame: theFP.
(self isBaseFrame: theFP) ifTrue:
[self printFrameOop: '(caller ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (2 * BytesPerWord).
self printFrameOop: '(saved ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (1 * BytesPerWord)].
self printFrameOop: 'rcvr/clsr'
at: theFP + FoxCallerSavedIP + ((numArgs + 1) * BytesPerWord).
numArgs to: 1 by: -1 do:
[:i|
self printFrameOop: 'arg' index: numArgs - i at: theFP + FoxCallerSavedIP + (i * BytesPerWord)].
self printFrameThing: 'caller ip'
at: theFP + FoxCallerSavedIP
extraString: ((stackPages longAt: theFP + FoxCallerSavedIP) = cogit ceReturnToInterpreterPC ifTrue:
['ceReturnToInterptreter']).
self printFrameThing: 'saved fp' at: theFP + FoxSavedFP.
self printFrameMethodFor: theFP.
(self isMachineCodeFrame: theFP) ifFalse:
[self printFrameFlagsForFP: theFP].
self printFrameOop: 'context' at: theFP + FoxThisContext.
(self isMachineCodeFrame: theFP) ifTrue:
[self printFrameFlagsForFP: theFP].
(self isMachineCodeFrame: theFP)
ifTrue: [rcvrAddress := theFP + FoxMFReceiver]
ifFalse:
[self printFrameThing: 'saved ip'
at: theFP + FoxIFSavedIP
extra: ((self iframeSavedIP: theFP) = 0
ifTrue: [0]
ifFalse: [(self iframeSavedIP: theFP) - theMethod + 2 - BaseHeaderSize]).
rcvrAddress := theFP + FoxIFReceiver].
self printFrameOop: 'receiver' at: rcvrAddress.
topThing := stackPages longAt: theSP.
(topThing between: theMethod and: theMethodEnd)
ifTrue:
[rcvrAddress - BytesPerWord to: theSP + BytesPerWord by: BytesPerWord negated do:
[:addr| | index |
index := rcvrAddress - addr / BytesPerWord + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
+ ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP)
+ ifTrue: ['temp/stck']
+ ifFalse: ['stck'])
+ at: addr]].
- ifFalse: [self printFrameOop: 'stck' at: addr]].
self printFrameThing: 'frame ip'
at: theSP
extra: ((self isMachineCodeFrame: theFP)
ifTrue: [topThing - theMethod]
ifFalse: [topThing - theMethod + 2 - BaseHeaderSize])]
ifFalse:
[rcvrAddress - BytesPerWord to: theSP by: BytesPerWord negated do:
[:addr| | index |
index := rcvrAddress - addr / BytesPerWord + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
+ ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP)
+ ifTrue: ['temp/stck']
+ ifFalse: ['stck'])
+ at: addr]]]!
- ifFalse: [self printFrameOop: 'stck' at: addr]]]!
Item was changed:
----- Method: CogVMSimulator>>ceSendAbort:to:numArgs: (in category 'trampolines') -----
ceSendAbort: selector to: rcvr numArgs: numArgs
"self stringOf: selector"
"self printOop: rcvr"
self logSend: selector.
cogit assertCStackWellAligned.
+ self maybeCheckStackDepth: numArgs + 1
+ sp: stackPointer + BytesPerWord
+ pc: (stackPages longAt: stackPointer).
- self maybeCheckStackDepth: 0 sp: stackPointer pc: (stackPages longAt: stackPointer).
^super ceSendAbort: selector to: rcvr numArgs: numArgs!
Item was added:
+ ----- Method: CogVMSimulator>>displayView (in category 'accessing') -----
+ displayView
+ "The VM SImulator draws directly on an imageMorph named displayView
+ displayView is housed on a Form named displayForm
+ Since this is housed directly on the Morph, I have this tight compling from here->model->morph.
+ "
+ self flag: 'tty'.
+ ^displayView!
Item was changed:
----- Method: CogVMSimulator>>incrementByteCount (in category 'interpreter shell') -----
incrementByteCount
(byteCount := byteCount + 1) = breakCount ifTrue:
[self doOrDefer: [self changed: #byteCountText; changed: #composeAll].
self halt].
byteCount \\ 1000 = 0 ifTrue:
[self doOrDefer: [self changed: #byteCountText; changed: #composeAll].
+ self forceInterruptCheck]!
- self forceInterruptCheck.
- byteCount \\ 10000 = 0 ifTrue: [self fullDisplayUpdate]]!
Item was changed:
----- Method: CogVMSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitives support') -----
ioRelinquishProcessorForMicroseconds: microseconds
"In the simulator give an indication that we're idling and check for input.
If called from machine code then increment the byte count since the clock
is derived from it and the clock will not advance otherwise.
If we're simulating threading we're in difficulties. We need a UI process
(to run activities such as fill-in-the-blanks) but we also need an independent
thread of control to run this VM thread. So we need to fork a new UI process."
Display reverse: (0 at 0 extent: 16 at 16).
- instructionPointer >= objectMemory startOfMemory ifFalse:
- [byteCount := byteCount + microseconds - 1.
- self incrementByteCount].
Sensor peekEvent ifNotNil:
[self forceInterruptCheck].
Processor activeProcess == Project uiProcess ifTrue:
[World doOneCycle].
microseconds >= 1000
ifTrue: [self isThreadedVM ifTrue:
[self forceInterruptCheckFromHeartbeat].
(Delay forMilliseconds: microseconds + 999 // 1000) wait]
+ ifFalse: [Processor yield].
+ byteCount := byteCount + microseconds - 1.
+ self incrementByteCount!
- ifFalse: [Processor yield]!
Item was changed:
----- Method: CogVMSimulator>>maybeCheckStackDepth:sp:pc: (in category 'debug support') -----
maybeCheckStackDepth: delta sp: sp pc: mcpc
+ | asp bcpc startbcpc cogHomeMethod cogBlockMethod csp debugStackPointers |
- | asp bcpc cogHomeMethod cogBlockMethod csp debugStackPointers |
debugStackDepthDictionary ifNil: [^self].
(self isMachineCodeFrame: framePointer) ifFalse: [^self].
cogBlockMethod := self mframeCogMethod: framePointer.
cogHomeMethod := self asCogHomeMethod: cogBlockMethod.
debugStackPointers := debugStackDepthDictionary
at: cogHomeMethod methodObject
ifAbsentPut: [self debugStackPointersFor: cogHomeMethod methodObject].
+ startbcpc := cogHomeMethod = cogBlockMethod
+ ifTrue: [self startPCOfMethod: cogHomeMethod methodObject]
+ ifFalse: [self startPCOfClosure: (self pushedReceiverOrClosureOfFrame: framePointer)].
+ bcpc := cogit bytecodePCFor: mcpc startBcpc: startbcpc in: cogBlockMethod.
- bcpc := cogit
- bytecodePCFor: mcpc
- startBcpc: (cogHomeMethod = cogBlockMethod
- ifTrue: [self startPCOfMethod: cogHomeMethod methodObject]
- ifFalse: [self startPCOfClosure: (self pushedReceiverOrClosureOfFrame: framePointer)])
- in: cogBlockMethod.
self assert: bcpc ~= 0.
+ cogBlockMethod ~= cogHomeMethod ifTrue:
+ [| lastbcpc |
+ lastbcpc := cogit lastBytecodePCForBlockAt: startbcpc in: cogHomeMethod methodObject.
+ bcpc > lastbcpc ifTrue:
+ [bcpc := lastbcpc]].
asp := self stackPointerIndexForFrame: framePointer WithSP: sp + BytesPerWord.
csp := debugStackPointers at: bcpc.
"Compensate lazily for absent receiver sends."
(NewspeakVM
and: [asp - delta = csp
and: [cogit isAbsentReceiverSendAt: mcpc in: cogHomeMethod]]) ifTrue:
[csp := debugStackPointers at: bcpc put: csp + 1].
self assert: asp - delta + 1 = csp!
Item was added:
+ ----- Method: CogVMSimulator>>preGCAction: (in category 'object memory support') -----
+ preGCAction: gcModeArg
+ "Override to void debugStackPointers on any GC/remap"
+ debugStackDepthDictionary ifNotNil:
+ [debugStackDepthDictionary := Dictionary new].
+ ^super preGCAction: gcModeArg!
Item was removed:
- ----- Method: CogVMSimulator>>primitiveScreenSize (in category 'I/O primitives') -----
- primitiveScreenSize
- | size |
- size := self desiredDisplayExtent min: 800 at 640.
- self pop: 1 thenPush: (self makePointwithxValue: size x yValue: size y)!
Item was changed:
----- Method: CogVMSimulator>>stackLimitFromMachineCode (in category 'I/O primitives support') -----
stackLimitFromMachineCode
"Intercept accesses to the stackLimit from machine code to
increment byteCount so that ioMSecs/ioMicroseconds does
somethng reasonable when we're purely in machine code."
(byteCount := byteCount + 1) - lastPollCount >= 100 ifTrue:
[lastPollCount := byteCount.
- byteCount \\ 500 = 0 ifTrue:
- [self fullDisplayUpdate].
(Sensor peekEvent notNil
or: [nextProfileTick > 0
and: [nextProfileTick <= self ioUTCMicroseconds]]) ifTrue:
[suppressHeartbeatFlag "gets set by selector breakpoints"
ifTrue: [self forceInterruptCheck]
ifFalse: [self forceInterruptCheckFromHeartbeat]]].
^stackLimit!
Item was changed:
----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
utilitiesMenu: aMenuMorph
aMenuMorph
add: 'toggle transcript' action: #toggleTranscript;
add: 'clone VM' action: #cloneSimulation;
addLine;
add: 'print ext head frame' action: #printExternalHeadFrame;
add: 'print int head frame' action: #printHeadFrame;
add: 'print mc/cog frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
add: 'short print mc/cog frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
add: 'long print mc/cog frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
add: 'print call stack' action: #printCallStack;
add: 'print stack call stack' action: #printStackCallStack;
add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]];
add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
add: 'print all stacks' action: #printAllStacks;
add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
self writeBackHeadFramePointers];
add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor eip.
self writeBackHeadFramePointers];
addLine;
add: 'print registers' action: [cogit processor printRegistersOn: transcript];
add: 'print register map' action: [cogit printRegisterMapOn: transcript];
add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
add: 'disassemble method/trampoline at pc' action: [cogit disassembleCodeAt: cogit processor pc];
add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
addLine;
add: 'inspect object memory' target: objectMemory action: #inspect;
add: 'inspect cointerpreter' action: #inspect;
add: 'inspect cogit' target: cogit action: #inspect;
add: 'inspect method zone' target: cogit methodZone action: #inspect.
self isThreadedVM ifTrue:
[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
aMenuMorph
addLine;
add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
add: 'print cog methods with prim...' action: [(self promptNum: 'prim index') ifNotNil: [:pix| cogMethodZone printCogMethodsWithPrimitive: pix]];
add: 'print trampoline table' target: cogit action: #printTrampolineTable;
add: 'print prim trace log' action: #dumpPrimTraceLog;
add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
add: 'set break pc (', (cogit breakPC isInteger ifTrue: [cogit breakPC hex] ifFalse: [cogit breakPC printString]), ')...' action: [(self promptHex: 'break pc') ifNotNil: [:bpc| cogit breakPC: bpc]];
add: (cogit singleStep
ifTrue: ['no single step']
ifFalse: ['single step'])
action: [cogit singleStep: cogit singleStep not];
add: (cogit printRegisters
ifTrue: ['no print registers each instruction']
ifFalse: ['print registers each instruction'])
action: [cogit printRegisters: cogit printRegisters not];
add: (cogit printInstructions
ifTrue: ['no print instructions each instruction']
ifFalse: ['print instructions each instruction'])
action: [cogit printInstructions: cogit printInstructions not];
addLine;
add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
s notEmpty ifTrue: [self setBreakSelector: s]];
add: 'set break block...' action: [|s| s := UIManager default request: 'break block'.
s notEmpty ifTrue: [self setBreakBlockFromString: s]];
+ add: 'set cogit break method...' action: [(self promptHex: 'cogit breakMethod') ifNotNil: [:bm| cogit setBreakMethod: bm]];
add: (printBytecodeAtEachStep
ifTrue: ['no print bytecode each bytecode']
ifFalse: ['print bytecode each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printBytecodeAtEachStep := printBytecodeAtEachStep not];
add: (printFrameAtEachStep
ifTrue: ['no print frame each bytecode']
ifFalse: ['print frame each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printFrameAtEachStep := printFrameAtEachStep not].
^aMenuMorph!
Item was changed:
----- Method: Cogit>>checkIfValidObjectRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
checkIfValidObjectRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
<var: #mcpc type: #'char *'>
+ | literal entryPoint |
- | literal cacheTag entryPoint |
annotation = IsObjectReference ifTrue:
[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
(self asserta: (objectRepresentation checkValidObjectReference: literal)) ifFalse:
[^1].
((objectRepresentation couldBeObject: literal)
and: [objectMemory isReallyYoungObject: literal]) ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
[^2]]].
(self isSendAnnotation: annotation) ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmType = CMMethod) ifFalse:
[^3].
+ self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
+ [:offset :cacheTag :tagCouldBeObject|
+ tagCouldBeObject
+ ifTrue:
+ [(objectRepresentation couldBeObject: cacheTag)
+ ifTrue:
+ [(self asserta: (objectRepresentation checkValidObjectReference: cacheTag)) ifFalse:
+ [^4]]
+ ifFalse:
+ [(self asserta: (objectRepresentation checkValidInlineCacheTag: cacheTag)) ifFalse:
+ [^5]].
+ ((objectRepresentation couldBeObject: cacheTag)
+ and: [coInterpreter isReallyYoungObject: cacheTag]) ifTrue:
+ [(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
+ [^6]]]
+ ifFalse:
+ [(self asserta: (objectRepresentation checkValidInlineCacheTag: cacheTag)) ifFalse:
+ [^7]]].
- cacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
- (self asserta: (objectRepresentation checkValidInlineCacheTag: cacheTag)) ifFalse:
- [^4].
- ((objectRepresentation couldBeObject: cacheTag)
- and: [coInterpreter isReallyYoungObject: cacheTag]) ifTrue:
- [(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
- [^5]].
entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase ifTrue:
["It's a linked send; find which kind."
self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :sendTable|
(self asserta: (targetMethod cmType = CMMethod
or: [targetMethod cmType = CMClosedPIC
or: [targetMethod cmType = CMOpenPIC]])) ifFalse:
+ [^8]]]].
- [^6]]]].
^0 "keep scanning"!
Item was added:
+ ----- Method: Cogit>>checkStackDepthOnSend (in category 'debugging') -----
+ checkStackDepthOnSend
+ <doNotGenerate>
+ ^(traceFlags bitAnd: 128) ~= 0!
Item was changed:
----- Method: Cogit>>followForwardedMethods (in category 'garbage collection') -----
followForwardedMethods
<api>
<option: #SpurObjectMemory>
<var: #cogMethod type: #'CogMethod *'>
| cogMethod freedPIC |
<var: #cogMethod type: #'CogMethod *'>
freedPIC := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType = CMMethod ifTrue:
[(objectMemory isForwarded: cogMethod methodObject) ifTrue:
[cogMethod methodObject: (objectMemory followForwarded: cogMethod methodObject).
(cogMethod cmRefersToYoung not
and: [objectMemory isYoungObject: cogMethod methodObject]) ifTrue:
[methodZone addToYoungReferrers: cogMethod]]].
cogMethod cmType = CMClosedPIC ifTrue:
[(self followMethodReferencesInClosedPIC: cogMethod) ifTrue:
[freedPIC := true.
methodZone freeMethod: cogMethod]].
cogMethod := methodZone methodAfter: cogMethod].
freedPIC ifTrue:
[self unlinkSendsToFree.
+ methodZone pruneYoungReferrers.
processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!
Item was added:
+ ----- Method: Cogit>>lastBytecodePCForBlockAt:in: (in category 'method map') -----
+ lastBytecodePCForBlockAt: startbcpc in: aMethodObj
+ "Answer the 0-relative pc of the last bytecode in the block starting at the 0-relative startbcpc in aMethodObj."
+ | methodHeader bcpc bsOffset byte descriptor |
+ <var: #descriptor type: #'BytecodeDescriptor *'>
+ methodHeader := coInterpreter headerOf: aMethodObj.
+ bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: methodHeader).
+ bsOffset := self bytecodeSetOffsetForHeader: methodHeader.
+ byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
+ descriptor := self generatorAt: byte.
+ ^(self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj) - 1!
Item was changed:
----- Method: Cogit>>sendTrace: (in category 'debugging') -----
sendTrace: aBooleanOrInteger
<doNotGenerate>
"traceFlags is a set of flags.
1 => print trace (if something below is selected)
2 => trace sends
4 => trace block activations
8 => trace interpreter primitives
16 => trace events (context switches, GCs, etc)
32 => trace stack overflow
+ 64 => send breakpoint on implicit receiver (Newspeak VM only)
+ 128 => check stack depth on send (simulation only)"
- 64 => send breakpoint on implicit receiver (Newspeak VM only)"
traceFlags := aBooleanOrInteger isInteger
ifTrue: [aBooleanOrInteger]
ifFalse: [aBooleanOrInteger ifTrue: [6] ifFalse: [0]]!
Item was changed:
FilePlugin subclass: #FilePluginSimulator
+ instanceVariableNames: 'openFiles states'
- instanceVariableNames: 'openFiles'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-InterpreterSimulation'!
!FilePluginSimulator commentStamp: 'tpr 5/5/2003 12:02' prior: 0!
File plugin simulation for the VM simulator!
Item was changed:
----- Method: FilePluginSimulator>>fileValueOf: (in category 'simulation') -----
fileValueOf: objectPointer
+ | index file |
- | index |
index := (interpreterProxy isIntegerObject: objectPointer)
ifTrue: [interpreterProxy integerValueOf: objectPointer]
ifFalse:
[((interpreterProxy isBytes: objectPointer)
and: [(interpreterProxy byteSizeOf: objectPointer) = BytesPerWord]) ifFalse:
[interpreterProxy primitiveFail.
^nil].
interpreterProxy longAt: objectPointer + BaseHeaderSize].
+ file := openFiles at: index.
+ "this attempts to preserve file positions across snapshots when debugging the VM
+ requires saving an image in full flight and pushing it over the cliff time after time..."
+ (file closed and: [states includesKey: file]) ifTrue:
+ [[:pos :isBinary|
+ file reopen; position: pos.
+ isBinary ifTrue:
+ [file binary]] valueWithArguments: (states at: file)].
+ ^file!
- ^openFiles at: index!
Item was changed:
----- Method: FilePluginSimulator>>initialiseModule (in category 'initialize-release') -----
initialiseModule
"See FilePluginSimulator>>sqFileStdioHandlesInto:"
(openFiles := Dictionary new)
at: 0 put: (FakeStdinStream for: interpreterProxy interpreter); "stdin"
at: 1 put: Transcript; "stdout"
at: 2 put: Transcript. "stderr"
+ states := IdentityDictionary new.
^super initialiseModule!
Item was added:
+ ----- Method: FilePluginSimulator>>recordStateOf: (in category 'simulation') -----
+ recordStateOf: file
+ ([file position]
+ on: Error
+ do: [:ex| nil]) ifNotNil:
+ [:position|
+ states at: file put: {position. file isBinary}]!
Item was changed:
----- Method: FilePluginSimulator>>sqFile:Read:Into:At: (in category 'simulation') -----
sqFile: file Read: count Into: byteArrayIndex At: startIndex
| interpreter |
interpreter := interpreterProxy interpreter.
startIndex to: startIndex + count - 1 do:
[ :i |
file atEnd ifTrue: [^i - startIndex].
interpreter byteAt: byteArrayIndex + i put: file next asInteger].
+ self recordStateOf: file.
^count!
Item was changed:
----- Method: FilePluginSimulator>>sqFile:SetPosition: (in category 'simulation') -----
sqFile: file SetPosition: newPosition
+ file position: newPosition.
+ self recordStateOf: file!
- file position: newPosition!
Item was changed:
----- Method: FilePluginSimulator>>sqFile:Truncate: (in category 'simulation') -----
sqFile: file Truncate: truncatePosition
+ file truncate: truncatePosition.
+ self recordStateOf: file!
- file truncate: truncatePosition!
Item was changed:
----- Method: FilePluginSimulator>>sqFile:Write:From:At: (in category 'simulation') -----
sqFile: file Write: count From: byteArrayIndex At: startIndex
| interpreter |
interpreter := interpreterProxy interpreter.
file isBinary
ifTrue:
[startIndex to: startIndex + count - 1 do:
[ :i | file nextPut: (interpreter byteAt: byteArrayIndex + i)]]
ifFalse:
[startIndex to: startIndex + count - 1 do:
[ :i | | byte |
byte := interpreter byteAt: byteArrayIndex + i.
file nextPut: (Character value: (byte == 12 "lf" ifTrue: [15"cr"] ifFalse: [byte]))]].
+ self recordStateOf: file.
^count!
Item was changed:
----- Method: FilePluginSimulator>>sqFileClose: (in category 'simulation') -----
sqFileClose: file
+ file close.
+ self recordStateOf: file!
- file close!
Item was added:
+ ----- Method: Integer>>asPositiveIntegerObj (in category '*VMMaker-interpreter simulator') -----
+ asPositiveIntegerObj
+ "This is a SmartSyntaxPlugin convenience, invented with little thought for simulation (grrr).
+ In the VM this is equivalent to
+ interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: self)
+ but if a plugin is being developed I /think/ it is just
+ ^self
+ So search the stack to discover what context it is being used in."
+ (thisContext findContextSuchThat: [:ctxt| ctxt receiver isInterpreterPlugin]) ifNotNil:
+ [:ctxt| | interpreter |
+ interpreter := ctxt receiver getInterpreter.
+ interpreter methodReturnValue: (interpreter positive32BitIntegerFor: self)].
+ ^self!
Item was changed:
----- Method: Interpreter>>primitiveArrayBecome (in category 'object access primitives') -----
primitiveArrayBecome
"We must flush the method cache here, to eliminate stale references
to mutated classes and/or selectors."
| arg rcvr |
arg := self stackTop.
rcvr := self stackValue: 1.
+ self success: (self become: rcvr with: arg twoWay: true copyHash: false).
- self success: (self become: rcvr with: arg twoWay: true copyHash: true).
successFlag ifTrue: [ self pop: 1 ].!
Item was added:
+ ----- Method: InterpreterPlugin>>isInterpreterPlugin (in category 'testing') -----
+ isInterpreterPlugin
+ <doNotGenerate>
+ "Simulation only"
+ ^true!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveArctan (in category 'arithmetic float primitives') -----
primitiveArctan
| rcvr |
<var: #rcvr type: #double>
rcvr := self popFloat.
self successful
+ ifTrue: [self pushFloat: (self cCode: [rcvr atan]
+ inSmalltalk: [rcvr = rcvr
+ ifTrue: [rcvr arcTan]
+ ifFalse: [Float nan]])]
- ifTrue: [self pushFloat: (self cCode: 'atan(rcvr)' inSmalltalk: [rcvr arcTan])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveArrayBecome (in category 'object access primitives') -----
primitiveArrayBecome
"We must flush the method cache here, to eliminate stale references
to mutated classes and/or selectors."
| arg rcvr ec |
arg := self stackTop.
rcvr := self stackValue: 1.
+ ec := objectMemory become: rcvr with: arg twoWay: true copyHash: false.
- ec := objectMemory become: rcvr with: arg twoWay: true copyHash: true.
ec = PrimNoErr
ifTrue: [self pop: 1]
ifFalse: [self primitiveFailFor: ec]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveExp (in category 'arithmetic float primitives') -----
primitiveExp
"Computes E raised to the receiver power."
| rcvr |
<var: #rcvr type: #double>
rcvr := self popFloat.
self successful
+ ifTrue: [self pushFloat: (self cCode: [rcvr exp]
+ inSmalltalk: [rcvr = rcvr
+ ifTrue: [rcvr exp]
+ ifFalse: [Float nan]])]
- ifTrue: [self pushFloat: (self cCode: 'exp(rcvr)' inSmalltalk: [rcvr exp])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveLogN (in category 'arithmetic float primitives') -----
primitiveLogN
"Natural log."
| rcvr |
<var: #rcvr type: #double>
rcvr := self popFloat.
self successful
+ ifTrue: [self pushFloat: (self cCode: [rcvr log]
+ inSmalltalk: [rcvr = rcvr
+ ifTrue: [rcvr ln]
+ ifFalse: [Float nan]])]
- ifTrue: [self pushFloat: (self cCode: 'log(rcvr)' inSmalltalk: [rcvr ln])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveScreenSize (in category 'I/O primitives') -----
primitiveScreenSize
+ "Answer a point indicating the current size of the Smalltalk window.
+ Currently there is a limit of 65535 in each direction because the
+ point is encoded into a single 32bit value in the image header.
+ This might well become a problem one day"
+ self
+ cCode:
+ [| pointWord |
+ pointWord := self ioScreenSize.
+ self pop: 1
+ thenPush: (self makePointwithxValue: (pointWord >> 16 bitAnd: 65535)
+ yValue: (pointWord bitAnd: 65535))]
+ inSmalltalk:
+ [| size |
+ "Default to a reasonable size for simulation, unless the window has opened,
+ in which case allow the screen to be as large as the simulation window"
+ size := (self displayView notNil and: [self savedWindowSize notNil])
+ ifTrue: [self desiredDisplayExtent]
+ ifFalse: [self desiredDisplayExtent min: 800 at 640].
+ self pop: 1 thenPush: (self makePointwithxValue: size x yValue: size y)]!
- "Return a point indicating the current size of the Smalltalk window. Currently there is a limit of 65535 in each direction because the point is encoded into a single 32bit value in the image header. This might well become a problem one day"
- | pointWord |
- self pop: 1.
- pointWord := self ioScreenSize.
- self push: (self makePointwithxValue: (pointWord >> 16 bitAnd: 65535) yValue: (pointWord bitAnd: 65535))!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSine (in category 'arithmetic float primitives') -----
primitiveSine
| rcvr |
<var: #rcvr type: #double>
rcvr := self popFloat.
self successful
+ ifTrue: [self pushFloat: (self cCode: [rcvr sin]
+ inSmalltalk: [rcvr = rcvr
+ ifTrue: [rcvr sin]
+ ifFalse: [Float nan]])]
- ifTrue: [self pushFloat: (self cCode: 'sin(rcvr)' inSmalltalk: [rcvr sin])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSquareRoot (in category 'arithmetic float primitives') -----
primitiveSquareRoot
| rcvr |
<var: #rcvr type: #double>
rcvr := self popFloat.
self success: rcvr >= 0.0.
self successful
+ ifTrue: [self pushFloat: rcvr sqrt]
- ifTrue: [self pushFloat: (self cCode: 'sqrt(rcvr)' inSmalltalk: [rcvr sqrt])]
ifFalse: [self unPop: 1]!
Item was added:
+ ----- Method: InterpreterProxy>>getDeferDisplayUpdates (in category 'special objects') -----
+ getDeferDisplayUpdates
+ ^false!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveArrayBecome (in category 'object access primitives') -----
primitiveArrayBecome
"We must flush the method cache here, to eliminate stale references
to mutated classes and/or selectors. This version fails for immutables."
| arg rcvr ec |
arg := self stackTop.
rcvr := self stackValue: 1.
+ ec := self become: rcvr with: arg twoWay: true copyHash: false forceImmutables: false.
- ec := self become: rcvr with: arg twoWay: true copyHash: true forceImmutables: false.
ec = PrimNoErr
ifTrue: [self pop: 1]
ifFalse: [self primitiveFailFor: ec]!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>incrementByteCount (in category 'interpreter shell') -----
incrementByteCount
(byteCount := byteCount + 1) = breakCount ifTrue:
[self doOrDefer: [self changed: #byteCountText].
self halt].
byteCount \\ 1000 = 0 ifTrue:
[self doOrDefer: [self changed: #byteCountText].
+ self forceInterruptCheck]!
- self forceInterruptCheck.
- byteCount \\ 10000 = 0 ifTrue: [self fullDisplayUpdate]]!
Item was added:
+ ----- Method: Object>>isInterpreterPlugin (in category '*VMMaker-translation support') -----
+ isInterpreterPlugin
+ ^false!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
"This list records the valid senders of isIntegerObject: as we replace uses of
isIntegerObject: by isImmediate: where appropriate."
| sel |
sel := thisContext sender method selector.
(#( DoIt
DoItIn:
+ baseFrameReturn
+ bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
- on:do: "from the debugger"
- makeBaseFrameFor:
- quickFetchInteger:ofObject:
- frameOfMarriedContext:
- objCouldBeClassObj:
- isMarriedOrWidowedContext:
- shortPrint:
bytecodePrimAt
bytecodePrimAtPut
+ bytesOrInt:growTo:
+ ceBaseFrameReturn:
+ checkIsStillMarriedContext:currentFP:
+ checkedIntegerValueOf:
+ cogMethodDoesntLookKosher:
commonAt:
commonAtPut:
+ commonVariable:at:put:cacheIndex:
- loadFloatOrIntFrom:
- positive32BitValueOf:
- primitiveExternalCall
- checkedIntegerValueOf:
- bytecodePrimAtPut
- commonAtPut:
- primitiveVMParameter
- checkIsStillMarriedContext:currentFP:
- displayBitsOf:Left:Top:Right:Bottom:
- fetchStackPointerOf:
- primitiveContextAt
- primitiveContextAtPut
- subscript:with:storing:format:
- printContext:
compare31or32Bits:equal:
+ digitBitLogic:with:opIndex:
- signed64BitValueOf:
- primDigitMultiply:negative:
digitLength:
+ displayBitsOf:Left:Top:Right:Bottom:
+ ensureContextHasBytecodePC:
+ externalInstVar:ofContext:
+ fetchIntOrFloat:ofObject:
+ fetchIntOrFloat:ofObject:ifNil:
+ fetchStackPointerOf:
- isNegativeIntegerValueOf:
- magnitude64BitValueOf:
- primitiveMakePoint
- primitiveAsCharacter
- primitiveInputSemaphore
- baseFrameReturn
- primitiveExternalCall
- primDigitCompare:
- isLiveContext:
- numPointerSlotsOf:
fileValueOf:
+ frameOfMarriedContext:
+ functionForPrimitiveExternalCall:
+ genSpecialSelectorArithmetic
+ genSpecialSelectorComparison
+ inlineCacheTagForInstance:
+ instVar:ofContext:
+ isCogMethodReference:
+ isLiveContext:
+ isMarriedOrWidowedContext:
+ isNegativeIntegerValueOf:
+ isNormalized:
loadBitBltDestForm
- fetchIntOrFloat:ofObject:ifNil:
- fetchIntOrFloat:ofObject:
loadBitBltSourceForm
+ loadFloatOrIntFrom:
loadPoint:from:
+ magnitude64BitValueOf:
+ makeBaseFrameFor:
+ numPointerSlotsOf:
+ objCouldBeClassObj:
+ on:do: "from the debugger"
+ positive32BitValueOf:
- primDigitAdd:
- primDigitSubtract:
positive64BitValueOf:
+ primDigitAdd:
+ primDigitBitShiftMagnitude:
+ primDigitCompare:
- digitBitLogic:with:opIndex:
- signed32BitValueOf:
- isNormalized:
primDigitDiv:negative:
+ primDigitMultiply:negative:
+ primDigitSubtract:
+ primitiveAllInstances
+ primitiveAsCharacter
+ primitiveContextAt
+ primitiveContextAtPut
+ primitiveExternalCall
+ primitiveFileSetPosition
+ primitiveFileTruncate DoIt
+ primitiveForwardSignalToSemaphore
+ primitiveGrowMemoryByAtLeast
+ primitiveInputSemaphore
+ primitiveMakePoint
- bytesOrInt:growTo:
primitiveNewMethod
- isCogMethodReference:
- functionForPrimitiveExternalCall:
- genSpecialSelectorArithmetic
- genSpecialSelectorComparison
- ensureContextHasBytecodePC:
- instVar:ofContext:
- ceBaseFrameReturn:
- inlineCacheTagForInstance:
primitiveObjectAtPut
- commonVariable:at:put:cacheIndex:
- primDigitBitShiftMagnitude:
- externalInstVar:ofContext:
- primitiveGrowMemoryByAtLeast
- primitiveFileSetPosition
- cogMethodDoesntLookKosher:
- shortPrintOop:
primitiveSizeInBytesOfInstance
+ primitiveVMParameter
+ printContext:
+ quickFetchInteger:ofObject:
+ shortPrint:
+ shortPrintOop:
+ signed32BitValueOf:
+ signed64BitValueOf:
+ subscript:with:storing:format:
+ unlockSurfaces) includes: sel) ifFalse:
- bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
- primitiveForwardSignalToSemaphore) includes: sel) ifFalse:
[self halt].
^super isIntegerObject: oop!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
- (fullGCFlag
- ifTrue: [self leakCheckFullGC]
- ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
- [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
- ^super runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ (fullGCFlag
+ ifTrue: [self leakCheckFullGC]
+ ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
+ [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
+ ^super
+ runLeakCheckerForFullGC: fullGCFlag
+ excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
+ classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was changed:
----- Method: Spur32BitMMLESimulator>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
"This list records the valid senders of isIntegerObject: as we replace uses of
isIntegerObject: by isImmediate: where appropriate."
| sel |
sel := thisContext sender method selector.
(#( DoIt
DoItIn:
+ baseFrameReturn
+ bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
- on:do: "from the debugger"
- makeBaseFrameFor:
- quickFetchInteger:ofObject:
- frameOfMarriedContext:
- objCouldBeClassObj:
- isMarriedOrWidowedContext:
- shortPrint:
bytecodePrimAt
bytecodePrimAtPut
+ bytesOrInt:growTo:
+ ceBaseFrameReturn:
+ checkIsStillMarriedContext:currentFP:
+ checkedIntegerValueOf:
+ cogMethodDoesntLookKosher:
commonAt:
commonAtPut:
+ commonVariable:at:put:cacheIndex:
- loadFloatOrIntFrom:
- positive32BitValueOf:
- primitiveExternalCall
- checkedIntegerValueOf:
- bytecodePrimAtPut
- commonAtPut:
- primitiveVMParameter
- checkIsStillMarriedContext:currentFP:
- displayBitsOf:Left:Top:Right:Bottom:
- fetchStackPointerOf:
- primitiveContextAt
- primitiveContextAtPut
- subscript:with:storing:format:
- printContext:
compare31or32Bits:equal:
+ digitBitLogic:with:opIndex:
- signed64BitValueOf:
- primDigitMultiply:negative:
digitLength:
+ displayBitsOf:Left:Top:Right:Bottom:
+ ensureContextHasBytecodePC:
+ externalInstVar:ofContext:
+ fetchIntOrFloat:ofObject:
+ fetchIntOrFloat:ofObject:ifNil:
+ fetchStackPointerOf:
- isNegativeIntegerValueOf:
- magnitude64BitValueOf:
- primitiveMakePoint
- primitiveAsCharacter
- primitiveInputSemaphore
- baseFrameReturn
- primitiveExternalCall
- primDigitCompare:
- isLiveContext:
- numPointerSlotsOf:
fileValueOf:
+ frameOfMarriedContext:
+ functionForPrimitiveExternalCall:
+ genSpecialSelectorArithmetic
+ genSpecialSelectorComparison
+ inlineCacheTagForInstance:
+ instVar:ofContext:
+ isCogMethodReference:
+ isLiveContext:
+ isMarriedOrWidowedContext:
+ isNegativeIntegerValueOf:
+ isNormalized:
loadBitBltDestForm
- fetchIntOrFloat:ofObject:ifNil:
- fetchIntOrFloat:ofObject:
loadBitBltSourceForm
+ loadFloatOrIntFrom:
loadPoint:from:
+ magnitude64BitValueOf:
+ makeBaseFrameFor:
+ numPointerSlotsOf:
+ objCouldBeClassObj:
+ on:do: "from the debugger"
+ positive32BitValueOf:
- primDigitAdd:
- primDigitSubtract:
positive64BitValueOf:
+ primDigitAdd:
+ primDigitBitShiftMagnitude:
+ primDigitCompare:
- digitBitLogic:with:opIndex:
- signed32BitValueOf:
- isNormalized:
primDigitDiv:negative:
+ primDigitMultiply:negative:
+ primDigitSubtract:
+ primitiveAllInstances
+ primitiveAsCharacter
+ primitiveContextAt
+ primitiveContextAtPut
+ primitiveExternalCall
+ primitiveFileSetPosition
+ primitiveFileTruncate DoIt
+ primitiveForwardSignalToSemaphore
+ primitiveGrowMemoryByAtLeast
+ primitiveInputSemaphore
+ primitiveMakePoint
- bytesOrInt:growTo:
primitiveNewMethod
- isCogMethodReference:
- functionForPrimitiveExternalCall:
- genSpecialSelectorArithmetic
- genSpecialSelectorComparison
- ensureContextHasBytecodePC:
- instVar:ofContext:
- ceBaseFrameReturn:
- inlineCacheTagForInstance:
primitiveObjectAtPut
+ primitiveSizeInBytesOfInstance
+ primitiveVMParameter
+ printContext:
+ quickFetchInteger:ofObject:
+ shortPrint:
+ shortPrintOop:
+ signed32BitValueOf:
+ signed64BitValueOf:
+ subscript:with:storing:format:
+ unlockSurfaces) includes: sel) ifFalse:
- commonVariable:at:put:cacheIndex:
- primDigitBitShiftMagnitude:
- externalInstVar:ofContext:
- primitiveGrowMemoryByAtLeast
- primitiveFileSetPosition
- bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
- shortPrintOop:) includes: sel) ifFalse:
[self halt].
^super isIntegerObject: oop!
Item was removed:
- ----- Method: Spur32BitMMLESimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
- (fullGCFlag
- ifTrue: [self leakCheckFullGC]
- ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
- [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
- ^super runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ (fullGCFlag
+ ifTrue: [self leakCheckFullGC]
+ ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
+ [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
+ ^super
+ runLeakCheckerForFullGC: fullGCFlag
+ excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
+ classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was changed:
----- Method: SpurMemoryManager>>allocateBytes:classIndex: (in category 'allocation') -----
allocateBytes: numBytes classIndex: classIndex
"Allocate an object of numBytes. Answer nil if no available memory.
classIndex must be that of a byte class (e.g. ByteString).
The object is *NOT FILLED*."
self assert: (coInterpreter addressCouldBeClassObj: (self classAtIndex: classIndex)).
self assert: (self instSpecOfClass: (self classAtIndex: classIndex)) = self firstByteFormat.
^self
allocateSlots: (numBytes + self bytesPerSlot - 1 // self bytesPerSlot)
+ format: (self byteFormatForNumBytes: numBytes)
- format: self firstByteFormat + (self bytesPerSlot - numBytes bitAnd: self bytesPerSlot - 1)
classIndex: classIndex!
Item was removed:
- ----- Method: SpurMemoryManager>>checkHeapIntegrity: (in category 'debug support') -----
- checkHeapIntegrity: excludeUnmarkedNewSpaceObjs
- "Perform an integrity/leak check using the heapMap. Assume
- clearLeakMapAndMapAccessibleObjects has set a bit at each
- object's header. Scan all objects in the heap checking that every
- pointer points to a header. Scan the rootTable, remapBuffer and
- extraRootTable checking that every entry is a pointer to a header.
- Check that the number of roots is correct and that all rootTable
- entries have their rootBit set. Answer if all checks pass."
- | ok numRememberedRootsInHeap |
- <inline: false>
- ok := true.
- numRememberedRootsInHeap := 0.
- self allHeapEntitiesDo:
- [:obj| | containsYoung fieldOop classIndex classOop |
- ((self isFreeObject: obj)
- or: [(self isYoungObject: obj) and: [(self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]]]) ifFalse:
- [containsYoung := false.
- (self isRemembered: obj) ifTrue:
- [numRememberedRootsInHeap := numRememberedRootsInHeap + 1.
- (scavenger isInRememberedSet: obj) ifFalse:
- [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
- self eek.
- ok := false]].
- (self isForwarded: obj)
- ifTrue:
- [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
- (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
- [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
- self eek.
- ok := false].
- (self isYoung: fieldOop) ifTrue:
- [containsYoung := true]]
- ifFalse:
- [classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
- (classOop = nilObj
- and: [(self isHiddenObj: obj) not]) ifTrue:
- [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
- self eek.
- ok := false].
- self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do:
- [:ptr|
- fieldOop := self longAt: obj + ptr.
- (self isNonImmediate: fieldOop) ifTrue:
- [| fi |
- fi := ptr - self baseHeaderSize / self wordSize.
- (fieldOop bitAnd: self wordSize - 1) ~= 0
- ifTrue:
- [coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
- self eek.
- ok := false]
- ifFalse:
- [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
- [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
- self eek.
- ok := false].
- "don't be misled by CogMethods; they appear to be young, but they're not"
- ((self isYoung: fieldOop)
- and: [self oop: fieldOop isGreaterThanOrEqualTo: newSpaceStart]) ifTrue:
- [containsYoung := true]]]]].
- (containsYoung and: [(self isYoung: obj) not]) ifTrue:
- [(self isRemembered: obj) ifFalse:
- [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
- self eek.
- ok := false]]]].
- numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
- [coInterpreter
- print: 'root count mismatch. #heap roots ';
- printNum: numRememberedRootsInHeap;
- print: '; #roots ';
- printNum: scavenger rememberedSetSize;
- cr.
- self eek.
- "But the system copes with overflow..."
- self flag: 'no support for remembered set overflow yet'.
- "ok := rootTableOverflowed and: [needGCFlag]"].
- scavenger rememberedSetWithIndexDo:
- [:obj :i|
- (obj bitAnd: self wordSize - 1) ~= 0
- ifTrue:
- [coInterpreter print: 'misaligned oop in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
- self eek.
- ok := false]
- ifFalse:
- [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
- ifTrue:
- [coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
- self eek.
- ok := false]
- ifFalse:
- [(self isYoung: obj) ifTrue:
- [coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
- self eek.
- ok := false]]]].
- 1 to: remapBufferCount do:
- [:ri| | obj |
- obj := remapBuffer at: ri.
- (obj bitAnd: self wordSize - 1) ~= 0
- ifTrue:
- [coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
- self eek.
- ok := false]
- ifFalse:
- [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
- [coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
- self eek.
- ok := false]]].
- 1 to: extraRootCount do:
- [:ri| | obj |
- obj := (extraRoots at: ri) at: 0.
- (obj bitAnd: self wordSize - 1) ~= 0
- ifTrue:
- [coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
- self eek.
- ok := false]
- ifFalse:
- [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
- [coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
- self eek.
- ok := false]]].
- ^ok!
Item was added:
+ ----- Method: SpurMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
+ checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ "Perform an integrity/leak check using the heapMap. Assume
+ clearLeakMapAndMapAccessibleObjects has set a bit at each
+ object's header. Scan all objects in the heap checking that every
+ pointer points to a header. Scan the rootTable, remapBuffer and
+ extraRootTable checking that every entry is a pointer to a header.
+ Check that the number of roots is correct and that all rootTable
+ entries have their rootBit set. Answer if all checks pass."
+ | ok numRememberedRootsInHeap |
+ <inline: false>
+ ok := true.
+ numRememberedRootsInHeap := 0.
+ self allHeapEntitiesDo:
+ [:obj| | containsYoung fieldOop classIndex classOop |
+ ((self isFreeObject: obj)
+ or: [(self isYoungObject: obj) and: [(self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]]]) ifFalse:
+ [containsYoung := false.
+ (self isRemembered: obj) ifTrue:
+ [numRememberedRootsInHeap := numRememberedRootsInHeap + 1.
+ (scavenger isInRememberedSet: obj) ifFalse:
+ [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
+ self eek.
+ ok := false]].
+ (self isForwarded: obj)
+ ifTrue:
+ [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
+ (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
+ self eek.
+ ok := false].
+ (self isYoung: fieldOop) ifTrue:
+ [containsYoung := true]]
+ ifFalse:
+ [classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
+ (classIndicesShouldBeValid
+ and: [classOop = nilObj
+ and: [(self isHiddenObj: obj) not]]) ifTrue:
+ [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
+ self eek.
+ ok := false].
+ self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do:
+ [:ptr|
+ fieldOop := self longAt: obj + ptr.
+ (self isNonImmediate: fieldOop) ifTrue:
+ [| fi |
+ fi := ptr - self baseHeaderSize / self wordSize.
+ (fieldOop bitAnd: self wordSize - 1) ~= 0
+ ifTrue:
+ [coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
+ self eek.
+ ok := false]
+ ifFalse:
+ [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
+ self eek.
+ ok := false].
+ "don't be misled by CogMethods; they appear to be young, but they're not"
+ ((self isYoung: fieldOop)
+ and: [self oop: fieldOop isGreaterThanOrEqualTo: newSpaceStart]) ifTrue:
+ [containsYoung := true]]]]].
+ (containsYoung and: [(self isYoung: obj) not]) ifTrue:
+ [(self isRemembered: obj) ifFalse:
+ [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
+ self eek.
+ ok := false]]]].
+ numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
+ [coInterpreter
+ print: 'root count mismatch. #heap roots ';
+ printNum: numRememberedRootsInHeap;
+ print: '; #roots ';
+ printNum: scavenger rememberedSetSize;
+ cr.
+ self eek.
+ "But the system copes with overflow..."
+ self flag: 'no support for remembered set overflow yet'.
+ "ok := rootTableOverflowed and: [needGCFlag]"].
+ scavenger rememberedSetWithIndexDo:
+ [:obj :i|
+ (obj bitAnd: self wordSize - 1) ~= 0
+ ifTrue:
+ [coInterpreter print: 'misaligned oop in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
+ self eek.
+ ok := false]
+ ifFalse:
+ [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
+ ifTrue:
+ [coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
+ self eek.
+ ok := false]
+ ifFalse:
+ [(self isYoung: obj) ifTrue:
+ [coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
+ self eek.
+ ok := false]]]].
+ 1 to: remapBufferCount do:
+ [:ri| | obj |
+ obj := remapBuffer at: ri.
+ (obj bitAnd: self wordSize - 1) ~= 0
+ ifTrue:
+ [coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
+ self eek.
+ ok := false]
+ ifFalse:
+ [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
+ [coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
+ self eek.
+ ok := false]]].
+ 1 to: extraRootCount do:
+ [:ri| | obj |
+ obj := (extraRoots at: ri) at: 0.
+ (obj bitAnd: self wordSize - 1) ~= 0
+ ifTrue:
+ [coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
+ self eek.
+ ok := false]
+ ifFalse:
+ [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
+ [coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
+ self eek.
+ ok := false]]].
+ ^ok!
Item was added:
+ ----- Method: SpurMemoryManager>>fullDisplayUpdate (in category 'simulation only') -----
+ fullDisplayUpdate
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter fullDisplayUpdate!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
self runLeakCheckerForFullGC: true.
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self markObjects.
self nilUnmarkedWeaklingSlots.
self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace.
+ self runLeakCheckerForFullGC: true excludeUnmarkedNewSpaceObjs: true classIndicesShouldBeValid: false.
- self runLeakCheckerForFullGC: true excludeUnmarkedNewSpaceObjs: true.
self compact.
self eliminateAndFreeForwarders.
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self assert: self allObjectsUnmarked.
self runLeakCheckerForFullGC: true!
Item was changed:
----- Method: SpurMemoryManager>>inPlaceBecome:and:copyHashFlag: (in category 'become implementation') -----
inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag
"Do become in place by swapping object contents."
+ | headerTemp temp1 temp2 o1HasYoung o2HasYoung fmt |
- | headerTemp temp1 temp2 o1HasYoung o2HasYoung |
self assert: (self numSlotsOf: obj1) = (self numSlotsOf: obj2).
"swap headers, but swapping headers swaps remembered bits;
these need to be unswapped."
temp1 := self isRemembered: obj1.
temp2 := self isRemembered: obj2.
headerTemp := self longLongAt: obj1.
self longLongAt: obj1 put: (self longLongAt: obj2).
self longLongAt: obj2 put: headerTemp.
self setIsRememberedOf: obj1 to: temp1.
self setIsRememberedOf: obj2 to: temp2.
"swapping headers swaps hash; if !!copyHashFlag undo hash copy"
copyHashFlag ifFalse:
[temp1 := self rawHashBitsOf: obj1.
self setHashBitsOf: obj1 to: (self rawHashBitsOf: obj2).
self setHashBitsOf: obj2 to: temp1].
o1HasYoung := o2HasYoung := false.
0 to: (self numSlotsOf: obj1) - 1 do:
[:i|
temp1 := self fetchPointer: i ofObject: obj1.
temp2 := self fetchPointer: i ofObject: obj2.
self storePointerUnchecked: i
ofObject: obj1
withValue: temp2.
self storePointerUnchecked: i
ofObject: obj2
withValue: temp1.
(self isYoung: temp2) ifTrue:
[o1HasYoung := true].
(self isYoung: temp1) ifTrue:
[o2HasYoung := true]].
(self isOldObject: obj1) ifTrue:
+ [fmt := self formatOf: obj1.
+ (o1HasYoung and: [(self isPureBitsFormat: fmt) not]) ifTrue:
- [o1HasYoung ifTrue:
[self possibleRootStoreInto: obj1]].
(self isOldObject: obj2) ifTrue:
+ [fmt := self formatOf: obj2.
+ (o2HasYoung and: [(self isPureBitsFormat: fmt) not]) ifTrue:
- [o2HasYoung ifTrue:
[self possibleRootStoreInto: obj2]]!
Item was changed:
----- Method: SpurMemoryManager>>runLeakCheckerForFullGC: (in category 'debug support') -----
runLeakCheckerForFullGC: fullGCFlag
+ ^self runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: false classIndicesShouldBeValid: true!
- ^self runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: false!
Item was removed:
- ----- Method: SpurMemoryManager>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
- <inline: false>
- (fullGCFlag
- ifTrue: [self leakCheckFullGC]
- ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
- [fullGCFlag
- ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
- ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
- self clearLeakMapAndMapAccessibleObjects.
- self assert: (self checkHeapIntegrity: excludeUnmarkedNewSpaceObjs).
- self assert: coInterpreter checkInterpreterIntegrity.
- self assert: coInterpreter checkStackIntegrity.
- self assert: (coInterpreter checkCodeIntegrity: fullGCFlag)]!
Item was added:
+ ----- Method: SpurMemoryManager>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ <inline: false>
+ (fullGCFlag
+ ifTrue: [self leakCheckFullGC]
+ ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
+ [fullGCFlag
+ ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
+ ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
+ self clearLeakMapAndMapAccessibleObjects.
+ self assert: (self checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid).
+ self assert: coInterpreter checkInterpreterIntegrity.
+ self assert: coInterpreter checkStackIntegrity.
+ self assert: (coInterpreter checkCodeIntegrity: fullGCFlag)]!
Item was changed:
----- Method: StackInterpreter>>followForwardedFrameContents:stackPointer: (in category 'lazy become') -----
followForwardedFrameContents: theFP stackPointer: theSP
"follow pointers in the current stack frame up to theSP."
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #ptr type: #'char *'>
theFP + (self frameStackedReceiverOffset: theFP)
to: theFP + FoxCallerSavedIP + BytesPerWord
by: BytesPerWord
do: [:ptr| | oop |
oop := stackPages longAt: ptr.
((objectMemory isNonImmediate: oop)
and: [objectMemory isForwarded: oop]) ifTrue:
[stackPages longAt: ptr put: (objectMemory followForwarded: oop)]].
theSP
to: (self frameReceiverOffset: theFP)
by: BytesPerWord
do: [:ptr| | oop |
oop := stackPages longAt: ptr.
((objectMemory isNonImmediate: oop)
and: [objectMemory isForwarded: oop]) ifTrue:
[stackPages longAt: ptr put: (objectMemory followForwarded: oop)]].
+ self assert: (objectMemory isForwarded: (self frameMethodObject: theFP)) not.
- self assert: (objectMemory isForwarded: (self frameMethod: theFP)) not.
(self frameHasContext: theFP) ifTrue:
[self assert: (objectMemory isForwarded: (self frameContext: theFP)) not]!
Item was added:
+ ----- Method: StackInterpreter>>getDeferDisplayUpdates (in category 'simulation support') -----
+ getDeferDisplayUpdates
+ <doNotGenerate>
+ ^deferDisplayUpdates!
Item was changed:
----- Method: StackInterpreter>>positive64BitIntegerFor: (in category 'primitive support') -----
positive64BitIntegerFor: integerValue
+ <var: 'integerValue' type: #sqLong>
+ "Answer a Large Positive Integer object for the given integer value. N.B. will *not* cause a GC."
- <var: 'integerValue' type: 'sqLong'>
| newLargeInteger highWord sz |
- "N.B. will *not* cause a GC.
- integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:."
highWord := self cCode: 'integerValue >> 32' inSmalltalk: [integerValue >> 32]. "shift is coerced to usqInt otherwise"
highWord = 0 ifTrue:[^self positive32BitIntegerFor: integerValue].
sz := 5.
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
newLargeInteger := objectMemory
eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
format: (objectMemory byteFormatForNumBytes: sz)
numSlots: 8 / objectMemory bytesPerSlot.
objectMemory
storeByte: 7 ofObject: newLargeInteger withValue: (integerValue >> 56 bitAnd: 16rFF);
storeByte: 6 ofObject: newLargeInteger withValue: (integerValue >> 48 bitAnd: 16rFF);
storeByte: 5 ofObject: newLargeInteger withValue: (integerValue >> 40 bitAnd: 16rFF);
storeByte: 4 ofObject: newLargeInteger withValue: (integerValue >> 32 bitAnd: 16rFF);
storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF);
storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF);
storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >> 8 bitAnd: 16rFF);
storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF).
^newLargeInteger
!
Item was changed:
----- Method: StackInterpreter>>signed32BitIntegerFor: (in category 'primitive support') -----
signed32BitIntegerFor: integerValue
+ "Answer a full 32 bit integer object for the given integer value."
- "Return a full 32 bit integer object for the given integer value"
| newLargeInteger value largeClass |
<inline: false>
(objectMemory isIntegerValue: integerValue) ifTrue:
[^objectMemory integerObjectOf: integerValue].
+ integerValue < 0
+ ifTrue: [largeClass := ClassLargeNegativeIntegerCompactIndex.
+ value := 0 - integerValue]
+ ifFalse: [largeClass := ClassLargePositiveIntegerCompactIndex.
+ value := integerValue].
+ newLargeInteger := objectMemory
+ eeInstantiateSmallClassIndex: largeClass
+ format: (objectMemory byteFormatForNumBytes: 4)
+ numSlots: 1.
- objectMemory hasSpurMemoryManagerAPI
- ifTrue:
- [integerValue < 0
- ifTrue: [largeClass := ClassLargeNegativeIntegerCompactIndex.
- value := 0 - integerValue]
- ifFalse: [largeClass := ClassLargePositiveIntegerCompactIndex.
- value := integerValue].
- objectMemory allocateBytes: 4 classIndex: largeClass]
- ifFalse:
- [integerValue < 0
- ifTrue: [largeClass := objectMemory classLargeNegativeInteger.
- value := 0 - integerValue]
- ifFalse: [largeClass := objectMemory classLargePositiveInteger.
- value := integerValue].
- newLargeInteger := objectMemory eeInstantiateClass: largeClass indexableSize: 4].
objectMemory storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF).
objectMemory storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF).
objectMemory storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF).
objectMemory storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF).
^newLargeInteger!
Item was changed:
----- Method: StackInterpreter>>signed64BitIntegerFor: (in category 'primitive support') -----
signed64BitIntegerFor: integerValue
- "Return a Large Integer object for the given integer value"
- | newLargeInteger magnitude largeClass intValue highWord sz |
- <inline: false>
<var: 'integerValue' type: #sqLong>
+ "Answer a Large Integer object for the given integer value. N.B. will *not* cause a GC."
+ | newLargeInteger magnitude largeClass highWord sz |
+ <inline: false>
<var: 'magnitude' type: #sqLong>
<var: 'highWord' type: #usqInt>
integerValue < 0
+ ifTrue:[ largeClass := ClassLargeNegativeIntegerCompactIndex.
- ifTrue:[ largeClass := objectMemory classLargeNegativeInteger.
magnitude := 0 - integerValue]
+ ifFalse:[ largeClass := ClassLargePositiveIntegerCompactIndex.
- ifFalse:[ largeClass := objectMemory classLargePositiveInteger.
magnitude := integerValue].
"Make sure to handle the most -ve value correctly. 0 - most -ve = most -ve and most -ve - 1
is +ve. Alas the simple (negative or: [integerValue - 1 < 0]) fails with contemporary gcc and icc
versions with optimization and sometimes without. The shift works on all, touch wood."
(magnitude <= 16r7FFFFFFF
and: [integerValue >= 0
or: [0 ~= (self cCode: [integerValue << 1]
inSmalltalk: [integerValue << 1 bitAnd: (1 << 64) - 1])]]) ifTrue:
[^self signed32BitIntegerFor: integerValue].
highWord := magnitude >> 32.
highWord = 0
ifTrue:[sz := 4]
ifFalse:
[sz := 5.
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1]].
+ newLargeInteger := objectMemory
+ eeInstantiateSmallClassIndex: largeClass
+ format: (objectMemory byteFormatForNumBytes: sz)
+ numSlots: sz + 3 // objectMemory bytesPerSlot.
+ sz > 4 ifTrue:
+ [objectMemory
+ storeByte: 7 ofObject: newLargeInteger withValue: (magnitude >> 56 bitAnd: 16rFF);
+ storeByte: 6 ofObject: newLargeInteger withValue: (magnitude >> 48 bitAnd: 16rFF);
+ storeByte: 5 ofObject: newLargeInteger withValue: (magnitude >> 40 bitAnd: 16rFF);
+ storeByte: 4 ofObject: newLargeInteger withValue: (magnitude >> 32 bitAnd: 16rFF)].
+ objectMemory
+ storeByte: 3 ofObject: newLargeInteger withValue: (magnitude >> 24 bitAnd: 16rFF);
+ storeByte: 2 ofObject: newLargeInteger withValue: (magnitude >> 16 bitAnd: 16rFF);
+ storeByte: 1 ofObject: newLargeInteger withValue: (magnitude >> 8 bitAnd: 16rFF);
+ storeByte: 0 ofObject: newLargeInteger withValue: (magnitude ">> 0" bitAnd: 16rFF).
- newLargeInteger := objectMemory instantiateClass: largeClass indexableSize: sz.
- 0 to: sz-1 do: [:i |
- intValue := (magnitude >> (i * 8)) bitAnd: 255.
- objectMemory storeByte: i ofObject: newLargeInteger withValue: intValue].
^newLargeInteger!
Item was changed:
StackInterpreterPrimitives subclass: #StackInterpreterSimulator
+ instanceVariableNames: 'bootstrapping byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES'
- instanceVariableNames: 'bootstrapping byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-InterpreterSimulation'!
!StackInterpreterSimulator commentStamp: 'eem 9/3/2013 11:05' prior: 0!
This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.
To see the thing actually run, you could (after backing up this image and changes), execute
(StackInterpreterSimulator new openOn: Smalltalk imageName) test
((StackInterpreterSimulator newWithOptions: #(NewspeakVM true MULTIPLEBYTECODESETS true))
openOn: 'ns101.image') test
and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image.
Here's an example of what Eliot uses to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff:
| vm |
vm := StackInterpreterSimulator newWithOptions: #().
vm openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'.
vm setBreakSelector: #&.
vm openAsMorph; run!
Item was changed:
----- Method: StackInterpreterSimulator>>fullDisplayUpdate (in category 'debug support') -----
fullDisplayUpdate
- "Preserve self successful when call asynchronously from Simulator"
| primFailCodeValue |
+ self break.
primFailCodeValue := primFailCode.
self initPrimCall.
super fullDisplayUpdate.
primFailCode := primFailCodeValue!
Item was changed:
----- Method: StackInterpreterSimulator>>incrementByteCount (in category 'interpreter shell') -----
incrementByteCount
(byteCount := byteCount + 1) = breakCount ifTrue:
[self doOrDefer: [self changed: #byteCountText].
self halt].
byteCount \\ 1000 = 0 ifTrue:
[self doOrDefer: [self changed: #byteCountText].
+ self forceInterruptCheck]!
- self forceInterruptCheck.
- byteCount \\ 1000 = 0 ifTrue: [self fullDisplayUpdate]] "tty. denominator was 10000 before event forwarding. Refactor me."!
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."
bootstrapping := false.
transcript := Transcript.
objectMemory ifNil:
[objectMemory := self class objectMemoryClass simulatorClass new].
objectMemory coInterpreter: self.
"Note: we must initialize ConstMinusOne differently for simulation,
due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := objectMemory integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
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 := Time totalSeconds * 1000000.
"initialize InterpreterSimulator variables used for debugging"
byteCount := 0.
sendCount := 0.
+ quitBlock := [^self].
- quitBlock := [^ self].
traceOn := true.
printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
displayForm := '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 in run can be turned off for simulation speed"!
- disableBooleanCheat := false!
Item was changed:
----- Method: StackInterpreterSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitive support') -----
ioRelinquishProcessorForMicroseconds: microseconds
"In the simulator give an indication that we're idling and check for input."
Display reverse: (0 at 0 extent: 16 at 16).
Sensor peekEvent ifNotNil:
[self forceInterruptCheck].
Processor activeProcess == Project uiProcess ifTrue:
[World doOneCycle].
microseconds >= 1000
ifTrue: [(Delay forMilliseconds: microseconds + 999 // 1000) wait]
+ ifFalse: [Processor yield].
+ "And increase the byteCount form which the microsecond clock is derived..."
+ byteCount := byteCount + microseconds - 1.
+ self incrementByteCount!
- ifFalse: [Processor yield]!
Item was removed:
- ----- Method: StackInterpreterSimulator>>primitiveScreenSize (in category 'I/O primitives') -----
- primitiveScreenSize
- | size |
- size := self desiredDisplayExtent min: 800 at 640.
- self pop: 1 thenPush: (self makePointwithxValue: size x yValue: size y)!
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].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
+ [assertVEPAES ifTrue: [self assertValidExecutionPointers].
- [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>>utilitiesMenu: (in category 'UI') -----
utilitiesMenu: aMenuMorph
aMenuMorph
add: 'toggle transcript' action: #toggleTranscript;
add: 'clone VM' action: #cloneSimulation;
addLine;
add: 'print ext head frame' action: #printExternalHeadFrame;
add: 'print int head frame' action: #printHeadFrame;
add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
add: 'print call stack' action: #printCallStack;
add: 'print stack call stack' action: #printStackCallStack;
add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
add: 'print all stacks' action: #printAllStacks;
add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
self writeBackHeadFramePointers];
add: 'print prim trace log' action: #dumpPrimTraceLog;
addLine;
add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
addLine;
add: 'inspect object memory' target: objectMemory action: #inspect;
add: 'inspect interpreter' action: #inspect;
addLine;
add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
s notEmpty ifTrue: [self setBreakSelector: s]];
+ add: 'turn valid exec ptrs assert o', (assertVEPAES ifTrue: ['ff'] ifFalse: ['n']) action: [assertVEPAES := assertVEPAES not];
add: (printSends
ifTrue: ['no print sends']
ifFalse: ['print sends'])
action: [self ensureDebugAtEachStepBlock.
printSends := printSends not];
"currently printReturns does nothing"
"add: (printReturns
ifTrue: ['no print returns']
ifFalse: ['print returns'])
action: [self ensureDebugAtEachStepBlock.
printReturns := printReturns not];"
add: (printBytecodeAtEachStep
ifTrue: ['no print bytecode each bytecode']
ifFalse: ['print bytecode each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printBytecodeAtEachStep := printBytecodeAtEachStep not];
add: (printFrameAtEachStep
ifTrue: ['no print frame each bytecode']
ifFalse: ['print frame each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printFrameAtEachStep := printFrameAtEachStep not].
^aMenuMorph!
Item was changed:
----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
inferTypesForImplicitlyTypedVariablesIn: aCodeGen
"infer types for untyped variables form assignments and arithmetic uses.
This for debugging:
(self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
| explicitlyTyped effectiveNodes |
explicitlyTyped := declarations keys asSet.
effectiveNodes := Dictionary new. "this for debugging"
parseTree nodesDo:
+ [:node| | type var |
- [:node| | type var m |
"If there is something of the form i >= 0, then i should be signed, not unsigned."
(node isSend
and: [(locals includes: (var := node receiver variableNameOrNil))
and: [(explicitlyTyped includes: var) not
and: [(#(<= < >= >) includes: node selector)
and: [node args first isConstant
and: [node args first value = 0
and: [(type := self typeFor: var in: aCodeGen) notNil
and: [type first == $u]]]]]]]) ifTrue:
[declarations at: var put: (declarations at: var) allButFirst.
effectiveNodes at: var put: { declarations at: var. node }].
"if an assignment of a known send, set the variable's type to the return type of the send."
(node isAssignment
and: [(locals includes: (var := node variable name))
and: [(declarations includesKey: var) not
and: [node expression isSend
+ and: [(type := aCodeGen returnTypeForSend: node expression) notNil]]]]) ifTrue:
+ [(#(sqInt void) includes: type) ifFalse:
- and: [(m := aCodeGen anyMethodNamed: node expression selector) notNil]]]]) ifTrue:
- [(#(sqInt void nil) includes: m returnType) ifFalse:
["the $: is to map things like unsigned field : 3 to usqInt"
declarations
at: var
+ put: ((type includes: $:) ifTrue: [#usqInt] ifFalse: [type]), ' ', var.
- put: ((m returnType includes: $:) ifTrue: [#usqInt] ifFalse: [m returnType]), ' ', var.
effectiveNodes at: var put: { declarations at: var. node }]]].
^effectiveNodes!
More information about the Vm-dev
mailing list