[Vm-dev] VM Maker: VMMaker.oscog-eem.638.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Mar 12 18:50:14 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.638.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.638
Author: eem
Time: 11 March 2014, 6:46:01.564 pm
UUID: 4c01acdf-1273-4319-aef5-fd3591c3dbe9
Ancestors: VMMaker.oscog-eem.637
Add primitiveAllInstances and modify primitiveAllObjects so that
both will grow memory to guarantee their results.
Modify Objectmemory/SpurMemoryManager>>allObjects &
allInstancesOf: to answer the count of objects when they run out of
space so that teh primitives can grow and retry.
Change the time primtiives to access the time now, not the time as
updated by the heartbeat (but /don't/ change the time basis for
event checking. This for performance because use of gettimeofday
in e.g. stack overflow can be a signficant performance overhead.
Move the simulated time implementations (ioSeconds et al) up to
StackInterpreter to reduce duplication.
Spur:
Assert that the markStack and weaklingStack are empty at system
startup and at start of GC (allInstancesOf: et al went though a buggy
phase where weaklingStack was left full).
Fix assert in popObjStack: now that isValidObjStack: checks slots in
hiddenRootsObj.
=============== Diff against VMMaker.oscog-eem.637 ===============
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'].
^ value!
Item was changed:
----- Method: BalloonArray>>at:put: (in category 'memory access') -----
at: index put: value
super at: index put: (self bitsOf: value).
^ simArray at: index + 1 put: value.
!
Item was changed:
----- Method: BalloonArray>>bitsOf: (in category 'memory access') -----
bitsOf: value
"Convert pos and neg ints and floats to 32-bit representations expected by C"
value isInteger ifTrue:
[value >= 0 ifTrue: [^ value].
^ value + 16r80000000 + 16r80000000].
value isFloat ifTrue:
[^ value asIEEE32BitWord].
self error: 'unexpected value for 32 bits'.
^ 0!
Item was changed:
----- Method: BalloonArray>>floatAt: (in category 'memory access') -----
floatAt: index
| value |
value := self at: index.
value isFloat ifFalse:
[value = 0 ifTrue: [^ 0.0].
self error: 'non-float was stored'.
^ Float fromIEEE32Bit: value].
^ value!
Item was changed:
----- Method: BalloonArray>>floatAt:put: (in category 'memory access') -----
floatAt: index put: value
value isFloat
ifFalse: [self error: 'inconsistent values'].
^ self at: index put: value!
Item was changed:
----- Method: BalloonArray>>intAt: (in category 'memory access') -----
intAt: index
| value |
value := self at: index.
value isInteger
ifFalse: [self error: 'inconsistent values'].
^ value!
Item was changed:
----- Method: BalloonArray>>intAt:put: (in category 'memory access') -----
intAt: index put: value
value isInteger
ifFalse: [self error: 'inconsistent values'].
^ self at: index put: value!
Item was changed:
----- Method: BalloonArray>>setSimArray: (in category 'memory access') -----
setSimArray: anArray
simArray := anArray!
Item was changed:
----- Method: BalloonEngineSimulation>>debugDrawBezier: (in category 'debug support') -----
debugDrawBezier: line
| canvas p1 p2 p3 |
self assert:(self isBezier: line).
p1 := (self edgeXValueOf: line) @ (self edgeYValueOf: line) // self aaLevelGet.
p2 := (self bezierViaXOf: line) @ (self bezierViaYOf: line) // self aaLevelGet.
p3 := (self bezierEndXOf: line) @ (self bezierEndYOf: line) // self aaLevelGet.
canvas := Display getCanvas.
canvas
line: p1 to: p2 width: 2 color: Color blue;
line: p2 to: p3 width: 2 color: Color blue.!
Item was changed:
----- Method: BalloonEngineSimulation>>debugDrawEdge: (in category 'debug support') -----
debugDrawEdge: edge
self assert: (self isEdge: edge).
(self isLine: edge) ifTrue:[^self debugDrawLine: edge].
(self isBezier: edge) ifTrue:[^self debugDrawBezier: edge].
self halt.!
Item was changed:
----- Method: BalloonEngineSimulation>>debugDrawHLine: (in category 'debug support') -----
debugDrawHLine: yValue
| canvas |
canvas := Display getCanvas.
canvas
line: 0 @ (yValue // self aaLevelGet)
to: Display extent x @ (yValue // self aaLevelGet)
width: 2
color: Color green.!
Item was changed:
----- Method: BalloonEngineSimulation>>debugDrawLine: (in category 'debug support') -----
debugDrawLine: line
| canvas |
self assert: (self isLine: line).
canvas := Display getCanvas.
canvas
line: (self edgeXValueOf: line) @ (self edgeYValueOf: line) // self aaLevelGet
to: (self lineEndXOf: line) @ (self lineEndYOf: line) // self aaLevelGet
width: 2
color: Color red.!
Item was changed:
----- Method: BalloonEngineSimulation>>debugDrawLineFrom:to: (in category 'debug support') -----
debugDrawLineFrom: pt1 to: pt2
| canvas |
canvas := Display getCanvas.
canvas
line: (pt1 at: 0) @ (pt1 at: 1) // self aaLevelGet
to: (pt2 at: 0) @ (pt2 at: 1) // self aaLevelGet
width: 1
color: Color red.!
Item was changed:
----- Method: BalloonEngineSimulation>>debugDrawPt: (in category 'debug support') -----
debugDrawPt: pt
| canvas |
canvas := Display getCanvas.
canvas
fillRectangle:((pt-2) corner: pt+2) color: Color red!
Item was changed:
----- Method: BalloonEngineSimulation>>debugDrawPtLineFrom:to: (in category 'debug support') -----
debugDrawPtLineFrom: pt1 to: pt2
| canvas |
canvas := Display getCanvas.
canvas
line: pt1
to: pt2
width: 1
color: Color red.!
Item was changed:
----- Method: BalloonEngineSimulation>>debugPrintObjects (in category 'debug support') -----
debugPrintObjects
| object end |
<inline: false>
object := 0.
end := objUsed.
[object < end] whileTrue:[
Transcript cr;
nextPut:$#; print: object; space;
print: (self objectHeaderOf: object); space.
(self isEdge: object)
ifTrue:[Transcript nextPutAll:'(edge) '].
(self isFill:object)
ifTrue:[Transcript nextPutAll:'(fill) '].
Transcript print: (self objectLengthOf: object); space.
Transcript endEntry.
object := object + (self objectLengthOf: object).
].!
Item was changed:
----- Method: BalloonEngineSimulation>>debugPrintPoints: (in category 'debug support') -----
debugPrintPoints: n
Transcript cr.
n > 0 ifTrue:[
Transcript print: (self point1Get at: 0) @ (self point1Get at: 1); space.
].
n > 1 ifTrue:[
Transcript print: (self point2Get at: 0) @ (self point2Get at: 1); space.
].
n > 2 ifTrue:[
Transcript print: (self point3Get at: 0) @ (self point3Get at: 1); space.
].
n > 3 ifTrue:[
Transcript print: (self point4Get at: 0) @ (self point4Get at: 1); space.
].
Transcript endEntry.!
Item was changed:
----- Method: BalloonEngineSimulation>>printAET (in category 'debug support') -----
printAET
| edge |
Transcript cr; show:'************* ActiveEdgeTable **************'.
0 to: self aetUsedGet - 1 do:[:i|
edge := aetBuffer at: i.
Transcript cr;
print: i; space;
nextPutAll:'edge #';print: edge; space;
nextPutAll:'x: '; print: (self edgeXValueOf: edge); space;
nextPutAll:'y: '; print: (self edgeYValueOf: edge); space;
nextPutAll:'z: '; print: (self edgeZValueOf: edge); space;
nextPutAll:'fill0: '; print: (self edgeLeftFillOf: edge); space;
nextPutAll:'fill1: '; print: (self edgeRightFillOf: edge); space;
nextPutAll:'lines: '; print: (self edgeNumLinesOf: edge); space.
(self areEdgeFillsValid: edge) ifFalse:[Transcript nextPutAll:' disabled'].
Transcript endEntry.
].!
Item was changed:
----- Method: BalloonEngineSimulation>>printGET (in category 'debug support') -----
printGET
| edge |
Transcript cr; show:'************* GlobalEdgeTable **************'.
0 to: self getUsedGet - 1 do:[:i|
edge := getBuffer at: i.
Transcript cr;
print: i; space;
nextPutAll:'edge #';print: edge; space;
nextPutAll:'x: '; print: (self edgeXValueOf: edge); space;
nextPutAll:'y: '; print: (self edgeYValueOf: edge); space;
nextPutAll:'z: '; print: (self edgeZValueOf: edge); space;
nextPutAll:'fill0: '; print: (self edgeLeftFillOf: edge); space;
nextPutAll:'fill1: '; print: (self edgeRightFillOf: edge); space;
nextPutAll:'lines: '; print: (self edgeNumLinesOf: edge); space.
(self areEdgeFillsValid: edge) ifFalse:[Transcript nextPutAll:' disabled'].
Transcript endEntry.
].!
Item was changed:
----- Method: BalloonEngineSimulation>>quickPrint: (in category 'debug support') -----
quickPrint: curve
Transcript nextPut:$(;
print: curve start;
space;
print: curve via;
space;
print: curve end;
nextPut:$).!
Item was changed:
----- Method: BalloonEngineSimulation>>quickPrintBezier: (in category 'debug support') -----
quickPrintBezier: bezier
Transcript cr.
Transcript nextPut:$(;
print: (self edgeXValueOf: bezier)@(self edgeYValueOf: bezier);
space;
print: (self bezierViaXOf: bezier)@(self bezierViaYOf: bezier);
space;
print: (self bezierEndXOf: bezier)@(self bezierEndYOf: bezier);
nextPut:$).
Transcript endEntry.!
Item was changed:
----- Method: BalloonEngineSimulation>>quickPrintBezier:first: (in category 'debug support') -----
quickPrintBezier: index first: aBool
aBool ifTrue:[Transcript cr].
Transcript nextPut:$(;
print: (self bzStartX: index)@(self bzStartY: index);
space;
print: (self bzViaX: index)@(self bzViaY: index);
space;
print: (self bzEndX: index)@(self bzEndY: index);
nextPut:$).
Transcript endEntry.!
Item was changed:
----- Method: BitBltSimulation>>dstLongAt: (in category 'memory access') -----
dstLongAt: idx
^self long32At: idx!
Item was changed:
----- Method: BitBltSimulation>>dstLongAt:put: (in category 'memory access') -----
dstLongAt: idx put: value
^self long32At: idx put: value!
Item was changed:
----- Method: BitBltSimulation>>dstLongAt:put:mask: (in category 'memory access') -----
dstLongAt: idx put: srcValue mask: dstMask
"Store the given value back into destination form, using dstMask
to mask out the bits to be modified. This is an essiantial
read-modify-write operation on the destination form."
| dstValue |
<inline: true>
dstValue := self dstLongAt: idx.
dstValue := dstValue bitAnd: dstMask.
dstValue := dstValue bitOr: srcValue.
self dstLongAt: idx put: dstValue.!
Item was changed:
----- Method: BitBltSimulation>>halftoneAt: (in category 'memory access') -----
halftoneAt: idx
"Return a value from the halftone pattern."
^self long32At: halftoneBase + (idx \\ halftoneHeight * 4)!
Item was changed:
----- Method: BitBltSimulation>>srcLongAt: (in category 'memory access') -----
srcLongAt: idx
^self long32At: idx!
Item was changed:
----- Method: BitBltSimulation>>tallyMapAt: (in category 'memory access') -----
tallyMapAt: idx
"Return the word at position idx from the colorMap"
^cmLookupTable at: (idx bitAnd: cmMask)!
Item was changed:
----- Method: BitBltSimulation>>tallyMapAt:put: (in category 'memory access') -----
tallyMapAt: idx put: value
"Store the word at position idx in the colorMap"
^cmLookupTable at: (idx bitAnd: cmMask) put: value!
Item was changed:
----- Method: BitBltSimulator>>dstLongAt: (in category 'debug support') -----
dstLongAt: dstIndex
interpreterProxy isInterpreterProxy
ifTrue:[^dstIndex long32At: 0].
((dstIndex anyMask: 3) or:[dstIndex + 4 < destBits or:[
dstIndex > (destBits + (destPitch * destHeight))]])
ifTrue:[self error:'Out of bounds'].
^self long32At: dstIndex!
Item was changed:
----- Method: BitBltSimulator>>dstLongAt:put: (in category 'debug support') -----
dstLongAt: dstIndex put: value
interpreterProxy isInterpreterProxy
ifTrue:[^dstIndex long32At: 0 put: value].
((dstIndex anyMask: 3) or:[dstIndex < destBits or:[
dstIndex >= (destBits + (destPitch * destHeight))]])
ifTrue:[self error:'Out of bounds'].
^self long32At: dstIndex put: value!
Item was removed:
- ----- Method: BitBltSimulator>>long32At: (in category 'memory access') -----
- long32At: byteAddress
- ^interpreterProxy long32At: byteAddress!
Item was added:
+ ----- Method: BitBltSimulator>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+ ^interpreterProxy long32At: byteAddress!
Item was added:
+ ----- Method: BitBltSimulator>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ ^interpreterProxy long32At: byteAddress put: a32BitValue!
Item was removed:
- ----- Method: BitBltSimulator>>long32At:put: (in category 'memory access') -----
- long32At: byteAddress put: a32BitValue
- ^interpreterProxy long32At: byteAddress put: a32BitValue!
Item was changed:
----- Method: BitBltSimulator>>srcLongAt: (in category 'debug support') -----
srcLongAt: srcIndex
interpreterProxy isInterpreterProxy
ifTrue:[^srcIndex long32At: 0].
((srcIndex anyMask: 3) or:[srcIndex + 4 < sourceBits or:[
srcIndex > (sourceBits + (sourcePitch * sourceHeight))]])
ifTrue:[self error:'Out of bounds'].
^self long32At: srcIndex!
Item was changed:
----- Method: CoInterpreter>>assertValidExecutionPointe:r:s:imbar:line: (in category 'debug support') -----
assertValidExecutionPointe: lip r: lifp s: lisp imbar: inInterpreter line: ln
<var: #lip type: #usqInt>
<var: #lifp type: #'char *'>
<var: #lisp type: #'char *'>
| methodField cogMethod theIP |
<var: #cogMethod type: #'CogMethod *'>
self assert: stackPage = (stackPages stackPageFor: lifp) l: ln.
self assert: stackPage = stackPages mostRecentlyUsedPage l: ln.
self assert: (self deferStackLimitSmashAround: #assertValidStackLimits: asSymbol with: ln).
self assert: lifp < stackPage baseAddress l: ln.
self assert: lisp < lifp l: ln.
self assert: lifp > lisp l: ln.
self assert: lisp >= (stackPage realStackLimit - self stackLimitOffset) l: ln.
self assert: (lifp - lisp) < LargeContextSize l: ln.
methodField := self frameMethodField: lifp.
inInterpreter
ifTrue:
[self assert: (self isMachineCodeFrame: lifp) not l: ln.
self assert: method = methodField l: ln.
self cppIf: MULTIPLEBYTECODESETS
ifTrue: [self assert: (self methodUsesAlternateBytecodeSet: method) = (bytecodeSetSelector = 256) l: ln].
(self asserta: (objectMemory cheapAddressCouldBeInHeap: methodField) l: ln) ifTrue:
[theIP := lip = cogit ceReturnToInterpreterPC
ifTrue: [self iframeSavedIP: lifp]
ifFalse: [lip].
self assert: (theIP >= (methodField + (objectMemory lastPointerOf: methodField))
and: [theIP < (methodField + (objectMemory byteLengthOf: methodField) + objectMemory baseHeaderSize - 1)])
l: ln].
self assert: ((self iframeIsBlockActivation: lifp)
or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self iframeReceiver: lifp)])
l: ln]
ifFalse:
[self assert: (self isMachineCodeFrame: lifp) l: ln.
((self asserta: methodField asUnsignedInteger >= cogit minCogMethodAddress l: ln)
and: [self asserta: methodField asUnsignedInteger < cogit maxCogMethodAddress l: ln]) ifTrue:
[cogMethod := self mframeHomeMethod: lifp.
self assert: (lip > (methodField + ((self mframeIsBlockActivation: lifp)
ifTrue: [self sizeof: CogBlockMethod]
ifFalse: [self sizeof: CogMethod]))
and: [lip < (methodField + cogMethod blockSize)])
l: ln].
self assert: ((self mframeIsBlockActivation: lifp)
or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self mframeReceiver: lifp)])
l: ln].
(self isBaseFrame: lifp) ifTrue:
[self assert: (self frameHasContext: lifp) l: ln.
self assert: (self frameContext: lifp) = (stackPages longAt: stackPage baseAddress - BytesPerWord) l: ln]!
Item was changed:
----- Method: CoInterpreter>>assertValidExternalStackPointers (in category 'debug support') -----
assertValidExternalStackPointers
self assert: framePointer < stackPage baseAddress.
self assert: stackPointer < framePointer.
self assert: framePointer > stackPointer.
self assert: stackPointer >= (stackPage realStackLimit - self stackLimitOffset)!
Item was changed:
----- Method: CoInterpreter>>assertValidStackPageHeadPointers (in category 'debug support') -----
assertValidStackPageHeadPointers
self assert: stackPage headFP < stackPage baseAddress.
self assert: stackPage headSP < stackPage headFP.
self assert: stackPage headFP > stackPage headSP.
self assert: stackPage headSP >= (stackPage realStackLimit - self stackLimitOffset)!
Item was changed:
----- Method: CoInterpreter>>assertValidStackedInstructionPointers: (in category 'debug support') -----
assertValidStackedInstructionPointers: ln
"Check that the stacked instruction pointers in all pages are correct.
Checks the interpreter sender/machine code callee contract.
Written so it will be optimized away if not in an assert VM."
| thePage |
<inline: false>
<var: #thePage type: #'StackPage *'>
0 to: numStackPages - 1 do:
[:i|
thePage := stackPages stackPageAt: i.
(stackPages isFree: thePage) ifFalse:
[self assert: (self assertValidStackedInstructionPointersIn: thePage line: ln) l: ln]]!
Item was changed:
----- Method: CoInterpreter>>assertValidStackedInstructionPointersIn:line: (in category 'debug support') -----
assertValidStackedInstructionPointersIn: aStackPage line: ln
"Check that the stacked instruction pointers in the given page are correct.
Checks the interpreter sender/machine code callee contract."
<var: #aStackPage type: #'StackPage *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #theIP type: #usqInt>
<var: #theMethod type: #'CogMethod *'>
<inline: false>
| prevFrameWasCogged theFP callerFP theMethod theIP methodObj |
(self asserta: (stackPages isFree: aStackPage) not l: ln) ifFalse:
[^false].
prevFrameWasCogged := false.
"The top of stack of an inactive page is always the instructionPointer.
The top of stack of the active page may be the instructionPointer if it has been pushed,
which is indicated by a 0 instructionPointer."
(stackPage = aStackPage and: [instructionPointer ~= 0])
ifTrue:
[theIP := instructionPointer.
theFP := framePointer]
ifFalse:
[theIP := (stackPages longAt: aStackPage headSP) asUnsignedInteger.
theFP := aStackPage headFP.
stackPage = aStackPage ifTrue:
[self assert: framePointer = theFP l: ln]].
[(self isMachineCodeFrame: theFP)
ifTrue:
[theMethod := self mframeHomeMethod: theFP.
self assert: (theIP = cogit ceCannotResumePC
or: [theIP >= theMethod asUnsignedInteger
and: [theIP < (theMethod asUnsignedInteger + theMethod blockSize)]])
l: ln.
prevFrameWasCogged := true]
ifFalse: "assert-check the interpreter frame."
[methodObj := self iframeMethod: theFP.
prevFrameWasCogged ifTrue:
[self assert: theIP = cogit ceReturnToInterpreterPC l: ln].
theIP = cogit ceReturnToInterpreterPC ifTrue:
[theIP := self iframeSavedIP: theFP].
self assert: (theIP >= (methodObj + (objectMemory lastPointerOf: methodObj))
and: [theIP < (methodObj + (objectMemory byteLengthOf: methodObj) + objectMemory baseHeaderSize - 1)])
l: ln.
prevFrameWasCogged := false].
theIP := (stackPages longAt: theFP + FoxCallerSavedIP) asUnsignedInteger.
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theFP := callerFP].
self assert: theIP = cogit ceBaseFrameReturnPC l: ln.
^true!
Item was changed:
----- Method: CoInterpreter>>ceTraceBlockActivation (in category 'debug support') -----
ceTraceBlockActivation
<api>
cogit recordBlockTrace ifTrue:
[self recordTrace: TraceBlockActivation
thing: (self mframeHomeMethod: framePointer) methodObject
source: TraceIsFromMachineCode.
cogit printOnTrace ifTrue:
[self printActivationNameFor: (self mframeHomeMethod: framePointer) methodObject
receiver: (self frameReceiver: framePointer)
isBlock: true
firstTemporary: nil.
self cr]]!
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 *'.
"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>>checkAssertsEnabledInCoInterpreter (in category 'debug support') -----
checkAssertsEnabledInCoInterpreter
<api>
| assertsAreEnabledInCoInterpreter |
assertsAreEnabledInCoInterpreter := false.
self assert: assertsAreEnabledInCoInterpreter!
Item was changed:
----- Method: CoInterpreter>>checkOkayFields: (in category 'debug support') -----
checkOkayFields: oop
"Check if the argument is an ok object.
If this is a pointers object, check that its fields are all okay oops."
| hasYoung i fieldOop |
(oop = nil or: [oop = 0]) ifTrue: [ ^true ]. "?? eem 1/16/2013"
(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
(objectMemory checkOkayOop: oop) ifFalse: [ ^false ].
(objectMemory checkOopHasOkayClass: oop) ifFalse: [ ^false ].
((objectMemory isPointersNonImm: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
hasYoung := objectMemory hasSpurMemoryManagerAPI not
and: [objectMemory isYoungObject: (objectMemory fetchClassOfNonImm: oop)].
(objectMemory isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart - 1]
ifFalse:
[(objectMemory isContext: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
[i >= 0] whileTrue:
[fieldOop := objectMemory fetchPointer: i ofObject: oop.
(objectMemory isNonIntegerObject: fieldOop) ifTrue:
[(i = 0 and: [objectMemory isCompiledMethod: oop])
ifTrue:
[(cogMethodZone methodFor: (self pointerForOop: fieldOop)) = 0 ifTrue:
[self print: 'method '; printHex: oop; print: ' has an invalid cog method reference'.
^false]]
ifFalse:
[hasYoung := hasYoung or: [objectMemory isYoung: fieldOop].
(objectMemory checkOkayOop: fieldOop) ifFalse: [ ^false ].
(self checkOopHasOkayClass: fieldOop) ifFalse: [ ^false ]]].
i := i - 1].
hasYoung ifTrue:
[^objectMemory checkOkayYoungReferrer: oop].
^true!
Item was changed:
----- Method: CoInterpreter>>clearTraceLog (in category 'debug support') -----
clearTraceLog
<api>
traceLogIndex := 0.
0 to: TraceBufferSize - 1 do:
[:i|
traceLog at: i put: 0]!
Item was changed:
----- Method: CoInterpreter>>compilationBreak:point: (in category 'debug support') -----
compilationBreak: selectorOop point: selectorLength
<api>
<cmacro: '(sel, len) do { \
if ((len) == breakSelectorLength \
&& !!strncmp((char *)((sel) + BaseHeaderSize), breakSelector, breakSelectorLength)) { \
suppressHeartbeatFlag = 1; \
compilationBreakpointFor(sel); \
} \
} while (0)'>
| i |
breakSelectorLength = selectorLength ifTrue:
[i := breakSelectorLength.
[i > 0] whileTrue:
[(objectMemory byteAt: selectorOop + i + BaseHeaderSize - 1) = (breakSelector at: i) asInteger
ifTrue: [(i := i - 1) = 0 ifTrue:
[self compilationBreakpointFor: selectorOop]]
ifFalse: [i := 0]]]!
Item was changed:
----- Method: CoInterpreter>>compilationBreakpointFor: (in category 'debug support') -----
compilationBreakpointFor: selectorOop
<api>
suppressHeartbeatFlag := true.
self
cCode: [self warning: 'compilation send break (heartbeat suppressed)']
inSmalltalk: [self halt: 'Compilation of ', breakSelector]!
Item was changed:
----- Method: CoInterpreter>>dumpPrimTraceLog (in category 'debug support') -----
dumpPrimTraceLog
"The prim trace log is a circular buffer of entries. If there is
an entry at primTraceLogIndex \\ PrimTraceLogSize it has entries.
If there is something at primTraceLogIndex it has wrapped."
<api>
<inline: false>
(primTraceLog at: (self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize)) = 0 ifTrue: [^self].
(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[primTraceLogIndex to: PrimTraceLogSize - 1 do:
[:i | self printPrimLogEntryAt: i; cr]].
0 to: primTraceLogIndex - 1 do:
[:i | self printPrimLogEntryAt: i; cr]!
Item was changed:
----- Method: CoInterpreter>>dumpTraceLog (in category 'debug support') -----
dumpTraceLog
<api>
"The trace log is a circular buffer of pairs of entries. If there is
an entry at traceLogIndex - 3 \\ TraceBufferSize it has entries.
If there is something at traceLogIndex it has wrapped."
<inline: false>
(traceLog at: (self safe: traceLogIndex - 3 mod: TraceBufferSize)) = 0 ifTrue: [^self].
(traceLog at: traceLogIndex) ~= 0 ifTrue:
[traceLogIndex to: TraceBufferSize - 3 by: 3 do:
[:i| self printLogEntryAt: i]].
0 to: traceLogIndex - 3 by: 3 do:
[:i| self printLogEntryAt: i]!
Item was changed:
----- Method: CoInterpreter>>fastLogPrim: (in category 'debug support') -----
fastLogPrim: aSelector
"Fast tracing of named primitives. primTraceLogIndex is a byte variable.
primTraceLog has 256 entries. In C the + 1 below is hence implicitly modulo 256."
<inline: true>
primTraceLog at: primTraceLogIndex put: aSelector.
self primTraceLogIndex: primTraceLogIndex + 1!
Item was changed:
----- Method: CoInterpreter>>getImageHeaderFlags (in category 'image save/restore') -----
getImageHeaderFlags
"Answer the flags that are contained in the 7th long of the image header."
^fullScreenFlag "0 or 1"
+ (VMBIGENDIAN ifTrue: [0] ifFalse: [2]) "this is the imageFloatsLittleEndian flag"
+ (processHasThreadId ifTrue: [4] ifFalse: [0])
+ (flagInterpretedMethods ifTrue: [8] ifFalse: [0])
+ (preemptionYields ifTrue: [0] ifFalse: [16])
+ (noThreadingOfGUIThread ifTrue: [32] ifFalse: [0])
+ (imageHeaderFlags bitClear: 63) "these are any flags we do not recognize"!
Item was changed:
----- Method: CoInterpreter>>ifValidWriteBackStack:Pointers:Save:To: (in category 'debug support') -----
ifValidWriteBackStack: theCFP Pointers: theCSP Save: savedFPP To: savedSPP
"This is for low-level error reporting. If either of the C stack pointers are
pointing into the stack zone then write them back to framePointer and/or
stackPointer so that the stack backtrace will be up to date. Write their
original values through savedFPP & savedSPP if non-null."
<api>
<var: #theCFP type: #'void *'>
<var: #theCSP type: #'void *'>
<var: #savedFPP type: #'char **'>
<var: #savedSPP type: #'char **'>
<returnTypeC: #void>
savedFPP ~= 0 ifTrue:
[savedFPP at: 0 put: framePointer].
savedSPP ~= 0 ifTrue:
[savedSPP at: 0 put: stackPointer].
(self couldBeFramePointer: theCFP) ifTrue:
[framePointer := theCFP].
(self couldBeFramePointer: theCSP) ifTrue:
[stackPointer := theCSP]!
Item was removed:
- ----- Method: CoInterpreter>>interpreterAllocationReserveBytes (in category 'stack pages') -----
- interpreterAllocationReserveBytes
- "At a rough approximation we may need to allocate up to a couple
- of page's worth of contexts when switching stack pages, assigning
- to senders, etc. But the snapshot primitive voids all stack pages.
- So a safe margin is the size of a large context times the maximum
- number of frames per page times the number of pages."
- | maxUsedBytesPerPage maxFramesPerPage |
- maxUsedBytesPerPage := self stackPageFrameBytes + self stackLimitOffset.
- maxFramesPerPage := maxUsedBytesPerPage / BytesPerWord // MFrameSlots.
- ^maxFramesPerPage * LargeContextSlots * BytesPerOop * numStackPages!
Item was added:
+ ----- Method: CoInterpreter>>interpreterAllocationReserveBytes (in category 'stack pages') -----
+ interpreterAllocationReserveBytes
+ "At a rough approximation we may need to allocate up to a couple
+ of page's worth of contexts when switching stack pages, assigning
+ to senders, etc. But the snapshot primitive voids all stack pages.
+ So a safe margin is the size of a large context times the maximum
+ number of frames per page times the number of pages."
+ | maxUsedBytesPerPage maxFramesPerPage |
+ maxUsedBytesPerPage := self stackPageFrameBytes + self stackLimitOffset.
+ maxFramesPerPage := maxUsedBytesPerPage / BytesPerWord // MFrameSlots.
+ ^maxFramesPerPage * LargeContextSlots * BytesPerOop * numStackPages!
Item was changed:
----- Method: CoInterpreter>>isMachineCodeIP: (in category 'debug support') -----
isMachineCodeIP: anInstrPointer
^anInstrPointer < objectMemory startOfMemory!
Item was changed:
----- Method: CoInterpreter>>mapPrimTraceLog (in category 'debug support') -----
mapPrimTraceLog
"The prim trace log is a circular buffer of selectors. If there is
an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
If there is something at primTraceLogIndex it has wrapped."
<inline: false>
| limit |
limit := self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize.
(primTraceLog at: limit) = 0 ifTrue: [^self].
(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[limit := PrimTraceLogSize - 1].
0 to: limit do:
[:i| | selector |
selector := primTraceLog at: i.
(objectMemory shouldRemapOop: selector) ifTrue:
[primTraceLog at: i put: (objectMemory remapObj: selector)]]!
Item was changed:
----- Method: CoInterpreter>>mapTraceLog (in category 'debug support') -----
mapTraceLog
"The trace log is a circular buffer of pairs of entries. If there is
an entry at traceLogIndex - 3 \\ TraceBufferSize it has entries.
If there is something at traceLogIndex it has wrapped."
<inline: false>
| limit |
limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
(traceLog at: limit) = 0 ifTrue: [^self].
(traceLog at: traceLogIndex) ~= 0 ifTrue:
[limit := TraceBufferSize - 3].
0 to: limit by: 3 do:
[:i| | intOrClass selectorOrMethod |
intOrClass := traceLog at: i.
(objectMemory shouldRemapOop: intOrClass) ifTrue:
[traceLog at: i put: (objectMemory remapObj: intOrClass)].
selectorOrMethod := traceLog at: i + 1.
(objectMemory shouldRemapOop: selectorOrMethod) ifTrue:
[traceLog at: i + 1 put: (objectMemory remapObj: selectorOrMethod)]]!
Item was changed:
----- Method: CoInterpreter>>mapTraceLogs (in category 'debug support') -----
mapTraceLogs
self mapTraceLog.
self mapPrimTraceLog!
Item was added:
+ ----- Method: CoInterpreter>>markAndTraceOrFreeMachineCode: (in category 'object memory support') -----
+ markAndTraceOrFreeMachineCode: fullGCFlag
+ "Deal with a fulGC's effects on machine code. Either mark and trace
+ oops in machine code or free machine-code methds that refer to freed
+ oops. The stack pages have already been traced so any methods
+ of live stack activations have already been marked and traced."
+ cogit markAndTraceObjectsOrFreeMachineCode: fullGCFlag!
Item was removed:
- ----- Method: CoInterpreter>>markAndTraceOrFreeMachineCode: (in category 'object memory support') -----
- markAndTraceOrFreeMachineCode: fullGCFlag
- "Deal with a fulGC's effects on machine code. Either mark and trace
- oops in machine code or free machine-code methds that refer to freed
- oops. The stack pages have already been traced so any methods
- of live stack activations have already been marked and traced."
- cogit markAndTraceObjectsOrFreeMachineCode: fullGCFlag!
Item was changed:
----- Method: CoInterpreter>>markAndTracePrimTraceLog (in category 'debug support') -----
markAndTracePrimTraceLog
"The prim trace log is a circular buffer of selectors. If there is
an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
If there is something at primTraceLogIndex it has wrapped."
<inline: false>
| limit |
limit := self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize.
(primTraceLog at: limit) = 0 ifTrue: [^self].
(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[limit := PrimTraceLogSize - 1].
0 to: limit do:
[:i| | selector |
selector := primTraceLog at: i.
(objectMemory isImmediate: selector) ifFalse:
[objectMemory markAndTrace: selector]]!
Item was changed:
----- Method: CoInterpreter>>maybeTraceStackOverflow (in category 'debug support') -----
maybeTraceStackOverflow
cogit recordOverflowTrace ifTrue:
[self recordTrace: TraceStackOverflow
thing: TraceStackOverflow
source: ((self isMachineCodeFrame: framePointer)
ifTrue: [TraceIsFromMachineCode]
ifFalse: [TraceIsFromInterpreter])]!
Item was changed:
----- Method: CoInterpreter>>minimumUnusedHeadroom (in category 'debug support') -----
minimumUnusedHeadroom
"Traverse all stack pages looking for non-zero bytes in the headroom part of each page.
Answer the minimum size of unused headroom (zero bytes) in the pages. This is for
checking that there is enough headroom allocated in stack pages."
| minUnused page |
<var: #page type: #'StackPage *'>
<var: #p type: #'char *'>
minUnused := (stackPages stackPageAt: 0) baseAddress - (stackPages stackPageAt: 0) lastAddress.
0 to: numStackPages - 1 do:
[:i| | p unused |
page := stackPages stackPageAt: i.
p := page lastAddress.
[p := p + BytesPerWord.
(self longAtPointer: p) = 0
and: [p <= page baseAddress]] whileTrue.
unused := p - BytesPerWord - page lastAddress.
unused < minUnused ifTrue:
[minUnused := unused]].
^minUnused!
Item was removed:
- ----- Method: CoInterpreter>>postGCAction: (in category 'object memory support') -----
- postGCAction: gcModeArg
- "Attempt to shrink free memory, signal the gc semaphore and let the Cogit do its post GC thang"
- self assert: gcModeArg = gcMode.
- super postGCAction: gcModeArg.
- cogit cogitPostGCAction: gcModeArg.
- lastCoggableInterpretedBlockMethod := lastUncoggableInterpretedBlockMethod := nil.
- gcMode := 0!
Item was added:
+ ----- Method: CoInterpreter>>postGCAction: (in category 'object memory support') -----
+ postGCAction: gcModeArg
+ "Attempt to shrink free memory, signal the gc semaphore and let the Cogit do its post GC thang"
+ self assert: gcModeArg = gcMode.
+ super postGCAction: gcModeArg.
+ cogit cogitPostGCAction: gcModeArg.
+ lastCoggableInterpretedBlockMethod := lastUncoggableInterpretedBlockMethod := nil.
+ gcMode := 0!
Item was removed:
- ----- Method: CoInterpreter>>preGCAction: (in category 'object memory support') -----
- preGCAction: gcModeArg
- <inline: true>
- "Need to write back the frame pointers unless all pages are free (as in snapshot).
- Need to set gcMode var (to avoid passing the flag through a lot of the updating code)"
- super preGCAction: gcModeArg.
-
- gcMode := gcModeArg.
-
- cogit recordEventTrace ifTrue:
- [| traceType |
- traceType := gcModeArg == GCModeFull ifTrue: [TraceFullGC] ifFalse: [TraceIncrementalGC].
- self recordTrace: traceType thing: traceType source: 0].
-
- cogit recordPrimTrace ifTrue:
- [| traceType |
- traceType := gcModeArg == GCModeFull ifTrue: [TraceFullGC] ifFalse: [TraceIncrementalGC].
- self fastLogPrim: traceType]!
Item was added:
+ ----- Method: CoInterpreter>>preGCAction: (in category 'object memory support') -----
+ preGCAction: gcModeArg
+ <inline: true>
+ "Need to write back the frame pointers unless all pages are free (as in snapshot).
+ Need to set gcMode var (to avoid passing the flag through a lot of the updating code)"
+ super preGCAction: gcModeArg.
+
+ gcMode := gcModeArg.
+
+ cogit recordEventTrace ifTrue:
+ [| traceType |
+ traceType := gcModeArg == GCModeFull ifTrue: [TraceFullGC] ifFalse: [TraceIncrementalGC].
+ self recordTrace: traceType thing: traceType source: 0].
+
+ cogit recordPrimTrace ifTrue:
+ [| traceType |
+ traceType := gcModeArg == GCModeFull ifTrue: [TraceFullGC] ifFalse: [TraceIncrementalGC].
+ self fastLogPrim: traceType]!
Item was changed:
----- Method: CoInterpreter>>printLogEntryAt: (in category 'debug support') -----
printLogEntryAt: i
<inline: false>
| intOrClass selectorMethodOrProcess source |
intOrClass := traceLog at: i.
selectorMethodOrProcess := traceLog at: i + 1.
source := traceLog at: i + 2.
source <= TraceIsFromInterpreter ifTrue:
[self print: (traceSources at: source); space].
(objectMemory isIntegerObject: intOrClass)
ifTrue:
[intOrClass = TraceStackOverflow ifTrue:
[self print: 'stack overflow'].
intOrClass = TraceContextSwitch ifTrue:
[self print: 'context switch from '; printHex: selectorMethodOrProcess].
intOrClass = TraceBlockActivation ifTrue:
[self print: ' [] in '; printHex: selectorMethodOrProcess].
intOrClass = TraceBlockCreation ifTrue:
[self print: 'create [] '; printHex: selectorMethodOrProcess].
intOrClass = TraceIncrementalGC ifTrue:
[self print: 'incrementalGC'].
intOrClass = TraceFullGC ifTrue:
[self print: 'fullGC'].
intOrClass = TraceCodeCompaction ifTrue:
[self print: 'compactCode'].
intOrClass = TraceVMCallback ifTrue:
[self print: 'callback'].
intOrClass = TraceVMCallbackReturn ifTrue:
[self print: 'return from callback']]
ifFalse:
[self space; printNameOfClass: intOrClass count: 5; print: '>>'; printStringOf: selectorMethodOrProcess].
source > TraceIsFromInterpreter ifTrue:
[self space; print: (traceSources at: source)].
self cr!
Item was changed:
----- Method: CoInterpreter>>printPrimLogEntryAt: (in category 'debug support') -----
printPrimLogEntryAt: i
<inline: false>
| intOrSelector |
intOrSelector := primTraceLog at: i.
(objectMemory isImmediate: intOrSelector)
ifTrue:
[intOrSelector = TraceIncrementalGC ifTrue:
[self print: '**IncrementalGC**'. ^nil].
intOrSelector = TraceFullGC ifTrue:
[self print: '**FullGC**'. ^nil].
intOrSelector = TraceCodeCompaction ifTrue:
[self print: '**CompactCode**'. ^nil].
self print: '???']
ifFalse:
[objectMemory safePrintStringOf: intOrSelector]!
Item was changed:
----- Method: CoInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr
minimumMemory heapSize bytesRead bytesToShift firstSegSize
hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize |
<var: #f type: #sqImageFile>
<var: #dataSize type: #'size_t'>
<var: #desiredHeapSize type: #usqInt>
<var: #headerStart type: #squeakFileOffsetType>
<var: #imageOffset type: #squeakFileOffsetType>
metaclassNumSlots := 6. "guess Metaclass instSize"
classNameIndex := 6. "guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
savedWindowSize := self getLongFromFile: f swap: swapBytes.
headerFlags := self getLongFromFile: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self getLongFromFile: f swap: swapBytes. "N.B. not used."
hdrNumStackPages := self getShortFromFile: f swap: swapBytes.
"4 stack pages is small. Should be able to run with as few as
three. 4 should be comfortable but slow. 8 is a reasonable
default. Can be changed via vmParameterAt: 43 put: n.
Can be set as a preference (Info.plist, VM.ini, command line etc).
If desiredNumStackPages is already non-zero then it has been
set as a preference. Ignore (but preserve) the header's default."
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
cogCodeSize := desiredCogCodeSize ~= 0
ifTrue: [desiredCogCodeSize]
ifFalse:
[hdrCogCodeSize = 0
ifTrue: [self defaultCogCodeSize]
ifFalse: [hdrCogCodeSize]].
hdrEdenBytes := self getLongFromFile: f swap: swapBytes.
objectMemory edenBytes: (desiredEdenBytes ~= 0
ifTrue: [desiredEdenBytes]
ifFalse:
[hdrEdenBytes = 0
ifTrue: [objectMemory defaultEdenBytes]
ifFalse: [hdrEdenBytes]]).
desiredEdenBytes := hdrEdenBytes.
hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
hdrMaxExtSemTabSize ~= 0 ifTrue:
[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
"pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
Preserve it to be polite to other VMs."
the2ndUnknownShort := self getShortFromFile: f swap: swapBytes.
firstSegSize := self getLongFromFile: f swap: swapBytes.
objectMemory firstSegmentSize: firstSegSize.
"compare memory requirements with availability"
minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed"
+ dataSize
+ objectMemory newSpaceBytes
+ self interpreterAllocationReserveBytes.
heapSize := cogCodeSize "no need to include the stackZone; this is alloca'ed"
+ desiredHeapSize
+ objectMemory newSpaceBytes
+ self interpreterAllocationReserveBytes.
heapSize < minimumMemory ifTrue:
[self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap and ancilliary data structures"
objectMemory memory: (self
allocateMemory: heapSize
minimum: minimumMemory
imageFile: f
headerSize: headerSize) asUnsignedInteger.
objectMemory memory ifNil: [self insufficientMemoryAvailableError].
heapBase := objectMemory
setHeapBase: objectMemory memory + cogCodeSize
memoryLimit: objectMemory memory + heapSize
endOfMemory: objectMemory memory + cogCodeSize + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
self ensureImageFormatIsUpToDate: swapBytes.
"compute difference between old and new memory base addresses"
bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
self initializeCodeGenerator.
^dataSize!
Item was changed:
----- Method: CoInterpreter>>recordContextSwitchFrom:in: (in category 'debug support') -----
recordContextSwitchFrom: aProcess in: sourceCode
cogit recordEventTrace ifTrue:
[self recordTrace: TraceContextSwitch thing: aProcess source: sourceCode]!
Item was changed:
----- Method: CoInterpreter>>recordTrace:thing:source: (in category 'debug support') -----
recordTrace: classOrInteger thing: selector source: source
traceLog at: traceLogIndex put: classOrInteger.
traceLog at: traceLogIndex + 1 put: selector.
traceLog at: traceLogIndex + 2 put: source.
traceLogIndex := traceLogIndex + 3 \\ TraceBufferSize!
Item was changed:
----- Method: CoInterpreter>>reportMinimumUnusedHeadroom (in category 'debug support') -----
reportMinimumUnusedHeadroom
"Report the stack page size and minimum unused headroom to stdout."
<api>
self cCode:
[self pri: 'stack page bytes %ld available headroom %ld minimum unused headroom %ld\n'
n: self stackPageByteSize asLong
t: (self stackPageByteSize - self stackLimitBytes - self stackLimitOffset) asLong
f: self minimumUnusedHeadroom asLong]
inSmalltalk:
["CogVMSimulator new initStackPagesForTests reportMinimumUnusedHeadroom"
self print: 'stack page bytes '; printNum: self stackPageByteSize;
print: ' available headroom '; printNum: self stackPageByteSize - self stackLimitBytes - self stackLimitOffset;
print: ' minimum unused headroom '; printNum: self minimumUnusedHeadroom;
cr]!
Item was changed:
----- Method: CoInterpreter>>setImageHeaderFlagsFrom: (in category 'image save/restore') -----
setImageHeaderFlagsFrom: headerFlags
"Set the flags that are contained in the 7th long of the image header."
imageHeaderFlags := headerFlags. "so as to preserve unrecognised flags."
fullScreenFlag := headerFlags bitAnd: 1.
imageFloatsBigEndian := (headerFlags bitAnd: 2) = 0 ifTrue: [1] ifFalse: [0].
processHasThreadId := (headerFlags bitAnd: 4) ~= 0.
flagInterpretedMethods := (headerFlags bitAnd: 8) ~= 0.
preemptionYields := (headerFlags bitAnd: 16) = 0.
noThreadingOfGUIThread := (headerFlags bitAnd: 32) ~= 0!
Item was changed:
----- Method: CoInterpreter>>unknownShortOrCodeSizeInKs (in category 'image save/restore') -----
unknownShortOrCodeSizeInKs
^desiredCogCodeSize + 1023 // 1024!
Item was changed:
----- Method: CoInterpreter>>validInstructionPointer:inMethod:framePointer: (in category 'debug support') -----
validInstructionPointer: instrPointer inMethod: aMethod framePointer: fp
<var: #instrPointer type: #usqInt>
<var: #aMethod type: #usqInt>
<var: #fp type: #'char *'>
| theInstrPointer cogMethod |
<var: #theInstrPointer type: #usqInt>
<var: #cogMethod type: #'CogMethod *'>
instrPointer = cogit ceCannotResumePC ifTrue:
[^self isMachineCodeFrame: fp].
instrPointer = cogit ceReturnToInterpreterPC
ifTrue:
[(self isMachineCodeFrame: fp) ifTrue:
[^false].
theInstrPointer := self iframeSavedIP: fp]
ifFalse:
[theInstrPointer := instrPointer.
self cppIf: NewspeakVM
ifTrue:
[(self isMachineCodeFrame: fp) ifTrue:
[cogMethod := self mframeHomeMethod: fp.
^theInstrPointer >= (cogMethod asUnsignedInteger + (cogit sizeof: CogMethod))
and: [theInstrPointer < (cogMethod asUnsignedInteger + cogMethod blockSize)]]]
ifFalse:
[| header |
header := self rawHeaderOf: aMethod.
((self isCogMethodReference: header)
and: [theInstrPointer < objectMemory startOfMemory]) ifTrue:
[cogMethod := self cCoerceSimple: header to: #'CogMethod *'.
^theInstrPointer >= (header + (cogit sizeof: CogMethod))
and: [theInstrPointer < (header + cogMethod blockSize)]]]].
^super validInstructionPointer: theInstrPointer inMethod: aMethod framePointer: fp!
Item was changed:
----- Method: CoInterpreterMT>>assertSaneThreadAndProcess (in category 'debug support') -----
assertSaneThreadAndProcess
<inline: true>
self assert: cogThreadManager getVMOwner > 0.
self assert: cogThreadManager currentVMThread state = CTMAssignableOrInVM.
self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject!
Item was added:
+ ----- Method: CoInterpreterMT>>mapInterpreterOops (in category 'object memory support') -----
+ mapInterpreterOops
+ "Map all oops in the interpreter's state to their new values
+ during garbage collection or a become: operation."
+ "Assume: All traced variables contain valid oops."
+ <var: #vmThread type: #'CogVMThread *'>
+ super mapInterpreterOops.
+
+ "Per-thread state; trace each thread's own newMethod and stack of awol processes."
+ 1 to: cogThreadManager getNumThreads do:
+ [:i| | vmThread |
+ vmThread := cogThreadManager vmThreadAt: i.
+ vmThread state ifNotNil:
+ [(vmThread newMethodOrNull notNil
+ and: [objectMemory shouldRemapOop: vmThread newMethodOrNull]) ifTrue:
+ [vmThread newMethodOrNull: (objectMemory remapObj: vmThread newMethodOrNull)].
+ 0 to: vmThread awolProcIndex - 1 do:
+ [:j|
+ (objectMemory shouldRemapOop: (vmThread awolProcesses at: j)) ifTrue:
+ [vmThread awolProcesses at: j put: (objectMemory remap: (vmThread awolProcesses at: j))]]]]!
Item was removed:
- ----- Method: CoInterpreterMT>>mapInterpreterOops (in category 'object memory support') -----
- mapInterpreterOops
- "Map all oops in the interpreter's state to their new values
- during garbage collection or a become: operation."
- "Assume: All traced variables contain valid oops."
- <var: #vmThread type: #'CogVMThread *'>
- super mapInterpreterOops.
-
- "Per-thread state; trace each thread's own newMethod and stack of awol processes."
- 1 to: cogThreadManager getNumThreads do:
- [:i| | vmThread |
- vmThread := cogThreadManager vmThreadAt: i.
- vmThread state ifNotNil:
- [(vmThread newMethodOrNull notNil
- and: [objectMemory shouldRemapOop: vmThread newMethodOrNull]) ifTrue:
- [vmThread newMethodOrNull: (objectMemory remapObj: vmThread newMethodOrNull)].
- 0 to: vmThread awolProcIndex - 1 do:
- [:j|
- (objectMemory shouldRemapOop: (vmThread awolProcesses at: j)) ifTrue:
- [vmThread awolProcesses at: j put: (objectMemory remap: (vmThread awolProcesses at: j))]]]]!
Item was added:
+ ----- Method: CoInterpreterMT>>markAndTraceInterpreterOops: (in category 'object memory support') -----
+ markAndTraceInterpreterOops: fullGCFlag
+ "Mark and trace all oops in the interpreter's state."
+ "Assume: All traced variables contain valid oops.
+ N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
+ only during message lookup and because createActualMessageTo will not
+ cause a GC these cannot change during message lookup."
+ | oop |
+ <var: #vmThread type: #'CogVMThread *'>
+ "Must mark stack pages first to initialize the per-page trace
+ flags for full garbage collect before any subsequent tracing."
+ self markAndTraceStackPages: fullGCFlag.
+ self markAndTraceTraceLog.
+ self markAndTracePrimTraceLog.
+ objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
+ (objectMemory isImmediate: newMethod) ifFalse:
+ [objectMemory markAndTrace: newMethod].
+ self traceProfileState.
+ tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
+
+ 1 to: objectMemory remapBufferCount do:
+ [:i|
+ oop := objectMemory remapBuffer at: i.
+ (objectMemory isIntegerObject: oop) ifFalse:
+ [objectMemory markAndTrace: oop]].
+
+ "Callback support - trace suspended callback list - will be made per-thread soon"
+ 1 to: jmpDepth do:
+ [:i|
+ oop := suspendedCallbacks at: i.
+ (objectMemory isIntegerObject: oop) ifFalse:
+ [objectMemory markAndTrace: oop].
+ oop := suspendedMethods at: i.
+ (objectMemory isIntegerObject: oop) ifFalse:
+ [objectMemory markAndTrace: oop]].
+
+ "Per-thread state; trace each thread's own newMethod and stack of awol processes."
+ 1 to: cogThreadManager getNumThreads do:
+ [:i| | vmThread |
+ vmThread := cogThreadManager vmThreadAt: i.
+ vmThread state notNil ifTrue:
+ [vmThread newMethodOrNull notNil ifTrue:
+ [objectMemory markAndTrace: vmThread newMethodOrNull].
+ 0 to: vmThread awolProcIndex - 1 do:
+ [:j|
+ objectMemory markAndTrace: (vmThread awolProcesses at: j)]]]!
Item was removed:
- ----- Method: CoInterpreterMT>>markAndTraceInterpreterOops: (in category 'object memory support') -----
- markAndTraceInterpreterOops: fullGCFlag
- "Mark and trace all oops in the interpreter's state."
- "Assume: All traced variables contain valid oops.
- N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
- only during message lookup and because createActualMessageTo will not
- cause a GC these cannot change during message lookup."
- | oop |
- <var: #vmThread type: #'CogVMThread *'>
- "Must mark stack pages first to initialize the per-page trace
- flags for full garbage collect before any subsequent tracing."
- self markAndTraceStackPages: fullGCFlag.
- self markAndTraceTraceLog.
- self markAndTracePrimTraceLog.
- objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
- (objectMemory isImmediate: newMethod) ifFalse:
- [objectMemory markAndTrace: newMethod].
- self traceProfileState.
- tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
-
- 1 to: objectMemory remapBufferCount do:
- [:i|
- oop := objectMemory remapBuffer at: i.
- (objectMemory isIntegerObject: oop) ifFalse:
- [objectMemory markAndTrace: oop]].
-
- "Callback support - trace suspended callback list - will be made per-thread soon"
- 1 to: jmpDepth do:
- [:i|
- oop := suspendedCallbacks at: i.
- (objectMemory isIntegerObject: oop) ifFalse:
- [objectMemory markAndTrace: oop].
- oop := suspendedMethods at: i.
- (objectMemory isIntegerObject: oop) ifFalse:
- [objectMemory markAndTrace: oop]].
-
- "Per-thread state; trace each thread's own newMethod and stack of awol processes."
- 1 to: cogThreadManager getNumThreads do:
- [:i| | vmThread |
- vmThread := cogThreadManager vmThreadAt: i.
- vmThread state notNil ifTrue:
- [vmThread newMethodOrNull notNil ifTrue:
- [objectMemory markAndTrace: vmThread newMethodOrNull].
- 0 to: vmThread awolProcIndex - 1 do:
- [:j|
- objectMemory markAndTrace: (vmThread awolProcesses at: j)]]]!
Item was changed:
----- Method: CoInterpreterMT>>printLogEntryAt: (in category 'debug support') -----
printLogEntryAt: i
<inline: false>
| intOrClass selectorOrMethod source |
intOrClass := traceLog at: i.
selectorOrMethod := traceLog at: i + 1.
self printNum: ((traceLog at: i + 2) bitShift: -16); space.
source := (traceLog at: i + 2) bitAnd: 16rFFFF.
source <= TraceIsFromInterpreter ifTrue:
[self print: (traceSources at: source); space].
(objectMemory isIntegerObject: intOrClass)
ifTrue:
[| value |
value := objectMemory integerValueOf: selectorOrMethod.
intOrClass = TraceContextSwitch ifTrue:
[self print: 'context switch'].
intOrClass = TraceBlockActivation ifTrue:
[self print: ' [] in '; printHex: selectorOrMethod].
intOrClass = TraceBlockCreation ifTrue:
[self print: 'create [] '; printHex: selectorOrMethod].
intOrClass = TraceIncrementalGC ifTrue:
[self print: 'incrementalGC'].
intOrClass = TraceFullGC ifTrue:
[self print: 'fullGC'].
intOrClass = TraceCodeCompaction ifTrue:
[self print: 'compactCode'].
intOrClass = TraceVMCallback ifTrue:
[self print: 'callback'].
intOrClass = TraceVMCallbackReturn ifTrue:
[self print: 'return from callback'].
intOrClass = TraceThreadSwitch ifTrue:
[self print: 'thread switch '; printNum: (value bitAnd: 16rFFFF); print: '->'; printNum: (value >> 16)].
intOrClass = TracePreemptDisowningThread ifTrue:
[self print: 'preempt thread '; printNum: value].
intOrClass = TraceOwnVM ifTrue:
[self print: 'ownVM '; printNum: value].
intOrClass = TraceDisownVM ifTrue:
[self print: 'disownVM '; printHex: value]]
ifFalse:
[self space; printNameOfClass: intOrClass count: 5; print: '>>'; printStringOf: selectorOrMethod].
source > TraceIsFromInterpreter ifTrue:
[self space; print: (traceSources at: source)].
self cr!
Item was changed:
----- Method: CoInterpreterMT>>recordThreadSwitchTo:source: (in category 'debug support') -----
recordThreadSwitchTo: ownerIndex source: sourceCode
cogit recordEventTrace ifTrue:
[self recordTrace: TraceThreadSwitch
thing: (objectMemory integerObjectOf: (ownerIndex << 16) + cogThreadManager getVMOwner)
source: sourceCode]!
Item was changed:
----- Method: CoInterpreterMT>>recordTrace:thing:source: (in category 'debug support') -----
recordTrace: classOrInteger thing: selector source: source
traceLog at: traceLogIndex put: classOrInteger.
traceLog at: traceLogIndex + 1 put: selector.
traceLog at: traceLogIndex + 2 put: source + (cogThreadManager getVMOwner bitShift: 16).
traceLogIndex := traceLogIndex + 3 \\ TraceBufferSize!
Item was changed:
----- Method: CoInterpreterMT>>setImageHeaderFlagsFrom: (in category 'image save/restore') -----
setImageHeaderFlagsFrom: headerFlags
"Set the flags that are contained in the 7th long of the image header."
imageHeaderFlags := headerFlags. "so as to preserve unrecognised flags."
fullScreenFlag := headerFlags bitAnd: 1.
imageFloatsBigEndian := (headerFlags bitAnd: 2) = 0 ifTrue: [1] ifFalse: [0].
processHasThreadId := (headerFlags bitAnd: 4) ~= 0.
flagInterpretedMethods := (headerFlags bitAnd: 8) ~= 0.
preemptionYields := (headerFlags bitAnd: 16) = 0.
noThreadingOfGUIThread := (headerFlags bitAnd: 32) ~= 0.
processHasThreadId ifFalse:
[self print: 'warning, processHasThreadId flag is unset; cannot function as a threaded VM if so.'; cr]!
Item was changed:
----- Method: CoInterpreterStackPages>>byteAt: (in category 'memory access') -----
byteAt: byteAddress "<Integer>"
self subclassResponsibility!
Item was added:
+ ----- Method: CoInterpreterStackPages>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+ self assert: (byteAddress >= minStackAddress and: [byteAddress < maxStackAddress]).
+ ^objectMemory longAt: byteAddress!
Item was removed:
- ----- Method: CoInterpreterStackPages>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
- self assert: (byteAddress >= minStackAddress and: [byteAddress < maxStackAddress]).
- ^objectMemory longAt: byteAddress!
Item was removed:
- ----- Method: CoInterpreterStackPages>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a32BitValue
- self assert: (byteAddress >= minStackAddress and: [byteAddress < maxStackAddress]).
- ^objectMemory longAt: byteAddress put: a32BitValue!
Item was added:
+ ----- Method: CoInterpreterStackPages>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ self assert: (byteAddress >= minStackAddress and: [byteAddress < maxStackAddress]).
+ ^objectMemory longAt: byteAddress put: a32BitValue!
Item was changed:
----- Method: CoInterpreterStackPagesLSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits long |
lowBits := byteAddress bitAnd: 3.
long := self longAt: byteAddress - lowBits.
^(lowBits caseOf: {
[0] -> [ long ].
[1] -> [ long bitShift: -8 ].
[2] -> [ long bitShift: -16 ].
[3] -> [ long bitShift: -24 ]
}) bitAnd: 16rFF!
Item was changed:
----- Method: CoInterpreterStackPagesLSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| lowBits long longAddress |
lowBits := byteAddress bitAnd: 3.
longAddress := byteAddress - lowBits.
long := self longAt: longAddress.
long := lowBits caseOf: {
[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16) ].
[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24) ]
}.
self longAt: longAddress put: long.
^byte!
Item was changed:
----- Method: CoInterpreterStackPagesMSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits bpwMinus1 |
bpwMinus1 := objectMemory wordSize - 1.
lowBits := byteAddress bitAnd: bpwMinus1.
^((self longAt: byteAddress - lowBits)
bitShift: (lowBits - bpwMinus1) * 8)
bitAnd: 16rFF!
Item was changed:
----- Method: CogARMCompiler>>callTargetFromReturnAddress: (in category 'inline cacheing') -----
callTargetFromReturnAddress: callSiteReturnAddress
"Answer the address the call immediately preceeding callSiteReturnAddress will jump to."
| callDistance call |
call := self instructionBeforeAddress: callSiteReturnAddress.
self assert: call ~= 0. "andeq r0, r0 will not be generated, not even as nops"
(self isBranch: call)
ifTrue: [ callDistance := (call bitAnd: 16r00FFFFFF) << 2.
"The distance is a signed 24bit number. Therefore, the highest (26th) bit has to be expanded"
(callDistance bitAnd: 16r02000000) ~= 0
ifTrue: [callDistance := callDistance bitOr: 16rFC000000]]
ifFalse: [ "A Long Jump. Extract the value saved to RISCTempReg from all the instructions before."
self notYetImplemented ].
^callSiteReturnAddress + 4 + callDistance signedIntFromLong!
Item was changed:
----- Method: CogARMCompiler>>computeMaximumSize (in category 'generate machine code') -----
computeMaximumSize
"Because we don't use Thumb, each ARM instruction has 4 bytes. Some abstract opcodes need more than one instruction."
| rotateableAt0then4or20Block |
rotateableAt0then4or20Block := [^self rotateable8bitImmediate: (operands at: 0)
ifTrue: [:r :i| maxSize := 4]
ifFalse: [maxSize := 20]].
(opcode between: FirstShortJump and: LastJump) ifTrue: [^maxSize := 16].
opcode
caseOf: {
[Label] -> [^maxSize := 0].
[AlignmentNops] -> [^maxSize := (operands at: 0) - 1].
[MoveAwR] -> [^maxSize := 16].
[MoveCqR] -> [^self rotateable8bitImmediate: (operands at: 0)
ifTrue: [:r :i| maxSize := 4]
ifFalse: [maxSize := 16]].
[MoveCwR] -> [^maxSize := 16].
[MoveRAw] -> [^maxSize := 16].
[MoveRMwr] -> [self is12BitValue: (operands at: 1)
ifTrue: [ :u :i | ^maxSize := 4]
ifFalse: [ ^maxSize := 20 ]].
[MoveRMbr] -> [self is12BitValue: (operands at: 1)
ifTrue: [ :u :i | ^maxSize := 4]
ifFalse: [ ^maxSize := 20 ]].
[MoveMwrR] -> [self is12BitValue: (operands at: 0)
ifTrue: [ :u :i | ^maxSize := 4]
ifFalse: [ ^maxSize := 20 ]].
[MoveMbrR] -> [self is12BitValue: (operands at: 0)
ifTrue: [ :u :i | ^maxSize := 4]
ifFalse: [ ^maxSize := 20 ]].
[PrefetchAw] -> [^maxSize := 16].
[Call] -> [^maxSize := 20 "recomputed in #sizePCDependentInstruction."].
[RetN] -> [^(operands at: 0) = 0
ifTrue: [maxSize := 4]
ifFalse: [maxSize := 8]].
[CmpCqR] -> [rotateableAt0then4or20Block value].
[AddCqR] -> [rotateableAt0then4or20Block value].
[SubCqR] -> [rotateableAt0then4or20Block value].
[AndCqR] -> [rotateableAt0then4or20Block value].
[OrCqR] -> [rotateableAt0then4or20Block value].
[XorCqR] -> [rotateableAt0then4or20Block value].
[CmpCwR] -> [^maxSize := 20].
[AddCwR] -> [^maxSize := 20].
[SubCwR] -> [^maxSize := 20].
[AndCwR] -> [^maxSize := 20].
[OrCwR] -> [^maxSize := 20].
[XorCwR] -> [^maxSize := 20].
[JumpR] -> [^maxSize := 4].
[JumpFPEqual] -> [^maxSize := 8].
[JumpFPNotEqual] -> [^maxSize := 8].
[JumpFPLess] -> [^maxSize := 8].
[JumpFPGreaterOrEqual]-> [^maxSize := 8].
[JumpFPGreater] -> [^maxSize := 8].
[JumpFPLessOrEqual] -> [^maxSize := 8].
[JumpFPOrdered] -> [^maxSize := 8].
[JumpFPUnordered] -> [^maxSize := 8].
[JumpLong] -> [^maxSize := 16].
[JumpLongZero] -> [^maxSize := 16].
[JumpLongNonZero] -> [^maxSize := 16].
[LoadEffectiveAddressMwrR] -> [rotateableAt0then4or20Block value].
[PushCw] -> [^maxSize := 20].
}
otherwise: [^maxSize := 4].
^4 "to keep C compiler quiet"
!
Item was added:
+ ----- Method: CogARMCompiler>>concretizeAddCqR (in category 'generate machine code - concretize') -----
+ concretizeAddCqR
+ "Will get inlined into concretizeAt: switch."
+ "Try whether the quick constant is a small negative number. If it is, optimize."
+ <inline: true>
+ self rotateable8bitImmediate: (operands at: 0)
+ ifTrue: [ :rot :immediate | | reg |
+ reg := self concreteRegister: (operands at: 1).
+ self machineCodeAt: 0 put: ((self t: 1 o: 4 s: 1) bitOr: reg << 16).
+ machineCode at: 0 put: immediate.
+ machineCode at: 1 put: (reg << 4 bitOr: rot).
+ ^machineCodeSize := 4]
+ ifFalse: [
+ self rotateable8bitImmediate: (operands at: 0) negated
+ ifTrue: [ :r :i |
+ opcode := SubCqR.
+ operands at: 0 put: (operands at: 0) negated.
+ ^self concretizeDataOperationCqR: 2]
+ ifFalse: [^self concretizeDataOperationCwR: 4]]!
Item was removed:
- ----- Method: CogARMCompiler>>concretizeAddCqR (in category 'generate machine code - concretize') -----
- concretizeAddCqR
- "Will get inlined into concretizeAt: switch."
- "Try whether the quick constant is a small negative number. If it is, optimize."
- <inline: true>
- self rotateable8bitImmediate: (operands at: 0)
- ifTrue: [ :rot :immediate | | reg |
- reg := self concreteRegister: (operands at: 1).
- self machineCodeAt: 0 put: ((self t: 1 o: 4 s: 1) bitOr: reg << 16).
- machineCode at: 0 put: immediate.
- machineCode at: 1 put: (reg << 4 bitOr: rot).
- ^machineCodeSize := 4]
- ifFalse: [
- self rotateable8bitImmediate: (operands at: 0) negated
- ifTrue: [ :r :i |
- opcode := SubCqR.
- operands at: 0 put: (operands at: 0) negated.
- ^self concretizeDataOperationCqR: 2]
- ifFalse: [^self concretizeDataOperationCwR: 4]]!
Item was added:
+ ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code - concretize') -----
+ concretizeArithmeticShiftRightRR
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | destReg distReg |
+ distReg := self concreteRegister: (operands at: 0).
+ destReg := self concreteRegister: (operands at: 1).
+ "cond 000 1101 0 0000 dest dist 0101 srcR"
+ self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: destReg
+ shifterOperand: (distReg << 8 bitOr: (80 bitOr: destReg))).
+ ^machineCodeSize := 4!
Item was removed:
- ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code - concretize') -----
- concretizeArithmeticShiftRightRR
- "Will get inlined into concretizeAt: switch."
- <inline: true>
- | destReg distReg |
- distReg := self concreteRegister: (operands at: 0).
- destReg := self concreteRegister: (operands at: 1).
- "cond 000 1101 0 0000 dest dist 0101 srcR"
- self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: destReg
- shifterOperand: (distReg << 8 bitOr: (80 bitOr: destReg))).
- ^machineCodeSize := 4!
Item was changed:
----- Method: CogARMCompiler>>concretizeAt: (in category 'generate machine code') -----
concretizeAt: actualAddress
"Generate concrete machine code for the instruction at actualAddress,
setting machineCodeSize, and answer the following address."
self assert: actualAddress \\ 4 = 0.
address := actualAddress.
self dispatchConcretize.
self assert: (maxSize = nil or: [maxSize >= machineCodeSize]).
^actualAddress + machineCodeSize!
Item was removed:
- ----- Method: CogARMCompiler>>concretizeCall (in category 'generate machine code - concretize') -----
- concretizeCall
- "Will get inlined into concretizeAt: switch."
- <inline: true>
- | offset |
- self assert: (operands at: 0) ~= 0.
- self assert: (operands at: 0) \\ 4 = 0.
- offset := (operands at: 0) signedIntFromLong - (address + 8 "normal pc offset") signedIntFromLong.
- (self isQuick: offset)
- ifTrue: [
- self machineCodeAt: 0 put: (self t: 5 o: 8) + (offset >> 2 bitAnd: 16r00FFFFFF). "BL offset"
- ^machineCodeSize := 4]
- ifFalse: [
- self error: 'While we know how to generate a long distance call, we can''t update such a send site yet. Please restart with smaller cache size'.
- self concretizeConditionalJumpLong: AL.
- "move the actual jump two instructions further, inserting the pc back-up to lr and the pc push."
- self machineCodeAt: 16 put: (self machineCodeAt: 12).
- "Because the pc always points to the actual address + 8, the value at pc is the address of the instruction after the branch"
- "mov lr, pc"
- self machineCodeAt: 12 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: LR shifterOperand: PC).
- ^machineCodeSize := 20]!
Item was added:
+ ----- Method: CogARMCompiler>>concretizeCall (in category 'generate machine code - concretize') -----
+ concretizeCall
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | offset |
+ self assert: (operands at: 0) ~= 0.
+ self assert: (operands at: 0) \\ 4 = 0.
+ offset := (operands at: 0) signedIntFromLong - (address + 8 "normal pc offset") signedIntFromLong.
+ (self isQuick: offset)
+ ifTrue: [
+ self machineCodeAt: 0 put: (self t: 5 o: 8) + (offset >> 2 bitAnd: 16r00FFFFFF). "BL offset"
+ ^machineCodeSize := 4]
+ ifFalse: [
+ self error: 'While we know how to generate a long distance call, we can''t update such a send site yet. Please restart with smaller cache size'.
+ self concretizeConditionalJumpLong: AL.
+ "move the actual jump two instructions further, inserting the pc back-up to lr and the pc push."
+ self machineCodeAt: 16 put: (self machineCodeAt: 12).
+ "Because the pc always points to the actual address + 8, the value at pc is the address of the instruction after the branch"
+ "mov lr, pc"
+ self machineCodeAt: 12 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: LR shifterOperand: PC).
+ ^machineCodeSize := 20]!
Item was added:
+ ----- Method: CogARMCompiler>>concretizeConditionalJumpLong: (in category 'generate machine code - concretize') -----
+ concretizeConditionalJumpLong: conditionCode
+ "Will get inlined into concretizeAt: switch."
+ "Sizing/generating jumps.
+ Jump targets can be to absolute addresses or other abstract instructions.
+ Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
+ Otherwise instructions must have a machineCodeSize which must be kept to."
+ <inline: true>
+ | jumpTarget |
+ <var: #jumpTarget type: #'AbstractInstruction *'>
+ jumpTarget := self longJumpTargetAddress.
+ self at: 0 moveCw: jumpTarget intoR: RISCTempReg.
+ "add pc, r3, #<byte 0>"
+ self machineCodeAt: 12 put: (self c: conditionCode t: 1 o: 4 s: 0 rn: RISCTempReg rd: PC shifterOperand: (jumpTarget bitAnd: 16rFF)).
+ ^machineCodeSize := 16!
Item was removed:
- ----- Method: CogARMCompiler>>concretizeConditionalJumpLong: (in category 'generate machine code - concretize') -----
- concretizeConditionalJumpLong: conditionCode
- "Will get inlined into concretizeAt: switch."
- "Sizing/generating jumps.
- Jump targets can be to absolute addresses or other abstract instructions.
- Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
- Otherwise instructions must have a machineCodeSize which must be kept to."
- <inline: true>
- | jumpTarget |
- <var: #jumpTarget type: #'AbstractInstruction *'>
- jumpTarget := self longJumpTargetAddress.
- self at: 0 moveCw: jumpTarget intoR: RISCTempReg.
- "add pc, r3, #<byte 0>"
- self machineCodeAt: 12 put: (self c: conditionCode t: 1 o: 4 s: 0 rn: RISCTempReg rd: PC shifterOperand: (jumpTarget bitAnd: 16rFF)).
- ^machineCodeSize := 16!
Item was removed:
- ----- Method: CogARMCompiler>>concretizeMoveRMbr (in category 'generate machine code - concretize') -----
- concretizeMoveRMbr
- "Will get inlined into concretizeAt: switch."
- <inline: true>
- | srcReg offset destReg |
- srcReg := self concreteRegister: (operands at: 0).
- offset := operands at: 1.
- destReg := self concreteRegister: (operands at: 2).
- self is12BitValue: offset
- ifTrue: [ :u :immediate |
- self machineCodeAt: 0
- "strb destReg, [srcReg, #immediate]"
- put: (self t: 2 o: (16rA bitOr: u<<2) s: 0 rn: destReg rd: srcReg shifterOperand: immediate).
- ^machineCodeSize := 4]
- ifFalse: [
- self at: 0 moveCw: offset intoR: RISCTempReg.
- "strb destReg, [srcReg, RISCTempReg]"
- self machineCodeAt: 16 put: (self t: 3 o: 16rE s: 0 rn: srcReg rd: destReg shifterOperand: RISCTempReg).
- ^machineCodeSize := 20 ]!
Item was added:
+ ----- Method: CogARMCompiler>>concretizeMoveRMbr (in category 'generate machine code - concretize') -----
+ concretizeMoveRMbr
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | srcReg offset destReg |
+ srcReg := self concreteRegister: (operands at: 0).
+ offset := operands at: 1.
+ destReg := self concreteRegister: (operands at: 2).
+ self is12BitValue: offset
+ ifTrue: [ :u :immediate |
+ self machineCodeAt: 0
+ "strb destReg, [srcReg, #immediate]"
+ put: (self t: 2 o: (16rA bitOr: u<<2) s: 0 rn: destReg rd: srcReg shifterOperand: immediate).
+ ^machineCodeSize := 4]
+ ifFalse: [
+ self at: 0 moveCw: offset intoR: RISCTempReg.
+ "strb destReg, [srcReg, RISCTempReg]"
+ self machineCodeAt: 16 put: (self t: 3 o: 16rE s: 0 rn: srcReg rd: destReg shifterOperand: RISCTempReg).
+ ^machineCodeSize := 20 ]!
Item was removed:
- ----- Method: CogARMCompiler>>concretizeSubCqR (in category 'generate machine code - concretize') -----
- concretizeSubCqR
- "Will get inlined into concretizeAt: switch."
- "Try whether the quick constant is a small negative number. If it is, optimize."
- <inline: true>
- self rotateable8bitImmediate: (operands at: 0)
- ifTrue: [ :rot :immediate | | reg |
- reg := self concreteRegister: (operands at: 1).
- self machineCodeAt: 0 put: ((self t: 1 o: 2 s: 1) bitOr: reg << 16).
- machineCode at: 0 put: immediate.
- machineCode at: 1 put: (reg << 4 bitOr: rot).
- ^machineCodeSize := 4]
- ifFalse: [
- self rotateable8bitImmediate: (operands at: 0) negated
- ifTrue: [ :r :i |
- opcode := AddCqR.
- operands at: 0 put: (operands at: 0) negated.
- ^self concretizeDataOperationCqR: 4]
- ifFalse: [^self concretizeDataOperationCwR: 2]]!
Item was added:
+ ----- Method: CogARMCompiler>>concretizeSubCqR (in category 'generate machine code - concretize') -----
+ concretizeSubCqR
+ "Will get inlined into concretizeAt: switch."
+ "Try whether the quick constant is a small negative number. If it is, optimize."
+ <inline: true>
+ self rotateable8bitImmediate: (operands at: 0)
+ ifTrue: [ :rot :immediate | | reg |
+ reg := self concreteRegister: (operands at: 1).
+ self machineCodeAt: 0 put: ((self t: 1 o: 2 s: 1) bitOr: reg << 16).
+ machineCode at: 0 put: immediate.
+ machineCode at: 1 put: (reg << 4 bitOr: rot).
+ ^machineCodeSize := 4]
+ ifFalse: [
+ self rotateable8bitImmediate: (operands at: 0) negated
+ ifTrue: [ :r :i |
+ opcode := AddCqR.
+ operands at: 0 put: (operands at: 0) negated.
+ ^self concretizeDataOperationCqR: 4]
+ ifFalse: [^self concretizeDataOperationCwR: 2]]!
Item was changed:
----- Method: CogARMCompiler>>dispatchConcretize (in category 'generate machine code') -----
dispatchConcretize
"Attempt to generate concrete machine code for the instruction at address.
This is the inner dispatch of concretizeAt: actualAddress which exists only
to get around the branch size limits in the SqueakV3 (blue book derived)
bytecode set."
<returnTypeC: #void>
opcode caseOf: {
"Noops & Pseudo Ops"
[Label] -> [^self concretizeLabel].
[AlignmentNops] -> [^self concretizeAlignmentNops].
[Fill16] -> [^self concretizeFill16].
[Fill32] -> [^self concretizeFill32].
[FillFromWord] -> [^self concretizeFillFromWord].
[Nop] -> [^self concretizeNop].
"Specific Control/Data Movement"
"[LDM] -> [^self concretizeLDM].
[STM] -> [^self concretizeSTM]."
"Control"
[Call] -> [^self concretizeCall].
[JumpR] -> [^self concretizeJumpR].
[JumpLong] -> [^self concretizeConditionalJumpLong: AL].
[JumpLongZero] -> [^self concretizeConditionalJumpLong: EQ].
[JumpLongNonZero] -> [^self concretizeConditionalJumpLong: NE].
[Jump] -> [^self concretizeConditionalJump: AL].
[JumpZero] -> [^self concretizeConditionalJump: EQ].
[JumpNonZero] -> [^self concretizeConditionalJump: NE].
[JumpNegative] -> [^self concretizeConditionalJump: MI].
[JumpNonNegative] -> [^self concretizeConditionalJump: PL].
[JumpOverflow] -> [^self concretizeConditionalJump: VS].
[JumpNoOverflow] -> [^self concretizeConditionalJump: VC].
[JumpCarry] -> [^self concretizeConditionalJump: CS].
[JumpNoCarry] -> [^self concretizeConditionalJump: CC].
[JumpLess] -> [^self concretizeConditionalJump: LT].
[JumpGreaterOrEqual] -> [^self concretizeConditionalJump: GE].
[JumpGreater] -> [^self concretizeConditionalJump: GT].
[JumpLessOrEqual] -> [^self concretizeConditionalJump: LE].
[JumpBelow] -> [^self concretizeConditionalJump: CC]. "unsigned lower"
[JumpAboveOrEqual] -> [^self concretizeConditionalJump: CS]. "unsigned greater or equal"
[JumpAbove] -> [^self concretizeConditionalJump: HI].
[JumpBelowOrEqual] -> [^self concretizeConditionalJump: LS].
[JumpFPEqual] -> [^self concretizeFPConditionalJump: EQ].
[JumpFPNotEqual] -> [^self concretizeFPConditionalJump: NE].
"[JumpFPLess] -> [^self concretizeFPConditionalJump: LT].
[JumpFPGreaterOrEqual] -> [^self concretizeFPConditionalJump: GE].
[JumpFPGreater] -> [^self concretizeFPConditionalJump: GT].
[JumpFPLessOrEqual] -> [^self concretizeFPConditionalJump: LE].
[JumpFPOrdered] -> [^self concretizeFPConditionalJump: VC].
[JumpFPUnordered] -> [^self concretizeFPConditionalJump: VS]."
[RetN] -> [^self concretizeRetN].
"Arithmetic"
[AddCqR] -> [^self concretizeAddCqR].
[AddCwR] -> [^self concretizeDataOperationCwR: 4].
[AddRR] -> [^self concretizeDataOperationRR: 4].
"[AddRdRd] -> [^self concretizeSEE2OpRdRd: 16r58]."
[AndCqR] -> [^self concretizeDataOperationCqR: 0].
[AndCwR] -> [^self concretizeDataOperationCwR: 0].
[AndRR] -> [^self concretizeDataOperationRR: 0].
[CmpCqR] -> [^self concretizeCmpCqR].
[CmpCwR] -> [^self concretizeCmpCwR].
[CmpRR] -> [^self concretizeCmpRR].
[CmpRdRd] -> [^self concretizeCmpRdRd].
"[DivRdRd] -> [^self concretizeSEE2OpRdRd: 16r5E].
[MulRdRd] -> [^self concretizeSEE2OpRdRd: 16r59]."
[OrCqR] -> [^self concretizeDataOperationCqR: 16rC].
[OrCwR] -> [^self concretizeDataOperationCwR: 16rC].
[OrRR] -> [^self concretizeDataOperationRR: 16rC].
[SubCqR] -> [^self concretizeSubCqR].
[SubCwR] -> [^self concretizeDataOperationCwR: 2].
[SubRR] -> [^self concretizeDataOperationRR: 2].
"[SubRdRd] -> [^self concretizeSEE2OpRdRd: 16r5C]."
[SqrtRd] -> [^self concretizeSqrtRd].
[XorCqR] -> [^self concretizeDataOperationCqR: 1].
[XorCwR] -> [^self concretizeDataOperationCwR: 1].
[XorRR] -> [^self concretizeDataOperationRR: 1].
[NegateR] -> [^self concretizeNegateR].
[LoadEffectiveAddressMwrR] -> [^self concretizeLoadEffectiveAddressMwrR].
[ArithmeticShiftRightCqR] -> [^self concretizeArithmeticShiftRightCqR].
[LogicalShiftRightCqR] -> [^self concretizeLogicalShiftRightCqR].
[LogicalShiftLeftCqR] -> [^self concretizeLogicalShiftLeftCqR].
[ArithmeticShiftRightRR] -> [^self concretizeArithmeticShiftRightRR].
[LogicalShiftLeftRR] -> [^self concretizeLogicalShiftLeftRR].
[LogicalShiftRightRR] -> [^self concretizeLogicalShiftRightRR].
"Data Movement"
[MoveCqR] -> [^self concretizeMoveCqR].
[MoveCwR] -> [^self concretizeMoveCwR].
[MoveRR] -> [^self concretizeMoveRR].
[MoveAwR] -> [^self concretizeMoveAwR].
[MoveRAw] -> [^self concretizeMoveRAw].
"While the two MoveMbR and MoveMwR are quite similar (off by 1 bit), they differ way more to
MoveM16R and MoveM64R. Because of that, they are not merged."
[MoveMbrR] -> [^self concretizeMoveMbrR].
[MoveRMbr] -> [^self concretizeMoveRMbr].
[MoveM16rR] -> [^self concretizeMoveM16rR].
[MoveM64rRd] -> [^self concretizeMoveM64rRd].
[MoveMwrR] -> [^self concretizeMoveMwrR].
[MoveXbrRR] -> [^self concretizeMoveXbrRR].
[MoveXwrRR] -> [^self concretizeMoveXwrRR].
[MoveRXwrR] -> [^self concretizeMoveRXwrR].
[MoveRMwr] -> [^self concretizeMoveRMwr].
[MoveRdM64r] -> [^self concretizeMoveRdM64r].
[PopR] -> [^self concretizePopR].
[PushR] -> [^self concretizePushR].
[PushCw] -> [^self concretizePushCw].
[PrefetchAw] -> [^self concretizePrefetchAw].
"Conversion"
[ConvertRRd] -> [^self concretizeConvertRRd].
"ARM specific opcodes"
[LDMFD] -> [^self concretizeLDMFD].
[STMFD] -> [^self concretizeSTMFD] }!
Item was changed:
----- Method: CogARMCompiler>>genSubstituteReturnAddress: (in category 'abstract instructions') -----
genSubstituteReturnAddress: retpc
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^cogit MoveCw: retpc R: LR!
Item was added:
+ ----- Method: CogARMCompiler>>generalPurposeRegisterMap (in category 'disassembly') -----
+ generalPurposeRegisterMap
+ <doNotGenerate>
+ "Answer a Dictionary from register getter to register index."
+ ^Dictionary newFromPairs:
+ { #r4. R4.
+ #r5. R5.
+ #r6. R6.
+ #r7. R7.
+ #r8. R8.
+ #r9. R9 }!
Item was removed:
- ----- Method: CogARMCompiler>>generalPurposeRegisterMap (in category 'disassembly') -----
- generalPurposeRegisterMap
- <doNotGenerate>
- "Answer a Dictionary from register getter to register index."
- ^Dictionary newFromPairs:
- { #r4. R4.
- #r5. R5.
- #r6. R6.
- #r7. R7.
- #r8. R8.
- #r9. R9 }!
Item was changed:
----- Method: CogARMCompiler>>instructionBeforeAddress: (in category 'inline cacheing') -----
instructionBeforeAddress: followingAddress
"Answer the instruction immediately preceeding followingAddress."
^ ((objectMemory byteAt: followingAddress - 1) << 24)
+ ((objectMemory byteAt: followingAddress - 2) << 16)
+ ((objectMemory byteAt: followingAddress - 3) << 8)
+ (objectMemory byteAt: followingAddress - 4)
!
Item was changed:
----- Method: CogARMCompiler>>machineCodeBytes (in category 'generate machine code') -----
machineCodeBytes
"Answer the maximum number of bytes of machine code generated for any abstract instruction.
e.g. CmpCwR =>
mov R3, #<addressByte1>, 12
orr R3, R3, #<addressByte2>, 8
orr R3, R3, #<addressByte3>, 4
orr R3, R3, #<addressByte4>, 0
cmp R?, R3"
^20!
Item was removed:
- ----- Method: CogARMCompiler>>rewriteInlineCacheAt:tag:target: (in category 'inline cacheing') -----
- rewriteInlineCacheAt: callSiteReturnAddress tag: cacheTag target: callTargetAddress
- "Rewrite an inline cache to call a different target for a new tag. This variant is used
- to link unlinked sends in ceSend:to:numArgs: et al. Answer the extent of the code
- change which is used to compute the range of the icache to flush."
-
- "chacheTag contains an oop to the selector which need be loaded before jumping"
- <var: #callSiteReturnAddress type: #usqInt>
- <var: #callTargetAddress type: #usqInt>
- | call callDistance |
- "self cCode: ''
- inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress -1]."
- false
- ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
- ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
- [self error: 'linking callsite to invalid address']].
- callDistance := (callTargetAddress - (callSiteReturnAddress + 8 "pc offset"- 4 "return offset")) signedIntToLong.
-
- self assert: (self isQuick: callDistance). "we don't support long call updates, yet"
- call := (self t: 5 o: 8)"BL" + (callDistance >> 2 bitAnd: 16rFFFFFF).
- objectMemory
- byteAt: callSiteReturnAddress - 1 put: (call >> 24 bitAnd: 16rFF);
- byteAt: callSiteReturnAddress - 2 put: (call >> 16 bitAnd: 16rFF);
- byteAt: callSiteReturnAddress - 3 put: (call >> 8 bitAnd: 16rFF);
- byteAt: callSiteReturnAddress - 4 put: (call bitAnd: 16rFF).
-
- "The cacheTag is loaded byte by byte. Each byte needs to be encoded with minimal right ring rotation. See also #at:moveCw:intoR:"
- -20 to: -8 by: 4 do: [ :offset || rotation |
- rotation := self minimalRightRingRotationFor: cacheTag initialRotation: (offset + 8) negated.
- (offset + 8) ~= 0 ifTrue: [ "in case of decoration which may change the last instrution, we should not overwrite bits 9 to 12"
- objectMemory
- byteAt: callSiteReturnAddress + offset + 1
- put: (((objectMemory byteAt: callSiteReturnAddress - offset + 1)
- bitAnd: 16rF0)
- bitOr: (rotation at: 1))].
- objectMemory
- byteAt: callSiteReturnAddress + offset
- put: (rotation at: 2)].
-
- self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
- "self cCode: ''
- inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1]."
- ^20!
Item was added:
+ ----- Method: CogARMCompiler>>rewriteInlineCacheAt:tag:target: (in category 'inline cacheing') -----
+ rewriteInlineCacheAt: callSiteReturnAddress tag: cacheTag target: callTargetAddress
+ "Rewrite an inline cache to call a different target for a new tag. This variant is used
+ to link unlinked sends in ceSend:to:numArgs: et al. Answer the extent of the code
+ change which is used to compute the range of the icache to flush."
+
+ "chacheTag contains an oop to the selector which need be loaded before jumping"
+ <var: #callSiteReturnAddress type: #usqInt>
+ <var: #callTargetAddress type: #usqInt>
+ | call callDistance |
+ "self cCode: ''
+ inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress -1]."
+ false
+ ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
+ ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
+ [self error: 'linking callsite to invalid address']].
+ callDistance := (callTargetAddress - (callSiteReturnAddress + 8 "pc offset"- 4 "return offset")) signedIntToLong.
+
+ self assert: (self isQuick: callDistance). "we don't support long call updates, yet"
+ call := (self t: 5 o: 8)"BL" + (callDistance >> 2 bitAnd: 16rFFFFFF).
+ objectMemory
+ byteAt: callSiteReturnAddress - 1 put: (call >> 24 bitAnd: 16rFF);
+ byteAt: callSiteReturnAddress - 2 put: (call >> 16 bitAnd: 16rFF);
+ byteAt: callSiteReturnAddress - 3 put: (call >> 8 bitAnd: 16rFF);
+ byteAt: callSiteReturnAddress - 4 put: (call bitAnd: 16rFF).
+
+ "The cacheTag is loaded byte by byte. Each byte needs to be encoded with minimal right ring rotation. See also #at:moveCw:intoR:"
+ -20 to: -8 by: 4 do: [ :offset || rotation |
+ rotation := self minimalRightRingRotationFor: cacheTag initialRotation: (offset + 8) negated.
+ (offset + 8) ~= 0 ifTrue: [ "in case of decoration which may change the last instrution, we should not overwrite bits 9 to 12"
+ objectMemory
+ byteAt: callSiteReturnAddress + offset + 1
+ put: (((objectMemory byteAt: callSiteReturnAddress - offset + 1)
+ bitAnd: 16rF0)
+ bitOr: (rotation at: 1))].
+ objectMemory
+ byteAt: callSiteReturnAddress + offset
+ put: (rotation at: 2)].
+
+ self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
+ "self cCode: ''
+ inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1]."
+ ^20!
Item was changed:
----- Method: CogARMCompiler>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
sizePCDependentInstructionAt: eventualAbsoluteAddress
"Size a jump and set its address. The target may be another instruction
or an absolute address. On entry the address inst var holds our virtual
address. On exit address is set to eventualAbsoluteAddress, which is
where this instruction will be output. The span of a jump to a following
instruction is therefore between that instruction's address and this
instruction's address ((which are both still their virtual addresses), but the
span of a jump to a preceeding instruction or to an absolute address is
between that instruction's address (which by now is its eventual absolute
address) or absolute address and eventualAbsoluteAddress."
| target maximumSpan abstractInstruction |
<var: #abstractInstruction type: #'AbstractInstruction *'>
opcode = AlignmentNops ifTrue:
[| alignment |
address := eventualAbsoluteAddress.
alignment := operands at: 0.
^machineCodeSize := (eventualAbsoluteAddress + (alignment - 1) bitAnd: alignment negated)
- eventualAbsoluteAddress].
self assert: (self isJump or: [opcode = Call]).
self isJump ifTrue: [self resolveJumpTarget].
target := operands at: 0.
abstractInstruction := cogit cCoerceSimple: target to: #'AbstractInstruction *'.
"maximumSpan calculation copied from CogIA32Compiler TODO: extract method?"
(self isAnInstruction: abstractInstruction)
ifTrue:
[maximumSpan := abstractInstruction address
- (((cogit abstractInstruction: self follows: abstractInstruction)
ifTrue: [eventualAbsoluteAddress]
ifFalse: [address]) + 2)]
ifFalse:
[maximumSpan := target - (eventualAbsoluteAddress + 2)].
address := eventualAbsoluteAddress.
^machineCodeSize := opcode = Call
ifTrue: [(self isQuick: maximumSpan) ifTrue: [4] ifFalse: [20]]
ifFalse: [(self isLongJump not and: [self isQuick: maximumSpan])
ifTrue: [4]
ifFalse: [16]] "load address to register, add"!
Item was removed:
- ----- Method: CogARMCompiler>>stackPageInterruptHeadroomBytes (in category 'accessing') -----
- stackPageInterruptHeadroomBytes
- "Return a minimum amount of headroom for each stack page (in bytes). In a
- JIT the stack has to have room for interrupt handlers which will run on the stack.
- According to ARM architecture v5 reference manual chapter A2.6, the basic interrupt procedure does not push anything onto the stack. It uses SPSR_err and R14_err to preserve state. Afterwards, it calls an interrupt procedure. So leave some room."
- ^128 "32 words"!
Item was added:
+ ----- Method: CogARMCompiler>>stackPageInterruptHeadroomBytes (in category 'accessing') -----
+ stackPageInterruptHeadroomBytes
+ "Return a minimum amount of headroom for each stack page (in bytes). In a
+ JIT the stack has to have room for interrupt handlers which will run on the stack.
+ According to ARM architecture v5 reference manual chapter A2.6, the basic interrupt procedure does not push anything onto the stack. It uses SPSR_err and R14_err to preserve state. Afterwards, it calls an interrupt procedure. So leave some room."
+ ^128 "32 words"!
Item was changed:
----- Method: CogAbstractInstruction class>>byteSizeForSimulator: (in category 'simulation only') -----
byteSizeForSimulator: aVMClass
"Answer an approximation of the byte size of an AbstractInstruction struct.
This is for estimating the alloca in allocateOpcodes:bytecodes:ifFail:"
| concreteClass ptrsize |
concreteClass := aVMClass processor abstractInstructionCompilerClass.
ptrsize := aVMClass sizeof: #'void *'.
^concreteClass instSize - 4 "cogit, objectMemory et al" * ptrsize
+ concreteClass basicNew machineCodeBytes
roundTo: ptrsize!
Item was removed:
- ----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct."
- "{CogAbstractInstruction. CogIA32Compiler. CogARMCompiler} do:
- [:c| Transcript print: c; cr. c printTypedefOn: Transcript]"
- | machineCodeBytes |
- machineCodeBytes := self == CogAbstractInstruction
- ifTrue: [0]
- ifFalse: [self basicNew machineCodeBytes].
- (self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do:
- [:ivn|
- ivn ~= 'bcpc' ifTrue:
- [aBinaryBlock
- value: ivn
- value: (ivn caseOf: {
- ['address'] -> ['unsigned long'].
- ['machineCode'] -> [{'unsigned char'. '[', machineCodeBytes printString, ']'}].
- ['operands'] -> [{'unsigned long'. '[', NumOperands, ']'}].
- ['dependent'] -> ['struct _AbstractInstruction *']}
- otherwise:
- [#char])]]!
Item was added:
+ ----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct."
+ "{CogAbstractInstruction. CogIA32Compiler. CogARMCompiler} do:
+ [:c| Transcript print: c; cr. c printTypedefOn: Transcript]"
+ | machineCodeBytes |
+ machineCodeBytes := self == CogAbstractInstruction
+ ifTrue: [0]
+ ifFalse: [self basicNew machineCodeBytes].
+ (self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do:
+ [:ivn|
+ ivn ~= 'bcpc' ifTrue:
+ [aBinaryBlock
+ value: ivn
+ value: (ivn caseOf: {
+ ['address'] -> ['unsigned long'].
+ ['machineCode'] -> [{'unsigned char'. '[', machineCodeBytes printString, ']'}].
+ ['operands'] -> [{'unsigned long'. '[', NumOperands, ']'}].
+ ['dependent'] -> ['struct _AbstractInstruction *']}
+ otherwise:
+ [#char])]]!
Item was removed:
- ----- Method: CogAbstractInstruction>>callInstructionByteSize (in category 'accessing') -----
- callInstructionByteSize
- self subclassResponsibility!
Item was added:
+ ----- Method: CogAbstractInstruction>>callInstructionByteSize (in category 'accessing') -----
+ callInstructionByteSize
+ self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>computeJumpTargetOffsetPlus: (in category 'generate machine code') -----
computeJumpTargetOffsetPlus: anPCOffset
<inline: true> "Since it's an extraction from other methods."
| jumpTarget |
<var: #jumpTarget type: #'AbstractInstruction *'>
jumpTarget := self jumpTargetAddress.
^jumpTarget signedIntFromLong - (address + anPCOffset) signedIntFromLong.!
Item was changed:
----- Method: CogAbstractInstruction>>concretizeAt: (in category 'generate machine code') -----
concretizeAt: actualAddress
"Generate concrete machine code for the instruction at actualAddress,
setting machineCodeSize, and answer the following address."
self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>concretizeFill16 (in category 'generate machine code') -----
concretizeFill16
"fill with (operand 0 bitAnd: 16rFFFF) according to the processor's endianness"
self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>concretizeFill32 (in category 'generate machine code') -----
concretizeFill32
"fill with operand 0 according to the processor's endianness"
self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>concretizeFillFromWord (in category 'generate machine code') -----
concretizeFillFromWord
"fill with operand 0 + operand 1 according to the processor's endianness"
self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>concretizeLabel (in category 'generate machine code') -----
concretizeLabel
<var: #dependentChain type: #'AbstractInstruction *'>
| dependentChain |
dependentChain := dependent.
[dependentChain isNil] whileFalse:
[dependentChain updateLabel: self.
dependentChain := dependentChain dependent].
^machineCodeSize := 0!
Item was changed:
----- Method: CogAbstractInstruction>>genJumpFPEqual: (in category 'abstract instructions') -----
genJumpFPEqual: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^cogit gen: JumpFPEqual operand: jumpTarget asInteger!
Item was changed:
----- Method: CogAbstractInstruction>>genJumpFPGreater: (in category 'abstract instructions') -----
genJumpFPGreater: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^cogit gen: JumpFPGreater operand: jumpTarget asInteger!
Item was changed:
----- Method: CogAbstractInstruction>>genJumpFPGreaterOrEqual: (in category 'abstract instructions') -----
genJumpFPGreaterOrEqual: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^cogit gen: JumpFPGreaterOrEqual operand: jumpTarget asInteger!
Item was changed:
----- Method: CogAbstractInstruction>>genJumpFPLess: (in category 'abstract instructions') -----
genJumpFPLess: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^cogit gen: JumpFPLess operand: jumpTarget asInteger!
Item was changed:
----- Method: CogAbstractInstruction>>genJumpFPLessOrEqual: (in category 'abstract instructions') -----
genJumpFPLessOrEqual: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^cogit gen: JumpFPLessOrEqual operand: jumpTarget asInteger!
Item was removed:
- ----- Method: CogAbstractInstruction>>genJumpFPNotEqual: (in category 'abstract instructions') -----
- genJumpFPNotEqual: jumpTarget
- <inline: true>
- <returnTypeC: #'AbstractInstruction *'>
- <var: #jumpTarget type: #'void *'>
- ^cogit gen: JumpFPNotEqual operand: jumpTarget asInteger!
Item was added:
+ ----- Method: CogAbstractInstruction>>genJumpFPNotEqual: (in category 'abstract instructions') -----
+ genJumpFPNotEqual: jumpTarget
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ <var: #jumpTarget type: #'void *'>
+ ^cogit gen: JumpFPNotEqual operand: jumpTarget asInteger!
Item was changed:
----- Method: CogAbstractInstruction>>genSubstituteReturnAddress: (in category 'abstract instructions') -----
genSubstituteReturnAddress: retpc
"Fake the return address for a call/jump so that the ``call'' returns
to retpc given that the ``call'' will be made by a following jump."
self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>generateICacheFlush (in category 'inline cacheing') -----
generateICacheFlush
"A dummy routine.
Processors that can generate code to flush the icache can override."
!
Item was changed:
----- Method: CogAbstractInstruction>>generateLowLevelTryLock: (in category 'multi-threading') -----
generateLowLevelTryLock: vmOwnerLockAddress
self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>generateLowLevelUnlock: (in category 'multi-threading') -----
generateLowLevelUnlock: vmOwnerLockAddress
self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>jumpLongTargetBeforeFollowingAddress: (in category 'inline cacheing') -----
jumpLongTargetBeforeFollowingAddress: mcpc
^self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>jumpTargetAddress (in category 'generate machine code') -----
jumpTargetAddress
<inline: true> "Since it's an extraction from other methods."
| jumpTarget |
<var: #jumpTarget type: #'AbstractInstruction *'>
jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
cogit assertSaneJumpTarget: jumpTarget.
(self isAnInstruction: jumpTarget) ifTrue:
[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
self assert: jumpTarget ~= 0.
^jumpTarget!
Item was changed:
----- Method: CogAbstractInstruction>>labelOffset (in category 'generate machine code') -----
labelOffset
"To arrange that the block method field pushed in a block entry has
its MFMethodFlagIsBlockFlag bit set we provide labels with an offset.
The offset for the fakeHeader reference is MFMethodFlagIsBlockFlag.
See compileBlockFrameBuild:"
^operands at: 1!
Item was changed:
----- Method: CogAbstractInstruction>>longJumpTargetAddress (in category 'generate machine code') -----
longJumpTargetAddress
<inline: true> "Since it's an extraction from other methods."
"This needs to be digfferent from jumpTargetAddress because long jumps can
be to absolute addresses and hence we can't assert that the jump target is sane."
| jumpTarget |
<var: #jumpTarget type: #'AbstractInstruction *'>
jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
(self isAnInstruction: jumpTarget) ifTrue:
[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
self assert: jumpTarget ~= 0.
^jumpTarget!
Item was changed:
----- Method: CogAbstractInstruction>>machineCodeBytes (in category 'generate machine code') -----
machineCodeBytes
"Answer the maximum number of bytes of machine code generated for any abstract instruction."
self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>numICacheFlushOpcodes (in category 'inline cacheing') -----
numICacheFlushOpcodes
"If the processor has the ablity to generate code to flush the icache answer
the number of opcodes required to compile an accessor for the feature."
^0!
Item was changed:
----- Method: CogAbstractInstruction>>numLowLevelLockOpcodes (in category 'multi-threading') -----
numLowLevelLockOpcodes
self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>relocateCallBeforeReturnPC:by: (in category 'inline cacheing') -----
relocateCallBeforeReturnPC: retpc by: delta
^self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>relocateJumpBeforeFollowingAddress:by: (in category 'inline cacheing') -----
relocateJumpBeforeFollowingAddress: pc by: delta
^self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>resolveJumpTarget (in category 'generate machine code') -----
resolveJumpTarget
<var: #fixup type: #'BytecodeFixup *'>
| fixup |
self assert: self isJump.
fixup := cogit cCoerceSimple: (operands at: 0) to: #'BytecodeFixup *'.
self cCode: [] inSmalltalk:
[(fixup isKindOf: CogBytecodeFixup) ifTrue:
[self assert: (self isAFixup: fixup)]].
(self isAFixup: fixup) ifTrue:
[self assert: (cogit addressIsInInstructions: fixup targetInstruction).
self jmpTarget: fixup targetInstruction]!
Item was changed:
----- Method: CogAbstractInstruction>>setLabelOffset: (in category 'generate machine code') -----
setLabelOffset: aValue
"Hack: To arrange that the block method field pushed in a block entry has
its MFMethodFlagIsBlockFlag bit set we provide labels with an offset. The
offset for the fakeHeader reference is MFMethodFlagIsBlockFlag. See
compileBlockFrameBuild:"
^operands at: 1 put: aValue!
Item was added:
+ ----- Method: CogAbstractInstruction>>stackPageInterruptHeadroomBytes (in category 'accessing') -----
+ stackPageInterruptHeadroomBytes
+ "Return a minimum amount of headroom for each stack page (in bytes). In a
+ JIT the stack has to have room for interrupt handlers which will run on the stack."
+ self subclassResponsibility!
Item was removed:
- ----- Method: CogAbstractInstruction>>stackPageInterruptHeadroomBytes (in category 'accessing') -----
- stackPageInterruptHeadroomBytes
- "Return a minimum amount of headroom for each stack page (in bytes). In a
- JIT the stack has to have room for interrupt handlers which will run on the stack."
- self subclassResponsibility!
Item was removed:
- ----- Method: CogAbstractInstruction>>unalignedLongAt: (in category 'memory access') -----
- unalignedLongAt: byteAddress
- ^self subclassResponsibility!
Item was added:
+ ----- Method: CogAbstractInstruction>>unalignedLongAt: (in category 'memory access') -----
+ unalignedLongAt: byteAddress
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: CogAbstractInstruction>>unalignedLongAt:put: (in category 'memory access') -----
- unalignedLongAt: byteAddress put: aWord
- ^self subclassResponsibility!
Item was added:
+ ----- Method: CogAbstractInstruction>>unalignedLongAt:put: (in category 'memory access') -----
+ unalignedLongAt: byteAddress put: aWord
+ ^self subclassResponsibility!
Item was changed:
----- Method: CogAbstractInstruction>>updateLabel: (in category 'generate machine code') -----
updateLabel: labelInstruction
"Update an instruction that depends on a label outside of
generated code (e.g. a method or block header)."
<var: #labelInstruction type: #'AbstractInstruction *'>
| offsetAddress |
offsetAddress := labelInstruction address + labelInstruction labelOffset.
opcode caseOf: {
[MoveCwR] -> [operands at: 0 put: offsetAddress].
[PushCw] -> [operands at: 0 put: offsetAddress].
[FillFromWord] -> [operands at: 0 put: offsetAddress]}!
Item was added:
+ ----- Method: CogBlockMethod class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the
+ inst vars to include in a CogMethod or CogBlockMethod struct."
+
+ self allInstVarNames do:
+ [:ivn|
+ "Notionally objectHeader is in a union with homeOffset and startpc but
+ we don't have any convenient support for unions. So hack, hack, hack, hack."
+ ((self == CogBlockMethod
+ ifTrue: [#('objectHeader')]
+ ifFalse: [#('homeOffset' 'startpc' 'padToWord')]) includes: ivn) ifFalse:
+ [aBinaryBlock
+ value: ivn
+ value: (ivn caseOf: {
+ ['objectHeader'] -> [self objectMemoryClass baseHeaderSize = 8
+ ifTrue: [#sqLong]
+ ifFalse: [#sqInt]].
+ ['cmNumArgs'] -> [#(unsigned ' : 8')]. "SqueakV3 needs only 5 bits"
+ ['cmType'] -> [#(unsigned ' : 3')].
+ ['cmRefersToYoung'] -> [#(unsigned #Boolean ' : 1')].
+ ['cpicHasMNUCase'] -> [#(unsigned #Boolean ' : 1')].
+ ['cmUsageCount'] -> [#(unsigned ' : 3')]. "see CMMaxUsageCount in initialize"
+ ['cmUsesPenultimateLit'] -> [#(unsigned #Boolean ' : 1')].
+ ['cmUsesMethodClass'] -> [#(unsigned #Boolean ' : 1')].
+ ['cmUnusedFlags'] -> [#(unsigned ' : 2')].
+ ['stackCheckOffset'] -> [#(unsigned ' : 12')]. "See MaxStackCheckOffset in initialize. a.k.a. cPICNumCases"
+ ['blockSize'] -> [#'unsigned short']. "See MaxMethodSize in initialize"
+ ['blockEntryOffset'] -> [#'unsigned short'].
+ ['homeOffset'] -> [#'unsigned short'].
+ ['startpc'] -> [#'unsigned short'].
+ ['padToWord'] -> [#(#BaseHeaderSize 8 'unsigned int')].
+ ['nextMethod'] -> ['struct _CogMethod *']} "see NewspeakCogMethod"
+ otherwise:
+ [#sqInt])]]!
Item was removed:
- ----- Method: CogBlockMethod class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the
- inst vars to include in a CogMethod or CogBlockMethod struct."
-
- self allInstVarNames do:
- [:ivn|
- "Notionally objectHeader is in a union with homeOffset and startpc but
- we don't have any convenient support for unions. So hack, hack, hack, hack."
- ((self == CogBlockMethod
- ifTrue: [#('objectHeader')]
- ifFalse: [#('homeOffset' 'startpc' 'padToWord')]) includes: ivn) ifFalse:
- [aBinaryBlock
- value: ivn
- value: (ivn caseOf: {
- ['objectHeader'] -> [self objectMemoryClass baseHeaderSize = 8
- ifTrue: [#sqLong]
- ifFalse: [#sqInt]].
- ['cmNumArgs'] -> [#(unsigned ' : 8')]. "SqueakV3 needs only 5 bits"
- ['cmType'] -> [#(unsigned ' : 3')].
- ['cmRefersToYoung'] -> [#(unsigned #Boolean ' : 1')].
- ['cpicHasMNUCase'] -> [#(unsigned #Boolean ' : 1')].
- ['cmUsageCount'] -> [#(unsigned ' : 3')]. "see CMMaxUsageCount in initialize"
- ['cmUsesPenultimateLit'] -> [#(unsigned #Boolean ' : 1')].
- ['cmUsesMethodClass'] -> [#(unsigned #Boolean ' : 1')].
- ['cmUnusedFlags'] -> [#(unsigned ' : 2')].
- ['stackCheckOffset'] -> [#(unsigned ' : 12')]. "See MaxStackCheckOffset in initialize. a.k.a. cPICNumCases"
- ['blockSize'] -> [#'unsigned short']. "See MaxMethodSize in initialize"
- ['blockEntryOffset'] -> [#'unsigned short'].
- ['homeOffset'] -> [#'unsigned short'].
- ['startpc'] -> [#'unsigned short'].
- ['padToWord'] -> [#(#BaseHeaderSize 8 'unsigned int')].
- ['nextMethod'] -> ['struct _CogMethod *']} "see NewspeakCogMethod"
- otherwise:
- [#sqInt])]]!
Item was added:
+ ----- Method: CogBlockMethod>>cmNumArgs: (in category 'accessing') -----
+ cmNumArgs: anObject
+ "Set the value of cmNumArgs"
+
+ ^cmNumArgs := anObject!
Item was removed:
- ----- Method: CogBlockMethod>>cmNumArgs: (in category 'accessing') -----
- cmNumArgs: anObject
- "Set the value of cmNumArgs"
-
- ^cmNumArgs := anObject!
Item was removed:
- ----- Method: CogBlockMethod>>cmRefersToYoung (in category 'accessing') -----
- cmRefersToYoung
- "Answer the value of cmRefersToYoung"
-
- ^cmRefersToYoung!
Item was added:
+ ----- Method: CogBlockMethod>>cmRefersToYoung (in category 'accessing') -----
+ cmRefersToYoung
+ "Answer the value of cmRefersToYoung"
+
+ ^cmRefersToYoung!
Item was added:
+ ----- Method: CogBlockMethod>>cmRefersToYoung: (in category 'accessing') -----
+ cmRefersToYoung: anObject
+ "Set the value of cmRefersToYoung"
+
+ ^cmRefersToYoung := anObject!
Item was removed:
- ----- Method: CogBlockMethod>>cmRefersToYoung: (in category 'accessing') -----
- cmRefersToYoung: anObject
- "Set the value of cmRefersToYoung"
-
- ^cmRefersToYoung := anObject!
Item was removed:
- ----- Method: CogBlockMethod>>cmUsesMethodClass (in category 'accessing') -----
- cmUsesMethodClass
- "Answer the value of cmUsesMethodClass"
-
- ^cmUsesMethodClass!
Item was added:
+ ----- Method: CogBlockMethod>>cmUsesMethodClass (in category 'accessing') -----
+ cmUsesMethodClass
+ "Answer the value of cmUsesMethodClass"
+
+ ^cmUsesMethodClass!
Item was added:
+ ----- Method: CogBlockMethod>>cmUsesMethodClass: (in category 'accessing') -----
+ cmUsesMethodClass: anObject
+ "Set the value of cmUsesMethodClass"
+
+ ^cmUsesMethodClass := anObject!
Item was removed:
- ----- Method: CogBlockMethod>>cmUsesMethodClass: (in category 'accessing') -----
- cmUsesMethodClass: anObject
- "Set the value of cmUsesMethodClass"
-
- ^cmUsesMethodClass := anObject!
Item was added:
+ ----- Method: CogBlockMethod>>cmUsesPenultimateLit (in category 'accessing') -----
+ cmUsesPenultimateLit
+ "Answer the value of cmUsesPenultimateLit"
+
+ ^cmUsesPenultimateLit!
Item was removed:
- ----- Method: CogBlockMethod>>cmUsesPenultimateLit (in category 'accessing') -----
- cmUsesPenultimateLit
- "Answer the value of cmUsesPenultimateLit"
-
- ^cmUsesPenultimateLit!
Item was added:
+ ----- Method: CogBlockMethod>>stackCheckOffset (in category 'accessing') -----
+ stackCheckOffset
+ "Answer the value of stackCheckOffset"
+
+ ^stackCheckOffset!
Item was removed:
- ----- Method: CogBlockMethod>>stackCheckOffset (in category 'accessing') -----
- stackCheckOffset
- "Answer the value of stackCheckOffset"
-
- ^stackCheckOffset!
Item was removed:
- ----- Method: CogBlockMethod>>startpc: (in category 'accessing') -----
- startpc: anObject
- "Set the value of startpc"
-
- ^startpc := anObject!
Item was added:
+ ----- Method: CogBlockMethod>>startpc: (in category 'accessing') -----
+ startpc: anObject
+ "Set the value of startpc"
+
+ ^startpc := anObject!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32 class>>alignedByteSize (in category 'accessing') -----
+ alignedByteSize
+ ^4 + self baseHeaderSize!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32 class>>alignedByteSize (in category 'accessing') -----
- alignedByteSize
- ^4 + self baseHeaderSize!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cmHomeMethod (in category 'accessing') -----
+ cmHomeMethod
+ ^cogit cogMethodSurrogateAt: address - self homeOffset!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmHomeMethod (in category 'accessing') -----
- cmHomeMethod
- ^cogit cogMethodSurrogateAt: address - self homeOffset!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmIsUnlinked: (in category 'accessing') -----
- cmIsUnlinked: aValue
- memory
- unsignedByteAt: address + 6
- put: (((memory unsignedByteAt: address + 6) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)).
- ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cmIsUnlinked: (in category 'accessing') -----
+ cmIsUnlinked: aValue
+ memory
+ unsignedByteAt: address + 6
+ put: (((memory unsignedByteAt: address + 6) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)).
+ ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cmNumArgs (in category 'accessing') -----
+ cmNumArgs
+ ^memory unsignedByteAt: address + 1 + baseHeaderSize!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmNumArgs (in category 'accessing') -----
- cmNumArgs
- ^memory unsignedByteAt: address + 1 + baseHeaderSize!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cmType (in category 'accessing') -----
+ cmType
+ ^(memory unsignedByteAt: address + 2 + baseHeaderSize) bitAnd: 16r7!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmType (in category 'accessing') -----
- cmType
- ^(memory unsignedByteAt: address + 2 + baseHeaderSize) bitAnd: 16r7!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cmType: (in category 'accessing') -----
+ cmType: aValue
+ self assert: (aValue between: 0 and: 16r7).
+ memory
+ unsignedByteAt: address + baseHeaderSize + 2
+ put: ((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rF8) + aValue.
+ ^aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmType: (in category 'accessing') -----
- cmType: aValue
- self assert: (aValue between: 0 and: 16r7).
- memory
- unsignedByteAt: address + baseHeaderSize + 2
- put: ((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rF8) + aValue.
- ^aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmUsageCount (in category 'accessing') -----
- cmUsageCount
- ^((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -5) bitAnd: 16r7!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cmUsageCount (in category 'accessing') -----
+ cmUsageCount
+ ^((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -5) bitAnd: 16r7!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmUsageCount: (in category 'accessing') -----
- cmUsageCount: aValue
- self assert: (aValue between: 0 and: 16r7).
- memory
- unsignedByteAt: address + baseHeaderSize + 2
- put: ((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16r1F) + (aValue bitShift: 5).
- ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cmUsageCount: (in category 'accessing') -----
+ cmUsageCount: aValue
+ self assert: (aValue between: 0 and: 16r7).
+ memory
+ unsignedByteAt: address + baseHeaderSize + 2
+ put: ((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16r1F) + (aValue bitShift: 5).
+ ^aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmUsesMethodClass: (in category 'accessing') -----
- cmUsesMethodClass: aValue
- memory
- unsignedByteAt: address + baseHeaderSize + 3
- put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
- ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cmUsesMethodClass: (in category 'accessing') -----
+ cmUsesMethodClass: aValue
+ memory
+ unsignedByteAt: address + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
+ ^aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmUsesPenultimateLit: (in category 'accessing') -----
- cmUsesPenultimateLit: aValue
- memory
- unsignedByteAt: address + baseHeaderSize + 3
- put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFE) + (aValue ifTrue: [1] ifFalse: [0])).
- ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cmUsesPenultimateLit: (in category 'accessing') -----
+ cmUsesPenultimateLit: aValue
+ memory
+ unsignedByteAt: address + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFE) + (aValue ifTrue: [1] ifFalse: [0])).
+ ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cpicHasMNUCase (in category 'accessing') -----
+ cpicHasMNUCase
+ ^(((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -4) bitAnd: 16r1) ~= 0!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cpicHasMNUCase (in category 'accessing') -----
- cpicHasMNUCase
- ^(((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -4) bitAnd: 16r1) ~= 0!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cpicHasMNUCase: (in category 'accessing') -----
- cpicHasMNUCase: aValue
- memory
- unsignedByteAt: address + baseHeaderSize + 2
- put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)).
- ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>cpicHasMNUCase: (in category 'accessing') -----
+ cpicHasMNUCase: aValue
+ memory
+ unsignedByteAt: address + baseHeaderSize + 2
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)).
+ ^aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>homeOffset (in category 'accessing') -----
- homeOffset
- ^memory unsignedShortAt: address + 1!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>homeOffset (in category 'accessing') -----
+ homeOffset
+ ^memory unsignedShortAt: address + 1!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>homeOffset: (in category 'accessing') -----
+ homeOffset: aValue
+ ^memory
+ unsignedShortAt: address + 1
+ put: aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>homeOffset: (in category 'accessing') -----
- homeOffset: aValue
- ^memory
- unsignedShortAt: address + 1
- put: aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>padToWord: (in category 'accessing') -----
+ padToWord: aValue
+ ^memory
+ unsignedLongAt: address + 5
+ put: aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>padToWord: (in category 'accessing') -----
- padToWord: aValue
- ^memory
- unsignedLongAt: address + 5
- put: aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>stackCheckOffset: (in category 'accessing') -----
- stackCheckOffset: aValue
- self assert: (aValue between: 0 and: 16rFFF).
- memory
- unsignedShortAt: address + baseHeaderSize + 3
- put: ((memory unsignedShortAt: address + baseHeaderSize + 3) bitAnd: 16rF) + (aValue bitShift: 4).
- ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>stackCheckOffset: (in category 'accessing') -----
+ stackCheckOffset: aValue
+ self assert: (aValue between: 0 and: 16rFFF).
+ memory
+ unsignedShortAt: address + baseHeaderSize + 3
+ put: ((memory unsignedShortAt: address + baseHeaderSize + 3) bitAnd: 16rF) + (aValue bitShift: 4).
+ ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>startpc (in category 'accessing') -----
+ startpc
+ ^memory unsignedShortAt: address + 3!
Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>startpc (in category 'accessing') -----
- startpc
- ^memory unsignedShortAt: address + 3!
Item was added:
+ ----- Method: CogBlockMethodSurrogate64>>cmIsUnlinked (in category 'accessing') -----
+ cmIsUnlinked
+ ^(((memory unsignedByteAt: address + 10) bitShift: -4) bitAnd: 16r1) ~= 0!
Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>cmIsUnlinked (in category 'accessing') -----
- cmIsUnlinked
- ^(((memory unsignedByteAt: address + 10) bitShift: -4) bitAnd: 16r1) ~= 0!
Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>cmNumArgs: (in category 'accessing') -----
- cmNumArgs: aValue
- ^memory
- unsignedByteAt: address + baseHeaderSize + 1
- put: aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate64>>cmNumArgs: (in category 'accessing') -----
+ cmNumArgs: aValue
+ ^memory
+ unsignedByteAt: address + baseHeaderSize + 1
+ put: aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>cmRefersToYoung (in category 'accessing') -----
- cmRefersToYoung
- ^(((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -3) bitAnd: 16r1) ~= 0!
Item was added:
+ ----- Method: CogBlockMethodSurrogate64>>cmRefersToYoung (in category 'accessing') -----
+ cmRefersToYoung
+ ^(((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -3) bitAnd: 16r1) ~= 0!
Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>cmRefersToYoung: (in category 'accessing') -----
- cmRefersToYoung: aValue
- memory
- unsignedByteAt: address + baseHeaderSize + 2
- put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3)).
- ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate64>>cmRefersToYoung: (in category 'accessing') -----
+ cmRefersToYoung: aValue
+ memory
+ unsignedByteAt: address + baseHeaderSize + 2
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3)).
+ ^aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate64>>cmUsesMethodClass (in category 'accessing') -----
+ cmUsesMethodClass
+ ^(((memory unsignedByteAt: address + 3 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0!
Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>cmUsesMethodClass (in category 'accessing') -----
- cmUsesMethodClass
- ^(((memory unsignedByteAt: address + 3 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0!
Item was added:
+ ----- Method: CogBlockMethodSurrogate64>>cmUsesMethodClass: (in category 'accessing') -----
+ cmUsesMethodClass: aValue
+ memory
+ unsignedByteAt: address + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
+ ^aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>cmUsesMethodClass: (in category 'accessing') -----
- cmUsesMethodClass: aValue
- memory
- unsignedByteAt: address + baseHeaderSize + 3
- put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
- ^aValue!
Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>cmUsesPenultimateLit (in category 'accessing') -----
- cmUsesPenultimateLit
- ^((memory unsignedByteAt: address + 3 + baseHeaderSize) bitAnd: 16r1) ~= 0!
Item was added:
+ ----- Method: CogBlockMethodSurrogate64>>cmUsesPenultimateLit (in category 'accessing') -----
+ cmUsesPenultimateLit
+ ^((memory unsignedByteAt: address + 3 + baseHeaderSize) bitAnd: 16r1) ~= 0!
Item was added:
+ ----- Method: CogBlockMethodSurrogate64>>padToWord (in category 'accessing') -----
+ padToWord
+ ^memory unsignedLongLongAt: address + 5!
Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>padToWord (in category 'accessing') -----
- padToWord
- ^memory unsignedLongLongAt: address + 5!
Item was added:
+ ----- Method: CogBlockMethodSurrogate64>>stackCheckOffset (in category 'accessing') -----
+ stackCheckOffset
+ ^((memory unsignedShortAt: address + 3 + baseHeaderSize) bitShift: -4) bitAnd: 16rFFF!
Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>stackCheckOffset (in category 'accessing') -----
- stackCheckOffset
- ^((memory unsignedShortAt: address + 3 + baseHeaderSize) bitShift: -4) bitAnd: 16rFFF!
Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>startpc: (in category 'accessing') -----
- startpc: aValue
- ^memory
- unsignedShortAt: address + 3
- put: aValue!
Item was added:
+ ----- Method: CogBlockMethodSurrogate64>>startpc: (in category 'accessing') -----
+ startpc: aValue
+ ^memory
+ unsignedShortAt: address + 3
+ put: aValue!
Item was added:
+ ----- Method: CogCodeRange>>startpc: (in category 'accessing') -----
+ startpc: anObject
+ "Set the value of startpc"
+
+ startpc := anObject!
Item was removed:
- ----- Method: CogCodeRange>>startpc: (in category 'accessing') -----
- startpc: anObject
- "Set the value of startpc"
-
- startpc := anObject!
Item was changed:
----- Method: CogIA32CompilerTests>>Label (in category 'abstract instructions') -----
Label
^self gen: Label operand: opcodes size!
Item was changed:
----- Method: CogICacheFlushingIA32Compiler>>flushICacheFrom:to: (in category 'inline cacheing') -----
flushICacheFrom: startAddress "<Integer>" to: endAddress "<Integer>"
<cmacro: '(me,startAddress,endAddress) ceFlushICache(startAddress,endAddress)'>
self halt: #ceFlushICache!
Item was changed:
----- Method: CogICacheFlushingIA32Compiler>>generateICacheFlush (in category 'inline cacheing') -----
generateICacheFlush
"Use CPUID as a serializing instruction for instruction modification.
MFENCE doesn't work which is a shame because CPUID updates registers."
cogit
PushR: EDX;
PushR: ECX;
PushR: EBX;
XorR: EAX R: EAX;
gen: CPUID;
PopR: EBX;
PopR: ECX;
PopR: EDX;
RetN: 8 "pop from,to args"
"self hasSSE2Instructions
ifTrue:
[cogit
gen: MFENCE]
ifFalse:
[cogit
PushR: EDX;
PushR: ECX;
PushR: EBX;
XorR: EAX R: EAX;
gen: CPUID;
PopR: EBX;
PopR: ECX;
PopR: EDX].
cogit RetN: 8 ``pop from,to args''"!
Item was changed:
----- Method: CogICacheFlushingIA32Compiler>>numICacheFlushOpcodes (in category 'inline cacheing') -----
numICacheFlushOpcodes
^10!
Item was changed:
----- Method: CogInstructionAnnotation class>>byteSizeForSimulator: (in category 'simulation only') -----
byteSizeForSimulator: aVMClass
"Answer an approximation of the byte size of an AbstractInstruction struct.
This is for estimating the alloca in allocateOpcodes:bytecodes:ifFail:"
^self instSize * (aVMClass sizeof: #'void *')!
Item was removed:
- ----- Method: CogInstructionAnnotation class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogInstructionAnnotation struct."
-
- self allInstVarNames do:
- [:ivn|
- aBinaryBlock
- value: ivn
- value: (ivn = 'instruction'
- ifTrue: [#'AbstractInstruction *']
- ifFalse: [#sqInt])]!
Item was added:
+ ----- Method: CogInstructionAnnotation class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogInstructionAnnotation struct."
+
+ self allInstVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn = 'instruction'
+ ifTrue: [#'AbstractInstruction *']
+ ifFalse: [#sqInt])]!
Item was added:
+ ----- Method: CogMethod>>blockEntryOffset (in category 'accessing') -----
+ blockEntryOffset
+ "Answer the value of blockEntryOffset"
+
+ ^blockEntryOffset!
Item was removed:
- ----- Method: CogMethod>>blockEntryOffset (in category 'accessing') -----
- blockEntryOffset
- "Answer the value of blockEntryOffset"
-
- ^blockEntryOffset!
Item was added:
+ ----- Method: CogMethod>>blockEntryOffset: (in category 'accessing') -----
+ blockEntryOffset: anObject
+ "Set the value of blockEntryOffset"
+
+ ^blockEntryOffset := anObject!
Item was removed:
- ----- Method: CogMethod>>blockEntryOffset: (in category 'accessing') -----
- blockEntryOffset: anObject
- "Set the value of blockEntryOffset"
-
- ^blockEntryOffset := anObject!
Item was removed:
- ----- Method: CogMethod>>blockSize (in category 'accessing') -----
- blockSize
- "Answer the value of blockSize"
-
- ^ blockSize!
Item was added:
+ ----- Method: CogMethod>>blockSize (in category 'accessing') -----
+ blockSize
+ "Answer the value of blockSize"
+
+ ^ blockSize!
Item was added:
+ ----- Method: CogMethod>>blockSize: (in category 'accessing') -----
+ blockSize: anObject
+ "Set the value of blockSize"
+
+ ^blockSize := anObject!
Item was removed:
- ----- Method: CogMethod>>blockSize: (in category 'accessing') -----
- blockSize: anObject
- "Set the value of blockSize"
-
- ^blockSize := anObject!
Item was removed:
- ----- Method: CogMethod>>methodHeader (in category 'accessing') -----
- methodHeader
- "Answer the value of methodHeader"
-
- ^ methodHeader!
Item was added:
+ ----- Method: CogMethod>>methodHeader (in category 'accessing') -----
+ methodHeader
+ "Answer the value of methodHeader"
+
+ ^ methodHeader!
Item was removed:
- ----- Method: CogMethod>>methodHeader: (in category 'accessing') -----
- methodHeader: anObject
- "Set the value of methodHeader"
-
- ^methodHeader := anObject!
Item was added:
+ ----- Method: CogMethod>>methodHeader: (in category 'accessing') -----
+ methodHeader: anObject
+ "Set the value of methodHeader"
+
+ ^methodHeader := anObject!
Item was removed:
- ----- Method: CogMethod>>methodObject (in category 'accessing') -----
- methodObject
- "Answer the value of methodObject"
-
- ^methodObject!
Item was added:
+ ----- Method: CogMethod>>methodObject (in category 'accessing') -----
+ methodObject
+ "Answer the value of methodObject"
+
+ ^methodObject!
Item was added:
+ ----- Method: CogMethod>>methodObject: (in category 'accessing') -----
+ methodObject: anObject
+ "Set the value of methodObject"
+
+ ^methodObject := anObject!
Item was removed:
- ----- Method: CogMethod>>methodObject: (in category 'accessing') -----
- methodObject: anObject
- "Set the value of methodObject"
-
- ^methodObject := anObject!
Item was removed:
- ----- Method: CogMethodSurrogate32 class>>alignedByteSize (in category 'accessing') -----
- alignedByteSize
- ^20 + self baseHeaderSize!
Item was added:
+ ----- Method: CogMethodSurrogate32 class>>alignedByteSize (in category 'accessing') -----
+ alignedByteSize
+ ^20 + self baseHeaderSize!
Item was added:
+ ----- Method: CogMethodSurrogate32 class>>offsetOf: (in category 'accessing') -----
+ offsetOf: aByteSymbol
+ "These should be generated!!!!"
+ self assert: self objectMemoryClass baseHeaderSize = BaseHeaderSize.
+ ^aByteSymbol caseOf:
+ { [#methodObject] -> [8 + BaseHeaderSize].
+ [#selector] -> [16 + BaseHeaderSize].
+ [#blockEntryOffset] -> [6 + BaseHeaderSize].
+ }!
Item was removed:
- ----- Method: CogMethodSurrogate32 class>>offsetOf: (in category 'accessing') -----
- offsetOf: aByteSymbol
- "These should be generated!!!!"
- self assert: self objectMemoryClass baseHeaderSize = BaseHeaderSize.
- ^aByteSymbol caseOf:
- { [#methodObject] -> [8 + BaseHeaderSize].
- [#selector] -> [16 + BaseHeaderSize].
- [#blockEntryOffset] -> [6 + BaseHeaderSize].
- }!
Item was removed:
- ----- Method: CogMethodSurrogate64>>blockEntryOffset (in category 'accessing') -----
- blockEntryOffset
- ^memory unsignedShortAt: address + 7 + baseHeaderSize!
Item was added:
+ ----- Method: CogMethodSurrogate64>>blockEntryOffset (in category 'accessing') -----
+ blockEntryOffset
+ ^memory unsignedShortAt: address + 7 + baseHeaderSize!
Item was removed:
- ----- Method: CogMethodSurrogate64>>blockEntryOffset: (in category 'accessing') -----
- blockEntryOffset: aValue
- ^memory
- unsignedShortAt: address + baseHeaderSize + 7
- put: aValue!
Item was added:
+ ----- Method: CogMethodSurrogate64>>blockEntryOffset: (in category 'accessing') -----
+ blockEntryOffset: aValue
+ ^memory
+ unsignedShortAt: address + baseHeaderSize + 7
+ put: aValue!
Item was removed:
- ----- Method: CogMethodSurrogate64>>blockSize (in category 'accessing') -----
- blockSize
- ^memory unsignedShortAt: address + 5 + baseHeaderSize!
Item was added:
+ ----- Method: CogMethodSurrogate64>>blockSize (in category 'accessing') -----
+ blockSize
+ ^memory unsignedShortAt: address + 5 + baseHeaderSize!
Item was added:
+ ----- Method: CogMethodSurrogate64>>blockSize: (in category 'accessing') -----
+ blockSize: aValue
+ ^memory
+ unsignedShortAt: address + baseHeaderSize + 5
+ put: aValue!
Item was removed:
- ----- Method: CogMethodSurrogate64>>blockSize: (in category 'accessing') -----
- blockSize: aValue
- ^memory
- unsignedShortAt: address + baseHeaderSize + 5
- put: aValue!
Item was added:
+ ----- Method: CogMethodSurrogate64>>cmUsesMethodClass (in category 'accessing') -----
+ cmUsesMethodClass
+ ^(((memory unsignedByteAt: address + 3 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0!
Item was removed:
- ----- Method: CogMethodSurrogate64>>cmUsesMethodClass (in category 'accessing') -----
- cmUsesMethodClass
- ^(((memory unsignedByteAt: address + 3 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0!
Item was added:
+ ----- Method: CogMethodSurrogate64>>cmUsesMethodClass: (in category 'accessing') -----
+ cmUsesMethodClass: aValue
+ memory
+ unsignedByteAt: address + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
+ ^aValue!
Item was removed:
- ----- Method: CogMethodSurrogate64>>cmUsesMethodClass: (in category 'accessing') -----
- cmUsesMethodClass: aValue
- memory
- unsignedByteAt: address + baseHeaderSize + 3
- put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
- ^aValue!
Item was added:
+ ----- Method: CogMethodSurrogate64>>methodHeader (in category 'accessing') -----
+ methodHeader
+ ^memory unsignedLongLongAt: address + 17 + baseHeaderSize!
Item was removed:
- ----- Method: CogMethodSurrogate64>>methodHeader (in category 'accessing') -----
- methodHeader
- ^memory unsignedLongLongAt: address + 17 + baseHeaderSize!
Item was added:
+ ----- Method: CogMethodSurrogate64>>methodHeader: (in category 'accessing') -----
+ methodHeader: aValue
+ ^memory
+ unsignedLongLongAt: address + baseHeaderSize + 17
+ put: aValue!
Item was removed:
- ----- Method: CogMethodSurrogate64>>methodHeader: (in category 'accessing') -----
- methodHeader: aValue
- ^memory
- unsignedLongLongAt: address + baseHeaderSize + 17
- put: aValue!
Item was added:
+ ----- Method: CogMethodSurrogate64>>methodObject (in category 'accessing') -----
+ methodObject
+ ^memory unsignedLongLongAt: address + 9 + baseHeaderSize!
Item was removed:
- ----- Method: CogMethodSurrogate64>>methodObject (in category 'accessing') -----
- methodObject
- ^memory unsignedLongLongAt: address + 9 + baseHeaderSize!
Item was removed:
- ----- Method: CogMethodSurrogate64>>methodObject: (in category 'accessing') -----
- methodObject: aValue
- ^memory
- unsignedLongLongAt: address + baseHeaderSize + 9
- put: aValue!
Item was added:
+ ----- Method: CogMethodSurrogate64>>methodObject: (in category 'accessing') -----
+ methodObject: aValue
+ ^memory
+ unsignedLongLongAt: address + baseHeaderSize + 9
+ put: aValue!
Item was changed:
----- Method: CogMethodZone>>cogit (in category 'simulation only') -----
cogit
"This is for the sizeof: CogMethod hook that allows different cogit classes to use differet CogMethod variants."
<doNotGenerate>
^cogit!
Item was changed:
----- Method: CogMethodZone>>methods (in category 'simulation only') -----
methods
<doNotGenerate>
| methods |
methods := OrderedCollection new.
self methodsDo:
[:m| methods addLast: m].
^methods!
Item was changed:
----- Method: CogMethodZone>>methodsDo: (in category 'simulation only') -----
methodsDo: aBlock
<doNotGenerate>
| cogMethod |
cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < self limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[aBlock value: cogMethod].
cogMethod := self methodAfter: cogMethod]
"<api>
<returnTypeC: #void>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < self limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[aBlock value: cogMethod].
cogMethod := self methodAfter: cogMethod]"!
Item was changed:
----- Method: CogMethodZone>>zoneEnd: (in category 'simulation only') -----
zoneEnd: zoneEnd
<doNotGenerate>
limitAddress := zoneEnd!
Item was changed:
----- Method: CogObjectRepresentationForSpur>>checkValidInlineCacheTag: (in category 'debug support') -----
checkValidInlineCacheTag: classIndexOrTagPattern
^classIndexOrTagPattern <= objectMemory tagMask
or: [(objectMemory classAtIndex: classIndexOrTagPattern) notNil]!
Item was changed:
----- Method: CogObjectRepresentationForSpur>>checkValidObjectReference: (in category 'debug support') -----
checkValidObjectReference: anOop
^(objectMemory isImmediate: anOop)
or: [(objectMemory heapMapAtWord: (self pointerForOop: anOop)) ~= 0]!
Item was removed:
- ----- Method: CogPrimitiveDescriptor class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a PrimitiveDescriptor struct."
-
- self instVarNames do:
- [:ivn|
- aBinaryBlock
- value: ivn
- value: (ivn caseOf: {
- ['primitiveGenerator'] -> [#('sqInt (*' ')(void)')].
- ['enabled'] -> [#('sqInt (*' ')(sqInt)')] }
- otherwise: [#sqInt])]!
Item was added:
+ ----- Method: CogPrimitiveDescriptor class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a PrimitiveDescriptor struct."
+
+ self instVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn caseOf: {
+ ['primitiveGenerator'] -> [#('sqInt (*' ')(void)')].
+ ['enabled'] -> [#('sqInt (*' ')(sqInt)')] }
+ otherwise: [#sqInt])]!
Item was removed:
- ----- Method: CogSimStackEntry class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogSimStackEntry struct."
- "self printTypedefOn: Transcript"
- self filteredInstVarNames do:
- [:ivn|
- aBinaryBlock
- value: (ivn = 'register' ifTrue: ['registerr'] ifFalse: [ivn]) "avoid reservedWord conflict"
- value: (ivn caseOf: {
- ['type'] -> [#char].
- ['spilled'] -> [#char].
- ['annotateUse'] -> [#char]}
- otherwise:
- [#sqInt])]!
Item was added:
+ ----- Method: CogSimStackEntry class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogSimStackEntry struct."
+ "self printTypedefOn: Transcript"
+ self filteredInstVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: (ivn = 'register' ifTrue: ['registerr'] ifFalse: [ivn]) "avoid reservedWord conflict"
+ value: (ivn caseOf: {
+ ['type'] -> [#char].
+ ['spilled'] -> [#char].
+ ['annotateUse'] -> [#char]}
+ otherwise:
+ [#sqInt])]!
Item was changed:
----- Method: CogVMSimulator>>CFramePointer (in category 'debug support') -----
CFramePointer
^self longAt: self inMemoryCFramePointerAddress!
Item was changed:
----- Method: CogVMSimulator>>CStackPointer (in category 'debug support') -----
CStackPointer
^self longAt: self inMemoryCStackPointerAddress!
Item was changed:
----- Method: CogVMSimulator>>allObjectsSelect: (in category 'debug support') -----
allObjectsSelect: objBlock
"self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]"
| selected |
selected := OrderedCollection new.
objectMemory allObjectsDoSafely:
[:oop| (objBlock value: oop) ifTrue: [selected addLast: oop]].
^ selected!
Item was changed:
----- Method: CogVMSimulator>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
^objectMemory byteAt: byteAddress!
Item was changed:
----- Method: CogVMSimulator>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
^objectMemory byteAt: byteAddress put: byte!
Item was changed:
----- Method: CogVMSimulator>>byteCount (in category 'debug support') -----
byteCount
"So you can call this from temp debug statements in, eg, Interpreter, such as
self byteCount = 12661 ifTrue: [self halt].
"
^ byteCount!
Item was changed:
----- Method: CogVMSimulator>>cCoerce:to: (in category 'memory access') -----
cCoerce: value to: cTypeString
"Type coercion for translation only; just return the value when running in Smalltalk."
^value == nil
ifTrue: [value]
ifFalse: [value coerceTo: cTypeString sim: self]!
Item was changed:
----- Method: CogVMSimulator>>ceNonLocalReturn: (in category 'debug support') -----
ceNonLocalReturn: returnValue
"self halt."
^super ceNonLocalReturn: returnValue!
Item was changed:
----- Method: CogVMSimulator>>ceTraceBlockActivation (in category 'debug support') -----
ceTraceBlockActivation
<var: #theFP type: #'char *'>
cogit printOnTrace ifTrue:
[transcript print: byteCount; nextPut: $/; print: (sendCount := sendCount + 1); space].
cogit assertCStackWellAligned.
super ceTraceBlockActivation.
^#continue!
Item was changed:
----- Method: CogVMSimulator>>ceTraceLinkedSend: (in category 'debug support') -----
ceTraceLinkedSend: theReceiver
(sendCount := sendCount + 1) \\ 500 = 0 ifTrue:
[self changed: #byteCountText].
cogit printOnTrace ifTrue:
[transcript print: byteCount; nextPut: $/; print: sendCount; space].
cogit assertCStackWellAligned.
super ceTraceLinkedSend: theReceiver.
^#continue!
Item was added:
+ ----- Method: CogVMSimulator>>charsOfLong: (in category 'debug support') -----
+ charsOfLong: long
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: CogVMSimulator>>charsOfLong: (in category 'debug support') -----
- charsOfLong: long
- ^self subclassResponsibility!
Item was changed:
----- Method: CogVMSimulator>>classAndSelectorOfMethod:forReceiver: (in category 'debug support') -----
classAndSelectorOfMethod: meth forReceiver: rcvr
| mClass dict length methodArray |
mClass := objectMemory fetchClassOf: rcvr.
[dict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: mClass.
length := objectMemory fetchWordLengthOf: dict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dict.
0 to: length-SelectorStart-1 do:
[:index |
meth = (objectMemory fetchPointer: index ofObject: methodArray)
ifTrue: [^ Array
with: mClass
with: (objectMemory fetchPointer: index + SelectorStart ofObject: dict)]].
mClass := objectMemory fetchPointer: SuperclassIndex ofObject: mClass.
mClass = objectMemory nilObject]
whileFalse: [].
^ Array
with: (objectMemory fetchClassOf: rcvr)
with: (objectMemory splObj: SelectorDoesNotUnderstand)!
Item was changed:
----- Method: CogVMSimulator>>cloneSimulation (in category 'debug support') -----
cloneSimulation
| savedDisplayView savedDisplayForm savedQuitBlock savedTranscript |
savedDisplayView := displayView. displayView := nil.
savedDisplayForm := displayForm. displayForm = nil.
savedQuitBlock := quitBlock. quitBlock := nil.
savedTranscript := transcript. transcript := nil.
[| clone window |
clone := self veryDeepCopy.
window := clone openAsMorph.
window setLabel: 'Clone of ', (savedDisplayView containingWindow label allButFirst: 'Simulation of ' size)]
ensure:
[displayView := savedDisplayView.
displayForm = savedDisplayForm.
quitBlock := savedQuitBlock.
transcript := savedTranscript]!
Item was changed:
----- Method: CogVMSimulator>>cogit (in category 'simulation only') -----
cogit
^cogit!
Item was changed:
----- Method: CogVMSimulator>>createActualMessageTo: (in category 'debugging traps') -----
createActualMessageTo: class
class == objectMemory nilObject ifTrue: [self halt].
^super createActualMessageTo: class!
Item was changed:
----- Method: CogVMSimulator>>debugStackPointersFor: (in category 'debug support') -----
debugStackPointersFor: aMethod
^CArrayAccessor on:
(((NewspeakVM
ifTrue: [NewspeakStackDepthFinder]
ifFalse: [StackDepthFinder]) on: (VMCompiledMethodProxy new
for: aMethod
coInterpreter: self
objectMemory: objectMemory))
stackPointers)!
Item was changed:
----- Method: CogVMSimulator>>dumpMethodHeader: (in category 'debug support') -----
dumpMethodHeader: hdr
^ String streamContents:
[:strm |
strm nextPutAll: '<nArgs=', ((hdr >> 25) bitAnd: 16r1F) printString , '>'.
strm nextPutAll: '<nTemps=', ((hdr >> 19) bitAnd: 16r3F) printString , '>'.
strm nextPutAll: '<lgCtxt=', ((hdr >> 18) bitAnd: 16r1) printString , '>'.
strm nextPutAll: '<nLits=', ((hdr >> 10) bitAnd: 16rFF) printString , '>'.
strm nextPutAll: '<prim=', ((hdr >> 1) bitAnd: 16r1FF) printString , '>'.
]!
Item was changed:
----- Method: CogVMSimulator>>enableCog: (in category 'debugging traps') -----
enableCog: aBoolean
enableCog := aBoolean!
Item was changed:
----- Method: CogVMSimulator>>externalCannotReturn:from: (in category 'debugging traps') -----
externalCannotReturn: resultOop from: aContext
self halt.
^super externalCannotReturn: resultOop from: aContext!
Item was changed:
----- Method: CogVMSimulator>>externalDivorceFrame:andContext: (in category 'debugging traps') -----
externalDivorceFrame: theFP andContext: ctxt
"((#(16r100570 16r101BC8) includes: theFP) or: [#(16r17159A4 16r1715948) includes: ctxt]) ifTrue:
[self halt]."
^super externalDivorceFrame: theFP andContext: ctxt!
Item was changed:
----- Method: CogVMSimulator>>externalInstVar:ofContext: (in category 'debugging traps') -----
externalInstVar: offset ofContext: aOnceMarriedContext
"offset = InstructionPointerIndex ifTrue:
[Transcript nextPutAll: '==================='; cr.
self printContext: 16r1715630.
self printCallStackOf: aOnceMarriedContext currentFP: framePointer.
Transcript nextPutAll: '==================='; cr.
self halt]."
| result |
"self shortPrintFrameAndCallers: framePointer.
Transcript print: byteCount; tab; print: thisContext; cr.
self print: offset; cr.
self printContext: aOnceMarriedContext.
(self confirm: 'continue?') ifFalse: [self halt]."
result := super externalInstVar: offset ofContext: aOnceMarriedContext.
"offset = StackPointerIndex ifTrue:
[Transcript nextPutAll: '^stackp ', (self integerValueOf: result) printString; tab.
self shortPrintContext: aOnceMarriedContext.
(#(24205456 24205732) includes: aOnceMarriedContext) ifTrue:
[(self checkIsStillMarriedContext: aOnceMarriedContext currentFP: framePointer)
ifTrue: [self printFrame: (self frameOfMarriedContext: aOnceMarriedContext) WithSP: (self frameOfMarriedContext: aOnceMarriedContext) - 48]
ifFalse: [self printContext: aOnceMarriedContext]]]."
^result!
Item was added:
+ ----- Method: CogVMSimulator>>fetchPointer:ofObject: (in category 'interpreter access') -----
+ fetchPointer: fieldIndex ofObject: oop
+ "index by word size, and return a pointer as long as the word size"
+ self assert: (objectMemory cheapIsInMemory: oop).
+ ^objectMemory fetchPointer: fieldIndex ofObject: oop!
Item was removed:
- ----- Method: CogVMSimulator>>fetchPointer:ofObject: (in category 'interpreter access') -----
- fetchPointer: fieldIndex ofObject: oop
- "index by word size, and return a pointer as long as the word size"
- self assert: (objectMemory cheapIsInMemory: oop).
- ^objectMemory fetchPointer: fieldIndex ofObject: oop!
Item was removed:
- ----- Method: CogVMSimulator>>firstIndexableField: (in category 'memory access') -----
- firstIndexableField: oop
- "This is in ObjectMemory and overridden in the obj mem simulators"
- self shouldNotImplement!
Item was added:
+ ----- Method: CogVMSimulator>>firstIndexableField: (in category 'memory access') -----
+ firstIndexableField: oop
+ "This is in ObjectMemory and overridden in the obj mem simulators"
+ self shouldNotImplement!
Item was changed:
----- Method: CogVMSimulator>>framePointer (in category 'debug support') -----
framePointer
^framePointer!
Item was changed:
----- Method: CogVMSimulator>>fullDisplayUpdate (in category 'debug support') -----
fullDisplayUpdate
"Preserve self successful when call asynchronously from Simulator"
| primFailCodeValue |
primFailCodeValue := primFailCode.
self initPrimCall.
super fullDisplayUpdate.
primFailCode := primFailCodeValue!
Item was changed:
----- Method: CogVMSimulator>>getShortFromFile:swap: (in category 'image save/restore') -----
getShortFromFile: aFile swap: swapFlag
| aShort |
aShort := self nextShortFrom: aFile.
^swapFlag
ifTrue: [(aShort bitShift: -8) + ((aShort bitAnd: 16rFF) bitShift: 8)]
ifFalse: [aShort]!
Item was removed:
- ----- Method: CogVMSimulator>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- ^self subclassResponsibility!
Item was added:
+ ----- Method: CogVMSimulator>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: CogVMSimulator>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: CogVMSimulator>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- ^self subclassResponsibility!
Item was changed:
----- Method: CogVMSimulator>>headerStart: (in category 'debug support') -----
headerStart: oop
^ (objectMemory extraHeaderBytes: oop) negated!
Item was changed:
----- Method: CogVMSimulator>>heapMapAtWord: (in category 'debug support') -----
heapMapAtWord: address
^objectMemory heapMap heapMapAtWord: address asUnsignedInteger!
Item was changed:
----- Method: CogVMSimulator>>heapMapAtWord:Put: (in category 'debug support') -----
heapMapAtWord: address Put: aBit
^objectMemory heapMap heapMapAtWord: address asUnsignedInteger Put: aBit!
Item was changed:
----- Method: CogVMSimulator>>ifAppropriateCompileToNativeCode:selector: (in category 'debugging traps') -----
ifAppropriateCompileToNativeCode: aMethodObject selector: selector
enableCog ifTrue:
[super ifAppropriateCompileToNativeCode: aMethodObject selector: selector]!
Item was changed:
----- Method: CogVMSimulator>>imageName (in category 'image save/restore') -----
imageName
^imageName!
Item was changed:
----- Method: CogVMSimulator>>instVar:ofContext: (in category 'debugging traps') -----
instVar: offset ofContext: aOnceMarriedContext
"offset = InstructionPointerIndex ifTrue:
[Transcript nextPutAll: '==================='; cr.
self printContext: 16r1715630.
self printCallStackOf: aOnceMarriedContext currentFP: framePointer.
Transcript nextPutAll: '==================='; cr.
self halt]."
| result |
"self shortPrintFrameAndCallers: localFP.
Transcript print: byteCount; tab; print: thisContext; cr.
self print: offset; cr.
self printContext: aOnceMarriedContext.
(self confirm: 'continue?') ifFalse: [self halt]."
result := super instVar: offset ofContext: aOnceMarriedContext.
"offset = StackPointerIndex ifTrue:
[Transcript nextPutAll: '^stackp ', (self integerValueOf: result) printString; tab.
self shortPrintContext: aOnceMarriedContext.
(#(24205456 24205732) includes: aOnceMarriedContext) ifTrue:
[(self checkIsStillMarriedContext: aOnceMarriedContext currentFP: localFP)
ifTrue: [self printFrame: (self frameOfMarriedContext: aOnceMarriedContext) WithSP: (self frameOfMarriedContext: aOnceMarriedContext) - 48]
ifFalse: [self printContext: aOnceMarriedContext]]]."
^result!
Item was changed:
----- Method: CogVMSimulator>>internalCannotReturn: (in category 'debugging traps') -----
internalCannotReturn: resultOop
self halt.
^super internalCannotReturn: resultOop!
Item was changed:
----- Method: CogVMSimulator>>internalMustBeBoolean (in category 'debugging traps') -----
internalMustBeBoolean
self halt.
^super internalMustBeBoolean!
Item was removed:
- ----- Method: CogVMSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
- ioLoadFunction: functionString From: pluginString
- "Load and return the requested function from a module"
- | firstTime plugin fnSymbol |
- firstTime := false.
- fnSymbol := functionString asSymbol.
- transcript
- cr;
- show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
- (pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
- functionString = breakSelector ifTrue: [self halt: breakSelector].
- plugin := pluginList
- detect:[:any| any key = pluginString asString]
- ifNone:
- [firstTime := true.
- self loadNewPlugin: pluginString].
- plugin ifNil:
- [firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
- ^0].
- plugin := plugin value.
- mappedPluginEntries doWithIndex:
- [:pluginAndName :index|
- ((pluginAndName at: 1) == plugin
- and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
- [^index]].
- (plugin respondsTo: fnSymbol) ifFalse:
- [firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
- ^0].
- mappedPluginEntries addLast: (Array
- with: plugin
- with: fnSymbol
- with: [plugin perform: fnSymbol. self]).
- "Transcript show: ' ... okay'."
- ^ mappedPluginEntries size!
Item was added:
+ ----- Method: CogVMSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
+ ioLoadFunction: functionString From: pluginString
+ "Load and return the requested function from a module"
+ | firstTime plugin fnSymbol |
+ firstTime := false.
+ fnSymbol := functionString asSymbol.
+ transcript
+ cr;
+ show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
+ (pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
+ functionString = breakSelector ifTrue: [self halt: breakSelector].
+ plugin := pluginList
+ detect:[:any| any key = pluginString asString]
+ ifNone:
+ [firstTime := true.
+ self loadNewPlugin: pluginString].
+ plugin ifNil:
+ [firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
+ ^0].
+ plugin := plugin value.
+ mappedPluginEntries doWithIndex:
+ [:pluginAndName :index|
+ ((pluginAndName at: 1) == plugin
+ and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
+ [^index]].
+ (plugin respondsTo: fnSymbol) ifFalse:
+ [firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
+ ^0].
+ mappedPluginEntries addLast: (Array
+ with: plugin
+ with: fnSymbol
+ with: [plugin perform: fnSymbol. self]).
+ "Transcript show: ' ... okay'."
+ ^ mappedPluginEntries size!
Item was removed:
- ----- Method: CogVMSimulator>>ioLocalSecondsOffset (in category 'I/O primitives support') -----
- ioLocalSecondsOffset
- ^DateAndTime localOffset asSeconds!
Item was removed:
- ----- Method: CogVMSimulator>>ioSeconds (in category 'I/O primitives support') -----
- ioSeconds
- "Return the value of the second clock."
-
- ^ Time primSecondsClock!
Item was removed:
- ----- Method: CogVMSimulator>>ioSetHeartbeatMilliseconds: (in category 'I/O primitives support') -----
- ioSetHeartbeatMilliseconds: ignored!
Item was removed:
- ----- Method: CogVMSimulator>>ioUTCMicrosecondsNow (in category 'I/O primitives support') -----
- ioUTCMicrosecondsNow
- ^self ioUTCMicroseconds!
Item was changed:
----- Method: CogVMSimulator>>logSend: (in category 'debugging traps') -----
logSend: oop
sendCount := sendCount + 1.
printSends ifTrue:
[transcript print: byteCount; nextPut: $/; print: sendCount; space.
self printStringOf: oop.
transcript cr; flush]!
Item was removed:
- ----- Method: CogVMSimulator>>long32At: (in category 'memory access') -----
- long32At: byteAddress
- "Return the 32-bit word at byteAddress which must be 0 mod 4."
- ^objectMemory long32At: byteAddress!
Item was added:
+ ----- Method: CogVMSimulator>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+ "Return the 32-bit word at byteAddress which must be 0 mod 4."
+ ^objectMemory long32At: byteAddress!
Item was added:
+ ----- Method: CogVMSimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ ^objectMemory longAt: byteAddress!
Item was removed:
- ----- Method: CogVMSimulator>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- ^objectMemory longAt: byteAddress!
Item was added:
+ ----- Method: CogVMSimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ ^objectMemory longAt: byteAddress put: a32BitValue!
Item was removed:
- ----- Method: CogVMSimulator>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a32BitValue
- ^objectMemory longAt: byteAddress put: a32BitValue!
Item was added:
+ ----- Method: CogVMSimulator>>mapInterpreterOops (in category 'multi-threading simulation switch') -----
+ mapInterpreterOops
+ "This method includes or excludes CoInterpreterMT methods as required.
+ Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
+
+ ^self perform: #mapInterpreterOops
+ withArguments: {}
+ inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was removed:
- ----- Method: CogVMSimulator>>mapInterpreterOops (in category 'multi-threading simulation switch') -----
- mapInterpreterOops
- "This method includes or excludes CoInterpreterMT methods as required.
- Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
-
- ^self perform: #mapInterpreterOops
- withArguments: {}
- inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was removed:
- ----- Method: CogVMSimulator>>markAndTraceInterpreterOops: (in category 'multi-threading simulation switch') -----
- markAndTraceInterpreterOops: fullGCFlag
- "This method includes or excludes CoInterpreterMT methods as required.
- Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
-
- ^self perform: #markAndTraceInterpreterOops:
- withArguments: {fullGCFlag}
- inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was added:
+ ----- Method: CogVMSimulator>>markAndTraceInterpreterOops: (in category 'multi-threading simulation switch') -----
+ markAndTraceInterpreterOops: fullGCFlag
+ "This method includes or excludes CoInterpreterMT methods as required.
+ Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
+
+ ^self perform: #markAndTraceInterpreterOops:
+ withArguments: {fullGCFlag}
+ inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was changed:
----- Method: CogVMSimulator>>maybeCheckStackDepth:sp:pc: (in category 'debug support') -----
maybeCheckStackDepth: delta sp: sp pc: mcpc
| 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].
bcpc := cogit
bytecodePCFor: mcpc
startBcpc: (cogHomeMethod = cogBlockMethod
ifTrue: [self startPCOfMethod: cogHomeMethod methodObject]
ifFalse: [self startPCOfClosure: (self pushedReceiverOrClosureOfFrame: framePointer)])
in: cogBlockMethod.
self assert: bcpc ~= 0.
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 changed:
----- Method: CogVMSimulator>>methodCacheSize (in category 'simulation only') -----
methodCacheSize
^MethodCacheSize * BytesPerWord!
Item was changed:
----- Method: CogVMSimulator>>methodForContext: (in category 'simulation only') -----
methodForContext: aContextOop
self assert: (objectMemory isContext: aContextOop).
^objectMemory fetchPointer: MethodIndex ofObject: aContextOop!
Item was changed:
----- Method: CogVMSimulator>>nameOfClass: (in category 'debug support') -----
nameOfClass: classOop
| numSlots |
classNameIndex ifNil: [^'??nil cnidx??'].
numSlots := objectMemory numSlotsOf: classOop.
numSlots = metaclassNumSlots ifTrue:
[^(self nameOfClass:
(objectMemory fetchPointer: thisClassIndex ofObject: classOop)) , ' class'].
numSlots <= classNameIndex ifTrue:
[^'bad class'].
^self stringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!
Item was added:
+ ----- Method: CogVMSimulator>>nextLongFrom: (in category 'initialization') -----
+ nextLongFrom: aStream
+ "Read a 32-bit quantity from the given (binary) stream."
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: CogVMSimulator>>nextLongFrom: (in category 'initialization') -----
- nextLongFrom: aStream
- "Read a 32-bit quantity from the given (binary) stream."
- ^self subclassResponsibility!
Item was added:
+ ----- Method: CogVMSimulator>>nextShortFrom: (in category 'initialization') -----
+ nextShortFrom: aStream
+ "Read a 16-bit quantity from the given (binary) stream."
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: CogVMSimulator>>nextShortFrom: (in category 'initialization') -----
- nextShortFrom: aStream
- "Read a 16-bit quantity from the given (binary) stream."
- ^self subclassResponsibility!
Item was changed:
----- Method: CogVMSimulator>>primTraceLogSize (in category 'simulation only') -----
primTraceLogSize
^PrimTraceLogSize * BytesPerWord!
Item was changed:
----- Method: CogVMSimulator>>primitiveClosureValueWithArgs (in category 'debugging traps') -----
primitiveClosureValueWithArgs
"Transcript clear.
self shortPrintFrameAndCallers: framePointer.
self halt."
^super primitiveClosureValueWithArgs!
Item was changed:
----- Method: CogVMSimulator>>primitiveContextAtPut (in category 'debugging traps') -----
primitiveContextAtPut
"| aContext |
aContext := self stackValue: 2.
(#(24205456 24205732) includes: aContext) ifTrue:
[(self checkIsStillMarriedContext: aContext currentFP: framePointer)
ifTrue: [self printFrame: (self frameOfMarriedContext: aContext)
WithSP: (self frameOfMarriedContext: aContext) - 48]
ifFalse: [self printContext: aContext]]."
^super primitiveContextAtPut!
Item was changed:
----- Method: CogVMSimulator>>primitiveDoPrimitiveWithArgs (in category 'debugging traps') -----
primitiveDoPrimitiveWithArgs
| primIndex |
primIndex := objectMemory integerValueOf: (self stackValue: 1).
NewspeakVM ifFalse:
[transcript nextPutAll: 'DO PRIMITIVE: '; print: (self functionPointerFor: primIndex inClass: nil); cr; flush].
primIndex = 76 ifTrue:
[self halt].
^super primitiveDoPrimitiveWithArgs!
Item was changed:
----- Method: CogVMSimulator>>primitiveExecuteMethod (in category 'debugging traps') -----
primitiveExecuteMethod
self halt: thisContext selector.
^super primitiveExecuteMethod!
Item was changed:
----- Method: CogVMSimulator>>primitiveNewWithArg (in category 'debugging traps') -----
primitiveNewWithArg
"(objectMemory hasSpurMemoryManagerAPI
and: [self classNameOf: (self stackValue: 1) Is: 'Bitmap']) ifTrue:
[self printExternalHeadFrame.
self halt]."
^super primitiveNewWithArg!
Item was changed:
----- Method: CogVMSimulator>>primitiveObjectPointsTo (in category 'debugging traps') -----
primitiveObjectPointsTo
"self halt."
^super primitiveObjectPointsTo!
Item was changed:
----- Method: CogVMSimulator>>primitivePerform (in category 'debugging traps') -----
primitivePerform
| selector |
selector := self stackValue: argumentCount - 1.
self sendBreakpoint: selector receiver: (self stackValue: argumentCount).
(self filterPerformOf: selector to: (self stackValue: argumentCount)) ifTrue:
[^self pop: argumentCount].
^super primitivePerform!
Item was changed:
----- Method: CogVMSimulator>>primitiveStoreStackp (in category 'debugging traps') -----
primitiveStoreStackp
"self printContext: (self stackValue: 1).
self halt."
"(self stackValue: 1) = 16r1934F80 ifTrue: [self halt]."
super primitiveStoreStackp!
Item was removed:
- ----- Method: CogVMSimulator>>printChar: (in category 'debug printing') -----
- printChar: aByte
-
- traceOn ifTrue: [ transcript nextPut: aByte asCharacter ].!
Item was added:
+ ----- Method: CogVMSimulator>>printChar: (in category 'debug printing') -----
+ printChar: aByte
+
+ traceOn ifTrue: [ transcript nextPut: aByte asCharacter ].!
Item was changed:
----- Method: CogVMSimulator>>reverseBytesInImage (in category 'image save/restore') -----
reverseBytesInImage
Utilities
informUser: 'Swapping bytes of foreign image...'
during: [super reverseBytesInImage]!
Item was changed:
----- Method: CogVMSimulator>>sendBreak:point:receiver: (in category 'debugging traps') -----
sendBreak: selectorString point: selectorLength receiver: receiverOrNil
"self shortPrintFrameAndCallers: localFP"
| i |
breakSelectorLength = selectorLength ifTrue:
[i := breakSelectorLength.
[i > 0] whileTrue:
[(objectMemory byteAt: selectorString + i - 1) = (breakSelector at: i) asInteger
ifTrue: [(i := i - 1) = 0 ifTrue:
[self changed: #byteCountText.
self halt: 'Send of '
, breakSelector,
(receiverOrNil
ifNotNil: [' to ', (self shortPrint: receiverOrNil)]
ifNil: [''])]]
ifFalse: [i := 0]]]!
Item was changed:
----- Method: CogVMSimulator>>shortPrint: (in category 'debug support') -----
shortPrint: oop
| name classOop |
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[^(objectMemory characterValueOf: oop) < 256
ifTrue:
['=$' , (objectMemory characterValueOf: oop) printString ,
' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')']
ifFalse:
['=$' , (objectMemory characterValueOf: oop) printString, '(???)']].
(objectMemory isIntegerObject: oop) ifTrue:
[^ '=' , (objectMemory integerValueOf: oop) printString ,
' (' , (objectMemory integerValueOf: oop) hex , ')'].
^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [' is not on the heap']].
(objectMemory isFreeObject: oop) ifTrue:
[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
(objectMemory isForwarded: oop) ifTrue:
[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
classOop := objectMemory fetchClassOfNonImm: oop.
(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
[^'class ' , (self nameOfClass: oop)].
name := self nameOfClass: classOop.
name size = 0 ifTrue: [name := '??'].
name = 'String' ifTrue: [^ (self stringOf: oop) printString].
name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
[^ '=' , (Character value: (objectMemory integerValueOf:
(objectMemory fetchPointer: 0 ofObject: oop))) printString].
name = 'UndefinedObject' ifTrue: [^ 'nil'].
name = 'False' ifTrue: [^ 'false'].
name = 'True' ifTrue: [^ 'true'].
name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
(#('Association' 'ReadOnlyVariableBinding' 'VariableBinding') includes: name) ifTrue:
[^ '(' ,
(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
' -> ' ,
(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!
Item was changed:
----- Method: CogVMSimulator>>sqMakeMemoryNotExecutableFrom:To: (in category 'simulation only') -----
sqMakeMemoryNotExecutableFrom: baseAddress To: limitAdress
^self!
Item was removed:
- ----- Method: CogVMSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- ^0!
Item was added:
+ ----- Method: CogVMSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
+ sqMemoryExtraBytesLeft: includingSwap
+ ^0!
Item was removed:
- ----- Method: CogVMSimulator>>sqShrinkMemory:By: (in category 'memory access') -----
- sqShrinkMemory: oldLimit By: delta
- transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr.
-
- ^ oldLimit!
Item was added:
+ ----- Method: CogVMSimulator>>sqShrinkMemory:By: (in category 'memory access') -----
+ sqShrinkMemory: oldLimit By: delta
+ transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr.
+
+ ^ oldLimit!
Item was changed:
----- Method: CogVMSimulator>>stackPointer (in category 'debug support') -----
stackPointer
^stackPointer!
Item was changed:
----- Method: CogVMSimulator>>startInContextSuchThat: (in category 'simulation only') -----
startInContextSuchThat: aBlock
"Change the active process's suspendedContext to its sender, which short-cuts the
initialization of the system. This can be a short-cut to running code, e.g. when doing
Smalltalk saveAs.
Compiler recompileAll
via e.g.
vm startInContextSuchThat: [:ctxt| (vm stringOf: (vm penultimateLiteralOf: (vm methodForContext: ctxt))) = 'DoIt']"
<doNotGenerate>
| context activeProc |
activeProc := self activeProcess.
context := objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc.
[context = objectMemory nilObject ifTrue:
[^self error: 'no context found'].
aBlock value: context] whileFalse:
[context := objectMemory fetchPointer: SenderIndex ofObject: context].
objectMemory storePointer: SuspendedContextIndex ofObject: activeProc withValue: context.
"Now push a dummy return value."
objectMemory
storePointer: (self fetchStackPointerOf: context) + CtxtTempFrameStart
ofObject: context
withValue: objectMemory nilObject.
self storeInteger: StackPointerIndex
ofObject: context
withValue: (self fetchStackPointerOf: context) + 1!
Item was changed:
----- Method: CogVMSimulator>>startOfMemory (in category 'debugging traps') -----
startOfMemory
self shouldNotImplement!
Item was changed:
----- Method: CogVMSimulator>>systemAttributes (in category 'simulation only') -----
systemAttributes
^systemAttributes!
Item was changed:
----- Method: CogVMSimulator>>transcript (in category 'simulation only') -----
transcript
^transcript!
Item was changed:
----- Method: CogVMSimulator>>transcript: (in category 'simulation only') -----
transcript: aTranscript
transcript := aTranscript!
Item was added:
+ ----- Method: CogVMSimulator>>validOop: (in category 'testing') -----
+ validOop: oop
+ " Return true if oop appears to be valid "
+ (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
+ (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
+ oop >= objectMemory endOfMemory ifTrue: [^ false]. "Out of range"
+ "could test if within the first large freeblock"
+ (self longAt: oop) = 4 ifTrue: [^ false].
+ (objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object"
+ ^ true!
Item was removed:
- ----- Method: CogVMSimulator>>validOop: (in category 'testing') -----
- validOop: oop
- " Return true if oop appears to be valid "
- (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
- (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
- oop >= objectMemory endOfMemory ifTrue: [^ false]. "Out of range"
- "could test if within the first large freeblock"
- (self longAt: oop) = 4 ifTrue: [^ false].
- (objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object"
- ^ true!
Item was changed:
----- Method: CogVMSimulatorLSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
^objectMemory byteAt: byteAddress put: byte!
Item was removed:
- ----- Method: CogVMSimulatorLSB>>charsOfLong: (in category 'debug support') -----
- charsOfLong: long
- ^ (1 to: 4) collect:
- [:i | ((long digitAt: i) between: 14 and: 126)
- ifTrue: [(long digitAt: i) asCharacter]
- ifFalse: [$?]]!
Item was added:
+ ----- Method: CogVMSimulatorLSB>>charsOfLong: (in category 'debug support') -----
+ charsOfLong: long
+ ^ (1 to: 4) collect:
+ [:i | ((long digitAt: i) between: 14 and: 126)
+ ifTrue: [(long digitAt: i) asCharacter]
+ ifFalse: [$?]]!
Item was added:
+ ----- Method: CogVMSimulatorLSB>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitAnd: 16rFFFF!
Item was removed:
- ----- Method: CogVMSimulatorLSB>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitAnd: 16rFFFF!
Item was added:
+ ----- Method: CogVMSimulatorLSB>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitShift: -16!
Item was removed:
- ----- Method: CogVMSimulatorLSB>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitShift: -16!
Item was added:
+ ----- Method: CogVMSimulatorLSB>>nextLongFrom: (in category 'initialization') -----
+ nextLongFrom: aStream
+ "Read a 32- or 64-bit quantity from the given (binary) stream."
+
+ ^ aStream nextLittleEndianNumber: BytesPerWord!
Item was removed:
- ----- Method: CogVMSimulatorLSB>>nextLongFrom: (in category 'initialization') -----
- nextLongFrom: aStream
- "Read a 32- or 64-bit quantity from the given (binary) stream."
-
- ^ aStream nextLittleEndianNumber: BytesPerWord!
Item was removed:
- ----- Method: CogVMSimulatorLSB>>nextShortFrom: (in category 'initialization') -----
- nextShortFrom: aStream
- "Read a 16-bit quantity from the given (binary) stream."
- ^aStream nextLittleEndianNumber: 2!
Item was added:
+ ----- Method: CogVMSimulatorLSB>>nextShortFrom: (in category 'initialization') -----
+ nextShortFrom: aStream
+ "Read a 16-bit quantity from the given (binary) stream."
+ ^aStream nextLittleEndianNumber: 2!
Item was removed:
- ----- Method: CogVMSimulatorLSB>>putLong:toFile: (in category 'image save/restore') -----
- putLong: n toFile: f
- "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
-
- | remainingValue |
-
- remainingValue := n.
- 4 timesRepeat: [
- f nextPut: (remainingValue bitAnd: 16rFF).
- remainingValue := remainingValue bitShift: -8].
-
- self success: true!
Item was added:
+ ----- Method: CogVMSimulatorLSB>>putLong:toFile: (in category 'image save/restore') -----
+ putLong: n toFile: f
+ "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
+
+ | remainingValue |
+
+ remainingValue := n.
+ 4 timesRepeat: [
+ f nextPut: (remainingValue bitAnd: 16rFF).
+ remainingValue := remainingValue bitShift: -8].
+
+ self success: true!
Item was removed:
- ----- Method: CogVMSimulatorLSB>>putShort:toFile: (in category 'image save/restore') -----
- putShort: n toFile: f
- "Append the given 2-byte half-word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
-
- | remainingValue |
-
- remainingValue := n.
- 2 timesRepeat: [
- f nextPut: (remainingValue bitAnd: 16rFF).
- remainingValue := remainingValue bitShift: -8].
-
- self success: true!
Item was added:
+ ----- Method: CogVMSimulatorLSB>>putShort:toFile: (in category 'image save/restore') -----
+ putShort: n toFile: f
+ "Append the given 2-byte half-word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
+
+ | remainingValue |
+
+ remainingValue := n.
+ 2 timesRepeat: [
+ f nextPut: (remainingValue bitAnd: 16rFF).
+ remainingValue := remainingValue bitShift: -8].
+
+ self success: true!
Item was removed:
- ----- Method: CogVMSimulatorLSB>>vmEndianness (in category 'memory access') -----
- vmEndianness
- "return 0 for little endian, 1 for big endian"
- ^0!
Item was added:
+ ----- Method: CogVMSimulatorLSB>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ "return 0 for little endian, 1 for big endian"
+ ^0!
Item was added:
+ ----- Method: CogVMThread class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogVMThread struct."
+
+ self allInstVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn caseOf: {
+ ['awolProcesses'] -> [{#sqInt. '[', CogThreadManager awolProcessesIncrement printString, ']'}].
+ ['cStackPointer'] -> [#'void *'].
+ ['cFramePointer'] -> [#'void *'].
+ ['osSemaphore'] -> ['sqOSSemaphore'].
+ ['osThread'] -> ['sqOSThread'].
+ ['reenterInterpreter'] -> ['jmp_buf'] }
+ otherwise:
+ [#sqInt])]!
Item was removed:
- ----- Method: CogVMThread class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogVMThread struct."
-
- self allInstVarNames do:
- [:ivn|
- aBinaryBlock
- value: ivn
- value: (ivn caseOf: {
- ['awolProcesses'] -> [{#sqInt. '[', CogThreadManager awolProcessesIncrement printString, ']'}].
- ['cStackPointer'] -> [#'void *'].
- ['cFramePointer'] -> [#'void *'].
- ['osSemaphore'] -> ['sqOSSemaphore'].
- ['osThread'] -> ['sqOSThread'].
- ['reenterInterpreter'] -> ['jmp_buf'] }
- otherwise:
- [#sqInt])]!
Item was changed:
----- Method: CogVMThread>>growAWOLProcesses (in category 'simulation only') -----
growAWOLProcesses
<doNotGenerate>
awolProcesses setObject: awolProcesses object, (Array new: CogThreadManager awolProcessesIncrement)!
Item was changed:
----- Method: Cogit>>AddCq:R: (in category 'abstract instructions') -----
AddCq: quickConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: AddCqR operand: quickConstant operand: reg!
Item was changed:
----- Method: Cogit>>AddCw:R: (in category 'abstract instructions') -----
AddCw: wordConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: AddCwR operand: wordConstant operand: reg!
Item was changed:
----- Method: Cogit>>AddR:R: (in category 'abstract instructions') -----
AddR: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: AddRR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>AddRd:Rd: (in category 'abstract instructions') -----
AddRd: dpreg1 Rd: dpreg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: AddRdRd operand: dpreg1 operand: dpreg2!
Item was changed:
----- Method: Cogit>>AlignmentNops: (in category 'abstract instructions') -----
AlignmentNops: alignment
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: AlignmentNops operand: alignment!
Item was changed:
----- Method: Cogit>>AndCq:R: (in category 'abstract instructions') -----
AndCq: quickConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: AndCqR operand: quickConstant operand: reg!
Item was changed:
----- Method: Cogit>>AndCw:R: (in category 'abstract instructions') -----
AndCw: wordConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: AndCwR operand: wordConstant operand: reg!
Item was changed:
----- Method: Cogit>>AndR:R: (in category 'abstract instructions') -----
AndR: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: AndRR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>ArithmeticShiftRightCq:R: (in category 'abstract instructions') -----
ArithmeticShiftRightCq: quickConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: ArithmeticShiftRightCqR operand: quickConstant operand: reg!
Item was changed:
----- Method: Cogit>>ArithmeticShiftRightR:R: (in category 'abstract instructions') -----
ArithmeticShiftRightR: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: ArithmeticShiftRightRR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>Call: (in category 'abstract instructions') -----
Call: callTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: Call operand: callTarget!
Item was changed:
----- Method: Cogit>>CmpCq:R: (in category 'abstract instructions') -----
CmpCq: quickConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: CmpCqR operand: quickConstant operand: reg!
Item was changed:
----- Method: Cogit>>CmpCw:R: (in category 'abstract instructions') -----
CmpCw: wordConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: CmpCwR operand: wordConstant operand: reg!
Item was changed:
----- Method: Cogit>>CmpR:R: (in category 'abstract instructions') -----
CmpR: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: CmpRR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>CmpRd:Rd: (in category 'abstract instructions') -----
CmpRd: dpreg1 Rd: dpreg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: CmpRdRd operand: dpreg1 operand: dpreg2!
Item was changed:
----- Method: Cogit>>ConvertR:Rd: (in category 'abstract instructions') -----
ConvertR: reg1 Rd: dpreg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: ConvertRRd operand: reg1 operand: dpreg2!
Item was changed:
----- Method: Cogit>>DivR:R:Quo:Rem: (in category 'abstract instructions') -----
DivR: rDivisor R: rDividend Quo: rQuotient Rem: rRemainder
"Division is a little weird on some processors. Defer to the backEnd
to allow it to generate any special code it may need to."
<returnTypeC: #'AbstractInstruction *'>
<inline: false>
backEnd genDivR: rDivisor R: rDividend Quo: rQuotient Rem: rRemainder.
^self abstractInstructionAt: opcodeIndex - 1!
Item was changed:
----- Method: Cogit>>DivRd:Rd: (in category 'abstract instructions') -----
DivRd: dpreg1 Rd: dpreg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: DivRdRd operand: dpreg1 operand: dpreg2!
Item was changed:
----- Method: Cogit>>Fill16: (in category 'abstract instructions') -----
Fill16: value
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
self assert: (value between: 0 and: 16rFFFF).
^self gen: Fill16 operand: value!
Item was changed:
----- Method: Cogit>>Fill32: (in category 'abstract instructions') -----
Fill32: value
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: Fill32 operand: value!
Item was changed:
----- Method: Cogit>>FillFrom:Word: (in category 'abstract instructions') -----
FillFrom: address Word: value
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: FillFromWord operand: address operand: value!
Item was changed:
----- Method: Cogit>>Jump: (in category 'abstract instructions') -----
Jump: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: Jump operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpAbove: (in category 'abstract instructions') -----
JumpAbove: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpAbove operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpAboveOrEqual: (in category 'abstract instructions') -----
JumpAboveOrEqual: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpAboveOrEqual operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpBelow: (in category 'abstract instructions') -----
JumpBelow: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpBelow operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpBelowOrEqual: (in category 'abstract instructions') -----
JumpBelowOrEqual: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpBelowOrEqual operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpCarry: (in category 'abstract instructions') -----
JumpCarry: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpCarry operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpFPEqual: (in category 'abstract instructions') -----
JumpFPEqual: jumpTarget
"Floating-point jumps are a little weird on some processors. Defer to
the backEnd to allow it to generate any special code it may need to."
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
<inline: false>
^backEnd genJumpFPEqual: jumpTarget!
Item was changed:
----- Method: Cogit>>JumpFPGreater: (in category 'abstract instructions') -----
JumpFPGreater: jumpTarget
"Floating-point jumps are a little weird on some processors. Defer to
the backEnd to allow it to generate any special code it may need to."
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
<inline: false>
^backEnd genJumpFPGreater: jumpTarget!
Item was changed:
----- Method: Cogit>>JumpFPGreaterOrEqual: (in category 'abstract instructions') -----
JumpFPGreaterOrEqual: jumpTarget
"Floating-point jumps are a little weird on some processors. Defer to
the backEnd to allow it to generate any special code it may need to."
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
<inline: false>
^backEnd genJumpFPGreaterOrEqual: jumpTarget!
Item was changed:
----- Method: Cogit>>JumpFPLess: (in category 'abstract instructions') -----
JumpFPLess: jumpTarget
"Floating-point jumps are a little weird on some processors. Defer to
the backEnd to allow it to generate any special code it may need to."
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
<inline: false>
^backEnd genJumpFPLess: jumpTarget!
Item was changed:
----- Method: Cogit>>JumpFPLessOrEqual: (in category 'abstract instructions') -----
JumpFPLessOrEqual: jumpTarget
"Floating-point jumps are a little weird on some processors. Defer to
the backEnd to allow it to generate any special code it may need to."
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
<inline: false>
^backEnd genJumpFPLessOrEqual: jumpTarget!
Item was changed:
----- Method: Cogit>>JumpFPNotEqual: (in category 'abstract instructions') -----
JumpFPNotEqual: jumpTarget
"Floating-point jumps are a little weird on some processors. Defer to
the backEnd to allow it to generate any special code it may need to."
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
<inline: false>
^backEnd genJumpFPNotEqual: jumpTarget!
Item was changed:
----- Method: Cogit>>JumpGreater: (in category 'abstract instructions') -----
JumpGreater: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpGreater operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpGreaterOrEqual: (in category 'abstract instructions') -----
JumpGreaterOrEqual: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpGreaterOrEqual operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpLess: (in category 'abstract instructions') -----
JumpLess: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpLess operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpLessOrEqual: (in category 'abstract instructions') -----
JumpLessOrEqual: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpLessOrEqual operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpLong: (in category 'abstract instructions') -----
JumpLong: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: JumpLong operand: jumpTarget!
Item was changed:
----- Method: Cogit>>JumpLongNonZero: (in category 'abstract instructions') -----
JumpLongNonZero: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: JumpLongNonZero operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpLongZero: (in category 'abstract instructions') -----
JumpLongZero: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: JumpLongZero operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpNegative: (in category 'abstract instructions') -----
JumpNegative: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpNegative operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpNoCarry: (in category 'abstract instructions') -----
JumpNoCarry: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpNoCarry operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpNoOverflow: (in category 'abstract instructions') -----
JumpNoOverflow: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpNoOverflow operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpNonNegative: (in category 'abstract instructions') -----
JumpNonNegative: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpNonNegative operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpNonZero: (in category 'abstract instructions') -----
JumpNonZero: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpNonZero operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpOverflow: (in category 'abstract instructions') -----
JumpOverflow: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpOverflow operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>JumpR: (in category 'abstract instructions') -----
JumpR: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: JumpR operand: reg!
Item was changed:
----- Method: Cogit>>JumpZero: (in category 'abstract instructions') -----
JumpZero: jumpTarget
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
<var: #jumpTarget type: #'void *'>
^self gen: JumpZero operand: jumpTarget asInteger!
Item was changed:
----- Method: Cogit>>Label (in category 'abstract instructions') -----
Label
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: Label operand: (labelCounter := labelCounter + 1) operand: bytecodePC!
Item was changed:
----- Method: Cogit>>LoadEffectiveAddressMw:r:R: (in category 'abstract instructions') -----
LoadEffectiveAddressMw: offset r: baseReg R: destReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: LoadEffectiveAddressMwrR operand: offset operand: baseReg operand: destReg!
Item was changed:
----- Method: Cogit>>LogicalShiftLeftCq:R: (in category 'abstract instructions') -----
LogicalShiftLeftCq: quickConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: LogicalShiftLeftCqR operand: quickConstant operand: reg!
Item was changed:
----- Method: Cogit>>LogicalShiftLeftR:R: (in category 'abstract instructions') -----
LogicalShiftLeftR: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: LogicalShiftLeftRR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>LogicalShiftRightCq:R: (in category 'abstract instructions') -----
LogicalShiftRightCq: quickConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: LogicalShiftRightCqR operand: quickConstant operand: reg!
Item was changed:
----- Method: Cogit>>LogicalShiftRightR:R: (in category 'abstract instructions') -----
LogicalShiftRightR: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: LogicalShiftRightRR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>MoveAw:R: (in category 'abstract instructions') -----
MoveAw: address R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveAwR operand: address operand: reg!
Item was changed:
----- Method: Cogit>>MoveCq:R: (in category 'abstract instructions') -----
MoveCq: quickConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveCqR operand: quickConstant operand: reg!
Item was changed:
----- Method: Cogit>>MoveCw:R: (in category 'abstract instructions') -----
MoveCw: wordConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveCwR operand: wordConstant operand: reg!
Item was changed:
----- Method: Cogit>>MoveM16:r:R: (in category 'abstract instructions') -----
MoveM16: offset r: baseReg R: destReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveM16rR operand: offset operand: baseReg operand: destReg!
Item was changed:
----- Method: Cogit>>MoveM64:r:Rd: (in category 'abstract instructions') -----
MoveM64: offset r: baseReg Rd: destDPReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveM64rRd operand: offset operand: baseReg operand: destDPReg!
Item was changed:
----- Method: Cogit>>MoveMb:r:R: (in category 'abstract instructions') -----
MoveMb: offset r: baseReg R: destReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveMbrR operand: offset operand: baseReg operand: destReg!
Item was changed:
----- Method: Cogit>>MoveMw:r:R: (in category 'abstract instructions') -----
MoveMw: offset r: baseReg R: destReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveMwrR operand: offset operand: baseReg operand: destReg!
Item was changed:
----- Method: Cogit>>MoveR:Aw: (in category 'abstract instructions') -----
MoveR: reg Aw: address
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveRAw operand: reg operand: address!
Item was changed:
----- Method: Cogit>>MoveR:Mb:r: (in category 'abstract instructions') -----
MoveR: sourceReg Mb: offset r: baseReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveRMbr operand: sourceReg operand: offset operand: baseReg!
Item was changed:
----- Method: Cogit>>MoveR:Mw:r: (in category 'abstract instructions') -----
MoveR: sourceReg Mw: offset r: baseReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveRMwr operand: sourceReg operand: offset operand: baseReg!
Item was changed:
----- Method: Cogit>>MoveR:R: (in category 'abstract instructions') -----
MoveR: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveRR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>MoveR:Xbr:R: (in category 'abstract instructions') -----
MoveR: srcReg Xbr: indexReg R: baseReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveRXbrR operand: srcReg operand: indexReg operand: baseReg!
Item was changed:
----- Method: Cogit>>MoveR:Xwr:R: (in category 'abstract instructions') -----
MoveR: sourceReg Xwr: indexReg R: baseReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveRXwrR operand: sourceReg operand: indexReg operand: baseReg!
Item was changed:
----- Method: Cogit>>MoveRd:M64:r: (in category 'abstract instructions') -----
MoveRd: sourceDPReg M64: offset r: baseReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveRdM64r operand: sourceDPReg operand: offset operand: baseReg!
Item was changed:
----- Method: Cogit>>MoveRd:Rd: (in category 'abstract instructions') -----
MoveRd: dpreg1 Rd: dpreg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveRdRd operand: dpreg1 operand: dpreg2!
Item was changed:
----- Method: Cogit>>MoveXbr:R:R: (in category 'abstract instructions') -----
MoveXbr: indexReg R: baseReg R: destReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveXbrRR operand: indexReg operand: baseReg operand: destReg!
Item was changed:
----- Method: Cogit>>MoveXwr:R:R: (in category 'abstract instructions') -----
MoveXwr: indexReg R: baseReg R: destReg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MoveXwrRR operand: indexReg operand: baseReg operand: destReg!
Item was changed:
----- Method: Cogit>>MulR:R: (in category 'abstract instructions') -----
MulR: reg1 R: reg2
"Multiplication is a little weird on some processors. Defer to the backEnd
to allow it to generate any special code it may need to."
<returnTypeC: #'AbstractInstruction *'>
<inline: false>
backEnd genMulR: reg1 R: reg2.
^self abstractInstructionAt: opcodeIndex - 1!
Item was changed:
----- Method: Cogit>>MulRd:Rd: (in category 'abstract instructions') -----
MulRd: dpreg1 Rd: dpreg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: MulRdRd operand: dpreg1 operand: dpreg2!
Item was changed:
----- Method: Cogit>>NegateR: (in category 'abstract instructions') -----
NegateR: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: NegateR operand: reg!
Item was changed:
----- Method: Cogit>>Nop (in category 'abstract instructions') -----
Nop
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: Nop!
Item was changed:
----- Method: Cogit>>OrCq:R: (in category 'abstract instructions') -----
OrCq: quickConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: OrCqR operand: quickConstant operand: reg!
Item was changed:
----- Method: Cogit>>OrCw:R: (in category 'abstract instructions') -----
OrCw: wordConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: OrCwR operand: wordConstant operand: reg!
Item was changed:
----- Method: Cogit>>OrR:R: (in category 'abstract instructions') -----
OrR: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: OrRR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>PopR: (in category 'abstract instructions') -----
PopR: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: PopR operand: reg!
Item was changed:
----- Method: Cogit>>PrefetchAw: (in category 'abstract instructions') -----
PrefetchAw: address
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: PrefetchAw operand: address!
Item was changed:
----- Method: Cogit>>PushCw: (in category 'abstract instructions') -----
PushCw: wordConstant
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: PushCw operand: wordConstant!
Item was changed:
----- Method: Cogit>>PushR: (in category 'abstract instructions') -----
PushR: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: PushR operand: reg!
Item was changed:
----- Method: Cogit>>RetN: (in category 'abstract instructions') -----
RetN: offset
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: RetN operand: offset!
Item was changed:
----- Method: Cogit>>SqrtRd: (in category 'abstract instructions') -----
SqrtRd: dpreg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: SqrtRd operand: dpreg!
Item was changed:
----- Method: Cogit>>SubCq:R: (in category 'abstract instructions') -----
SubCq: quickConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: SubCqR operand: quickConstant operand: reg!
Item was changed:
----- Method: Cogit>>SubCw:R: (in category 'abstract instructions') -----
SubCw: wordConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: SubCwR operand: wordConstant operand: reg!
Item was changed:
----- Method: Cogit>>SubR:R: (in category 'abstract instructions') -----
SubR: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: SubRR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>SubRd:Rd: (in category 'abstract instructions') -----
SubRd: dpreg1 Rd: dpreg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: SubRdRd operand: dpreg1 operand: dpreg2!
Item was changed:
----- Method: Cogit>>XorCw:R: (in category 'abstract instructions') -----
XorCw: wordConstant R: reg
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: XorCwR operand: wordConstant operand: reg!
Item was changed:
----- Method: Cogit>>XorR:R: (in category 'abstract instructions') -----
XorR: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
^self gen: XorRR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>alignUptoRoutineBoundary: (in category 'generate machine code') -----
alignUptoRoutineBoundary: anAddress
^anAddress + 7 bitClear: 7!
Item was changed:
----- Method: Cogit>>assertCStackWellAligned (in category 'simulation only') -----
assertCStackWellAligned
"Check alignment of the C stack. This is a simulation only facsimilie.
See platforms/Cross/vm/sqCogStackAlignment.h for the real code."
<doNotGenerate>
self assert: processor sp \\ cStackAlignment = expectedSPAlignment.
self assert: processor fp \\ cStackAlignment = expectedFPAlignment!
Item was changed:
----- Method: Cogit>>breakBlock: (in category 'simulation only') -----
breakBlock: aBlock
<doNotGenerate>
breakBlock := aBlock!
Item was changed:
----- Method: Cogit>>breakMethod (in category 'simulation only') -----
breakMethod
<doNotGenerate>
^breakMethod!
Item was changed:
----- Method: Cogit>>breakPC (in category 'simulation only') -----
breakPC
<doNotGenerate>
^breakPC!
Item was changed:
----- Method: Cogit>>breakPC: (in category 'simulation only') -----
breakPC: anAddress
<doNotGenerate>
breakPC := anAddress.
(breakPC isInteger
and: [anAddress between: codeBase and: coInterpreter heapBase]) ifTrue:
[singleStep := true].
"If there's a breakPC then it is anded with breakBlock's result, so the breakBlock must default to true.
If there's no breakPC the break block is used on its own and so must befault to false."
(breakBlock isNil
or: [breakBlock method = thisContext method]) ifTrue:
[breakBlock := breakPC isInteger
ifTrue: [[:cogit| true]]
ifFalse: [[:cogit| false]]]!
Item was changed:
----- Method: Cogit>>bytecodeFixupClass (in category 'simulation only') -----
bytecodeFixupClass
self subclassResponsibility!
Item was changed:
----- Method: Cogit>>ceEnterCogCodePopReceiverAndClassRegs (in category 'simulation only') -----
ceEnterCogCodePopReceiverAndClassRegs
<api: 'extern void (*ceEnterCogCodePopReceiverAndClassRegs)()'>
<doNotGenerate>
self simulateEnilopmart: ceEnterCogCodePopReceiverAndClassRegs numArgs: 2!
Item was changed:
----- Method: Cogit>>ceEnterCogCodePopReceiverReg (in category 'simulation only') -----
ceEnterCogCodePopReceiverReg
<api: 'extern void (*ceEnterCogCodePopReceiverReg)()'>
<doNotGenerate>
self simulateEnilopmart: ceEnterCogCodePopReceiverReg numArgs: 1!
Item was changed:
----- Method: Cogit>>cogBlockMethodSurrogateAt: (in category 'simulation only') -----
cogBlockMethodSurrogateAt: address
<doNotGenerate>
self assert: (address bitAnd: BytesPerWord - 1) = 0.
^cogBlockMethodSurrogateClass new
at: address
objectMemory: objectMemory
cogit: self!
Item was changed:
----- Method: Cogit>>cogBlockMethodSurrogateClass (in category 'simulation only') -----
cogBlockMethodSurrogateClass
<doNotGenerate>
^cogBlockMethodSurrogateClass!
Item was added:
+ ----- Method: Cogit>>cogCodeBase (in category 'disassembly') -----
+ cogCodeBase
+ <api>
+ ^codeBase!
Item was removed:
- ----- Method: Cogit>>cogCodeBase (in category 'disassembly') -----
- cogCodeBase
- <api>
- ^codeBase!
Item was changed:
----- Method: Cogit>>cogMethodOrBlockSurrogateAt: (in category 'simulation only') -----
cogMethodOrBlockSurrogateAt: address
<doNotGenerate>
| surrogate |
surrogate := self cogMethodSurrogateAt: address.
^surrogate cmType = CMBlock
ifTrue: [self cogBlockMethodSurrogateAt: address]
ifFalse: [surrogate]!
Item was changed:
----- Method: Cogit>>cogMethodSurrogateAt: (in category 'simulation only') -----
cogMethodSurrogateAt: address
<doNotGenerate>
self assert: (address bitAnd: BytesPerWord - 1) = 0.
^cogMethodSurrogateClass new
at: address
objectMemory: objectMemory
cogit: self!
Item was changed:
----- Method: Cogit>>cogMethodSurrogateClass (in category 'simulation only') -----
cogMethodSurrogateClass
<doNotGenerate>
^cogMethodSurrogateClass!
Item was changed:
----- Method: Cogit>>cogit (in category 'simulation only') -----
cogit
"This is for the sizeof: CogMethod hook that allows different cogit classes to use differet CogMethod variants."
<doNotGenerate>
^self!
Item was changed:
----- Method: Cogit>>compilationTrace (in category 'simulation only') -----
compilationTrace
^compilationTrace!
Item was changed:
----- Method: Cogit>>compilationTrace: (in category 'simulation only') -----
compilationTrace: anInteger
compilationTrace := anInteger!
Item was changed:
----- Method: Cogit>>computeMaximumSizes (in category 'generate machine code') -----
computeMaximumSizes
"This pass assigns maximum sizes to all abstract instructions and eliminates jump fixups.
It hence assigns the maximum address an instruction will occur at which allows the next
pass to conservatively size jumps."
<inline: false>
<var: #abstractInstruction type: #'AbstractInstruction *'>
| relativeAddress |
relativeAddress := 0.
0 to: opcodeIndex - 1 do:
[:i| | abstractInstruction |
abstractInstruction := self abstractInstructionAt: i.
abstractInstruction address: relativeAddress.
abstractInstruction computeMaximumSize.
relativeAddress := relativeAddress + abstractInstruction maxSize].
!
Item was changed:
----- Method: Cogit>>disassembleCachedOop: (in category 'simulation only') -----
disassembleCachedOop: address
<doNotGenerate>
| oopOrZero |
"Answer a disassembly string for an implicit receiver cache entry in a Newspeak send."
oopOrZero := objectMemory unalignedLongAt: address.
^(objectMemory addressCouldBeObj: oopOrZero)
ifTrue: [oopOrZero hex, ': ', (coInterpreter shortPrint: oopOrZero)]
ifFalse: [oopOrZero = 0 ifTrue: [oopOrZero printString] ifFalse: [oopOrZero hex]]!
Item was changed:
----- Method: Cogit>>doesNotUnderstand: (in category 'simulation only') -----
doesNotUnderstand: aMessage
(aMessage selector beginsWith: 'print') ifTrue:
[(coInterpreter respondsTo: aMessage selector) ifTrue:
[^aMessage lookupClass: nil; sentTo: coInterpreter].
(methodZone respondsTo: aMessage selector) ifTrue:
[^aMessage lookupClass: nil; sentTo: methodZone].
(objectMemory respondsTo: aMessage selector) ifTrue:
[^aMessage lookupClass: nil; sentTo: objectMemory]].
^super doesNotUnderstand: aMessage!
Item was changed:
----- Method: Cogit>>fillInBlockHeadersAt: (in category 'generate machine code') -----
fillInBlockHeadersAt: startAddress
"Fill in the block headers now we know the exact layout of the code."
| blockStart blockHeader |
<var: #blockStart type: #'BlockStart *'>
<var: #blockHeader type: #'CogBlockMethod *'>
(needsFrame and: [blockCount > 0]) ifFalse:
[^nil].
blockNoContextSwitchOffset = nil
ifTrue: [blockNoContextSwitchOffset := blockEntryLabel address - blockEntryNoContextSwitch address]
ifFalse: [self assert: blockNoContextSwitchOffset = (blockEntryLabel address - blockEntryNoContextSwitch address)].
0 to: blockCount - 1 do:
[:i|
blockStart := self blockStartAt: i.
blockHeader := self cCoerceSimple: blockStart fakeHeader address
to: #'CogBlockMethod *'.
blockHeader
homeOffset: (blockStart fakeHeader address - startAddress);
startpc: blockStart startpc;
cmType: CMBlock;
cmNumArgs: blockStart numArgs;
stackCheckOffset: (blockStart stackCheckLabel = nil
ifTrue: [0]
ifFalse: [blockStart stackCheckLabel address - blockStart fakeHeader address])]!
Item was changed:
----- Method: Cogit>>fillInCPICHeader:size:numArgs:numCases:hasMNUCase:selector: (in category 'generate machine code') -----
fillInCPICHeader: pic size: size numArgs: numArgs numCases: numCases hasMNUCase: hasMNUCase selector: selector
<returnTypeC: #'CogMethod *'>
<var: #pic type: #'CogMethod *'>
self assert: (objectMemory isYoung: selector) not.
pic cmType: CMClosedPIC.
pic objectHeader: 0.
pic blockSize: size.
pic methodObject: 0.
pic methodHeader: 0.
pic selector: selector.
pic cmNumArgs: numArgs.
pic cmRefersToYoung: false.
pic cmUsageCount: self initialClosedPICUsageCount.
pic cpicHasMNUCase: hasMNUCase.
pic cPICNumCases: numCases.
pic blockEntryOffset: 0.
self assert: pic cmType = CMClosedPIC.
self assert: pic selector = selector.
self assert: pic cmNumArgs = numArgs.
self assert: pic cPICNumCases = numCases.
self assert: (backEnd callTargetFromReturnAddress: pic asInteger + missOffset) = (self picAbortTrampolineFor: numArgs).
self assert: size = (methodZone roundUpLength: size).
^pic!
Item was changed:
----- Method: Cogit>>fillInMethodHeader:size:selector: (in category 'generate machine code') -----
fillInMethodHeader: method size: size selector: selector
<returnTypeC: #'CogMethod *'>
<var: #method type: #'CogMethod *'>
<var: #originalMethod type: #'CogMethod *'>
| methodHeader originalMethod |
method cmType: CMMethod.
method objectHeader: objectMemory nullHeaderForMachineCodeMethod.
method blockSize: size.
method methodObject: methodObj.
methodHeader := coInterpreter rawHeaderOf: methodObj.
"If the method has already been cogged (e.g. Newspeak accessors) then
leave the original method attached to its cog method, but get the right header."
(coInterpreter isCogMethodReference: methodHeader)
ifTrue:
[originalMethod := self cCoerceSimple: methodHeader to: #'CogMethod *'.
self assert: originalMethod blockSize = size.
methodHeader := originalMethod methodHeader.
self cppIf: NewspeakVM ifTrue: [methodZone addToUnpairedMethodList: method]]
ifFalse:
[coInterpreter rawHeaderOf: methodObj put: method asInteger].
method methodHeader: methodHeader.
method selector: selector.
method cmNumArgs: (coInterpreter argumentCountOfMethodHeader: methodHeader).
(method cmRefersToYoung: hasYoungReferent) ifTrue:
[methodZone addToYoungReferrers: method].
method cmUsageCount: self initialMethodUsageCount.
method cpicHasMNUCase: false.
method cmUsesPenultimateLit: maxLitIndex >= ((coInterpreter literalCountOfHeader: methodHeader) - 2).
method cmUsesMethodClass: usesMethodClass.
method blockEntryOffset: (blockEntryLabel notNil
ifTrue: [blockEntryLabel address - method asInteger]
ifFalse: [0]).
"This can be an error check since a large stackCheckOffset is caused by compiling
a machine-code primitive, and hence depends on the Cogit, not the input method."
needsFrame ifTrue:
[stackCheckLabel address - method asInteger <= MaxStackCheckOffset ifFalse:
[self error: 'too much code for stack check offset']].
method stackCheckOffset: (needsFrame
ifTrue: [stackCheckLabel address - method asInteger]
ifFalse: [0]).
self assert: (backEnd callTargetFromReturnAddress: method asInteger + missOffset)
= (self methodAbortTrampolineFor: method cmNumArgs).
self assert: size = (methodZone roundUpLength: size).
^method!
Item was changed:
----- Method: Cogit>>fillInOPICHeader:size:numArgs:selector: (in category 'generate machine code') -----
fillInOPICHeader: pic size: size numArgs: numArgs selector: selector
<returnTypeC: #'CogMethod *'>
<var: #pic type: #'CogMethod *'>
pic cmType: CMOpenPIC.
pic objectHeader: 0.
pic blockSize: size.
"pic methodObject: 0.""This is also the nextOpenPIC link so don't initialize it"
methodZone addToOpenPICList: pic.
pic methodHeader: 0.
pic selector: selector.
pic cmNumArgs: numArgs.
(pic cmRefersToYoung: (objectMemory isYoung: selector)) ifTrue:
[methodZone addToYoungReferrers: pic].
pic cmUsageCount: self initialOpenPICUsageCount.
pic cpicHasMNUCase: false.
pic cPICNumCases: 0.
pic blockEntryOffset: 0.
self assert: pic cmType = CMOpenPIC.
self assert: pic selector = selector.
self assert: pic cmNumArgs = numArgs.
self assert: (backEnd callTargetFromReturnAddress: pic asInteger + missOffset) = (self picAbortTrampolineFor: numArgs).
self assert: size = (methodZone roundUpLength: size).
^pic!
Item was changed:
----- Method: Cogit>>generateCogMethod: (in category 'generate machine code') -----
generateCogMethod: selector
"We handle jump sizing simply. First we make a pass that asks each
instruction to compute its maximum size. Then we make a pass that
sizes jumps based on the maxmimum sizes. Then we make a pass
that fixes up jumps. When fixing up a jump the jump is not allowed to
choose a smaller offset but must stick to the size set in the second pass."
<returnTypeC: #'CogMethod *'>
| codeSize headerSize mapSize totalSize startAddress result method |
<var: #method type: #'CogMethod *'>
headerSize := self sizeof: CogMethod.
methodLabel address: headerSize negated.
self computeMaximumSizes.
methodLabel concretizeAt: methodZone freeStart.
codeSize := self generateInstructionsAt: methodLabel address + headerSize.
mapSize := self generateMapAt: 0 start: methodLabel address + cmNoCheckEntryOffset.
totalSize := methodZone roundUpLength: headerSize + codeSize + mapSize.
totalSize > MaxMethodSize ifTrue:
[^self cCoerceSimple: MethodTooBig to: #'CogMethod *'].
startAddress := methodZone allocate: totalSize.
startAddress = 0 ifTrue:
[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
self assert: startAddress + cmEntryOffset = entry address.
self assert: startAddress + cmNoCheckEntryOffset = noCheckEntry address.
result := self outputInstructionsAt: startAddress + headerSize.
self assert: startAddress + headerSize + codeSize = result.
backEnd padIfPossibleWithNopsFrom: result to: startAddress + totalSize - mapSize.
self generateMapAt: startAddress + totalSize - 1 start: startAddress + cmNoCheckEntryOffset.
self fillInBlockHeadersAt: startAddress.
method := self fillInMethodHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
size: totalSize
selector: selector.
postCompileHook notNil ifTrue:
[self perform: postCompileHook with: method with: primInvokeLabel.
postCompileHook := nil].
processor flushICacheFrom: startAddress to: startAddress + headerSize + codeSize.
^method!
Item was changed:
----- Method: Cogit>>generateInstructionsAt: (in category 'generate machine code') -----
generateInstructionsAt: eventualAbsoluteAddress
"Size pc-dependent instructions and assign eventual addresses to all instructions.
Answer the size of the code.
Compute forward branches based on virtual address (abstract code starts at 0),
assuming that any branches branched over are long.
Compute backward branches based on actual address.
Reuse the fixups array to record the pc-dependent instructions that need to have
their code generation postponed until after the others."
| absoluteAddress pcDependentIndex abstractInstruction fixup |
<var: #abstractInstruction type: #'AbstractInstruction *'>
<var: #fixup type: #'BytecodeFixup *'>
absoluteAddress := eventualAbsoluteAddress.
pcDependentIndex := 0.
0 to: opcodeIndex - 1 do:
[:i|
breakPC = absoluteAddress ifTrue:
[self halt: 'breakPC reached in generateInstructionsAt:'].
abstractInstruction := self abstractInstructionAt: i.
abstractInstruction isPCDependent
ifTrue:
[abstractInstruction sizePCDependentInstructionAt: absoluteAddress.
fixup := self fixupAt: pcDependentIndex.
pcDependentIndex := pcDependentIndex + 1.
fixup instructionIndex: i.
absoluteAddress := absoluteAddress + abstractInstruction machineCodeSize]
ifFalse:
[absoluteAddress := abstractInstruction concretizeAt: absoluteAddress]].
0 to: pcDependentIndex - 1 do:
[:i|
fixup := self fixupAt: i.
abstractInstruction := self abstractInstructionAt: fixup instructionIndex.
breakPC = absoluteAddress ifTrue:
[self halt: 'breakPC reached in generateInstructionsAt:'].
abstractInstruction concretizeAt: abstractInstruction address].
self cCode: ''
inSmalltalk:
[breakPC ifNotNil:
[breakPC <= absoluteAddress ifTrue:
[self singleStep: true]]].
^absoluteAddress - eventualAbsoluteAddress!
Item was changed:
----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
<doNotGenerate>
| evaluable function result savedFramePointer savedStackPointer savedArgumentCount rpc |
evaluable := simulatedTrampolines at: aProcessorSimulationTrap address.
function := evaluable
isBlock ifTrue: ['aBlock; probably some plugin primitive']
ifFalse: [evaluable selector].
function ~~ #ceBaseFrameReturn: ifTrue:
[coInterpreter assertValidExternalStackPointers].
(function beginsWith: 'ceShort') ifTrue:
[^self perform: function with: aProcessorSimulationTrap].
aProcessorSimulationTrap type = #call
ifTrue:
[processor
simulateCallOf: aProcessorSimulationTrap address
nextpc: aProcessorSimulationTrap nextpc
memory: coInterpreter memory.
self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}]
ifFalse:
[processor
simulateJumpCallOf: aProcessorSimulationTrap address
memory: coInterpreter memory.
self recordInstruction: {'(simulated jump to '. aProcessorSimulationTrap address. '/'. function. ')'}].
savedFramePointer := coInterpreter framePointer.
savedStackPointer := coInterpreter stackPointer.
savedArgumentCount := coInterpreter argumentCount.
result := ["self halt: evaluable selector."
evaluable valueWithArguments: (processor
postCallArgumentsNumArgs: evaluable numArgs
in: coInterpreter memory)]
on: ReenterMachineCode
do: [:ex| ex return: ex returnValue].
coInterpreter assertValidExternalStackPointers.
"Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
not called something that has built a frame, such as closure value or evaluate method, or
switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
(function beginsWith: 'primitive') ifTrue:
[objectMemory checkForLastObjectOverwrite.
coInterpreter primFailCode = 0
ifTrue: [(#( primitiveClosureValue primitiveClosureValueWithArgs primitiveClosureValueNoContextSwitch
primitiveSignal primitiveWait primitiveResume primitiveSuspend primitiveYield
primitiveExecuteMethodArgsArray primitiveExecuteMethod
primitivePerform primitivePerformWithArgs primitivePerformInSuperclass
primitiveTerminateTo primitiveStoreStackp primitiveDoPrimitiveWithArgs)
includes: function) ifFalse:
[self assert: savedFramePointer = coInterpreter framePointer.
self assert: savedStackPointer + (savedArgumentCount * BytesPerWord)
= coInterpreter stackPointer]]
ifFalse:
[self assert: savedFramePointer = coInterpreter framePointer.
self assert: savedStackPointer = coInterpreter stackPointer]].
result ~~ #continueNoReturn ifTrue:
[self recordInstruction: {'(simulated return to '. processor retpcIn: coInterpreter memory. ')'}.
rpc := processor retpcIn: coInterpreter memory.
self assert: (rpc >= codeBase and: [rpc < methodZone freeStart]).
processor
smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: BytesPerWord;
simulateReturnIn: coInterpreter memory].
self assert: (result isInteger "an oop result"
or: [result == coInterpreter
or: [result == objectMemory
or: [#(nil continue continueNoReturn) includes: result]]]).
processor cResultRegister: (result
ifNil: [0]
ifNotNil: [result isInteger
ifTrue: [result]
ifFalse: [16rF00BA222]])
"coInterpreter cr.
processor sp + 32 to: processor sp - 32 by: -4 do:
[:sp|
sp = processor sp
ifTrue: [coInterpreter print: 'sp->'; tab]
ifFalse: [coInterpreter printHex: sp].
coInterpreter tab; printHex: (coInterpreter longAt: sp); cr]"!
Item was changed:
----- Method: Cogit>>handleReadSimulationTrap: (in category 'simulation only') -----
handleReadSimulationTrap: aProcessorSimulationTrap
<doNotGenerate>
| variableValue |
variableValue := (simulatedVariableGetters at: aProcessorSimulationTrap address) value asInteger.
processor
perform: aProcessorSimulationTrap registerAccessor
with: variableValue signedIntToLong.
processor pc: aProcessorSimulationTrap nextpc!
Item was changed:
----- Method: Cogit>>handleSimulationTrap: (in category 'simulation only') -----
handleSimulationTrap: aProcessorSimulationTrap
<doNotGenerate>
aProcessorSimulationTrap type caseOf:
{ [#read] -> [self handleReadSimulationTrap: aProcessorSimulationTrap].
[#write] -> [self handleWriteSimulationTrap: aProcessorSimulationTrap].
[#call] -> [self handleCallOrJumpSimulationTrap: aProcessorSimulationTrap].
[#jump] -> [self handleCallOrJumpSimulationTrap: aProcessorSimulationTrap] }!
Item was changed:
----- Method: Cogit>>handleWriteSimulationTrap: (in category 'simulation only') -----
handleWriteSimulationTrap: aProcessorSimulationTrap
<doNotGenerate>
| variableValue |
(aProcessorSimulationTrap address between: codeBase and: methodZone zoneEnd) ifTrue:
[self error: 'attempt to write to code space'].
variableValue := processor perform: aProcessorSimulationTrap registerAccessor.
(simulatedVariableSetters at: aProcessorSimulationTrap address) value: variableValue.
processor pc: aProcessorSimulationTrap nextpc!
Item was changed:
----- Method: Cogit>>initialClosedPICUsageCount (in category 'generate machine code') -----
initialClosedPICUsageCount
"Answer a usage count that reflects likely long-term usage."
^2!
Item was changed:
----- Method: Cogit>>initialMethodUsageCount (in category 'generate machine code') -----
initialMethodUsageCount
"Answer a usage count that reflects likely long-term usage.
Answer 0 for non-primitives or quick primitives (inst var accessors),
1 for methods with interpreter primitives, and 2 for compiled primitives."
(primitiveIndex = 0
or: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
[^0].
self primitiveGeneratorOrNil isNil ifTrue:
[^1].
^2!
Item was changed:
----- Method: Cogit>>initialOpenPICUsageCount (in category 'generate machine code') -----
initialOpenPICUsageCount
"Answer a usage count that reflects likely long-term usage."
^3!
Item was changed:
----- Method: Cogit>>isAbsentReceiverSendAt:in: (in category 'simulation only') -----
isAbsentReceiverSendAt: mcpc in: cogHomeMethod
| prev this |
self mapFor: cogHomeMethod
do: [:a :m|
m < mcpc
ifTrue: [prev := a]
ifFalse: [m = mcpc ifTrue: [this := a]].
false].
^this = IsSendCall and: [prev = IsNSSendCall]!
Item was changed:
----- Method: Cogit>>labelForSimulationAccessor: (in category 'simulation only') -----
labelForSimulationAccessor: blockOrMessageSendOrSelector
<doNotGenerate>
^'&', (blockOrMessageSendOrSelector isBlock
ifTrue: ['block in ', blockOrMessageSendOrSelector method selector]
ifFalse: [blockOrMessageSendOrSelector isMessageSend
ifTrue: [blockOrMessageSendOrSelector selector]
ifFalse: [blockOrMessageSendOrSelector]])!
Item was changed:
----- Method: Cogit>>mapPrimitive:withIndexToUniqueAddress: (in category 'simulation only') -----
mapPrimitive: primitiveRoutine "<Symbol>" withIndexToUniqueAddress: primitiveIndex "<SmallInteger>"
| uniqueAddress |
<doNotGenerate>
self assert: (primitiveRoutine isSymbol or: [primitiveRoutine isBlock]).
uniqueAddress := -1 - methodZoneBase - (primitiveIndex * 4) - 16r1000 bitAnd: self allButTopBitOfAddressSpaceMask.
simulatedTrampolines
at: uniqueAddress
ifAbsentPut:
[primitiveRoutine isSymbol
ifTrue: [MessageSend receiver: coInterpreter selector: primitiveRoutine]
ifFalse: [primitiveRoutine]].
^uniqueAddress!
Item was changed:
----- Method: Cogit>>methodZone (in category 'simulation only') -----
methodZone
<doNotGenerate>
^methodZone!
Item was changed:
----- Method: Cogit>>nExtensionsFor:in: (in category 'simulation only') -----
nExtensionsFor: bcpc in: aMethodObj
(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj) ifFalse:
[^0].
^(InstructionStream on: (VMCompiledMethodProxy new
for: aMethodObj
coInterpreter: coInterpreter
objectMemory: objectMemory))
extensionsForBytecodeAt: bcpc + 1
into: [:extAValue :extBValue| (extAValue ~= 0 ifTrue: [1] ifFalse: [0]) + (extBValue ~= 0 ifTrue: [1] ifFalse: [0])]!
Item was changed:
----- Method: Cogit>>objectRepresentation (in category 'simulation only') -----
objectRepresentation
<doNotGenerate>
^objectRepresentation!
Item was changed:
----- Method: Cogit>>offset:of: (in category 'simulation only') -----
offset: aClass of: fieldSymbol
"This is implemented by stddef's offsetof macro."
<doNotGenerate>
^aClass caseOf:
{ [CogMethod] -> [cogMethodSurrogateClass offsetOf: fieldSymbol] }!
Item was changed:
----- Method: Cogit>>outputInstructionsAt: (in category 'generate machine code') -----
outputInstructionsAt: startAddress
"Store the generated machine code, answering the last address"
| absoluteAddress |
<var: #abstractInstruction type: #'AbstractInstruction *'>
absoluteAddress := startAddress.
0 to: opcodeIndex - 1 do:
[:i| | abstractInstruction |
abstractInstruction := self abstractInstructionAt: i.
self assert: abstractInstruction address = absoluteAddress.
0 to: abstractInstruction machineCodeSize - 1 do:
[:j|
objectMemory byteAt: absoluteAddress put: (abstractInstruction machineCode at: j).
absoluteAddress := absoluteAddress + 1]].
^absoluteAddress!
Item was changed:
----- Method: Cogit>>recordInstruction: (in category 'simulation only') -----
recordInstruction: thing
<doNotGenerate>
lastNInstructions addLast: thing.
[lastNInstructions size > 160"80"] whileTrue:
[lastNInstructions removeFirst.
lastNInstructions size * 2 > lastNInstructions capacity ifTrue:
[lastNInstructions makeRoomAtLast]].
^thing!
Item was changed:
----- Method: Cogit>>recordLastInstruction (in category 'simulation only') -----
recordLastInstruction
<doNotGenerate>
^self recordInstruction: (processor
disassembleNextInstructionIn: coInterpreter memory
for: (EagerInstructionDecoration ifTrue: [self]))!
Item was changed:
----- Method: Cogit>>recordProcessing (in category 'simulation only') -----
recordProcessing
| inst |
self recordRegisters.
inst := self recordLastInstruction.
printRegisters ifTrue:
[processor printRegistersOn: coInterpreter transcript].
printInstructions ifTrue:
[printRegisters ifTrue:
[coInterpreter transcript cr].
coInterpreter transcript nextPutAll: inst; cr; flush]!
Item was changed:
----- Method: Cogit>>recordRegisters (in category 'simulation only') -----
recordRegisters
<doNotGenerate>
self recordInstruction: processor integerRegisterState
"self recordInstruction: processor registerState"!
Item was changed:
----- Method: Cogit>>selectorForSendAt:annotation: (in category 'simulation only') -----
selectorForSendAt: mcpc annotation: annotation
<doNotGenerate>
| entryPoint offset targetMethod selector |
entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
selector := entryPoint > methodZoneBase
ifTrue: "It's a linked send."
[self
offsetAndSendTableFor: entryPoint
annotation: annotation
into: [:off :table| offset := off].
targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
targetMethod selector]
ifFalse:
[backEnd inlineCacheTagAt: mcpc].
^coInterpreter isCurrentImageFacade
ifTrue: [coInterpreter objectForOop: selector]
ifFalse: [selector]!
Item was changed:
----- Method: Cogit>>selectorForSendBefore:in: (in category 'simulation only') -----
selectorForSendBefore: bcpc in: aCompiledMethod
<doNotGenerate>
| is sel |
"sends map to the following pc. need to find the selector for the previous pc"
is := InstructionStream on: aCompiledMethod.
is pc: (aCompiledMethod pcPreviousTo: bcpc + 1). "bcpc is 0-rel"
^(sel := is selectorToSendOrSelf) ~~ is ifTrue: [sel]!
Item was changed:
----- Method: Cogit>>shortcutTrampoline:to: (in category 'simulation only') -----
shortcutTrampoline: aProcessorSimulationTrap to: aBlock
<doNotGenerate>
processor
simulateLeafCallOf: aProcessorSimulationTrap address
nextpc: aProcessorSimulationTrap nextpc
memory: coInterpreter memory.
coInterpreter
stackPointer: processor sp;
framePointer: processor fp.
processor
sp: self getCStackPointer;
fp: self getCFramePointer.
aBlock value.
processor
sp: coInterpreter stackPointer;
fp: coInterpreter framePointer;
simulateLeafReturnIn: coInterpreter memory!
Item was changed:
----- Method: Cogit>>simulateCogCodeAt: (in category 'simulation only') -----
simulateCogCodeAt: address "<Integer>"
<doNotGenerate>
| stackZoneBase |
stackZoneBase := coInterpreter stackZoneBase.
processor pc: address.
[[[singleStep ifTrue:
[[processor sp < stackZoneBase ifTrue: [self halt].
self recordProcessing.
(breakPC isInteger
ifTrue:
[processor pc = breakPC
and: [breakBlock value: self]]
ifFalse:
[breakBlock value: self]) ifTrue:
["printRegisters := printInstructions := true"
"self reportLastNInstructions"
"coInterpreter printExternalHeadFrame"
"coInterpreter printFrameAndCallers: coInterpreter framePointer SP: coInterpreter stackPointer"
"coInterpreter shortPrintFrameAndCallers: coInterpreter framePointer"
"coInterpreter printFrame: processor fp WithSP: processor sp"
"coInterpreter printFrameAndCallers: processor fp SP: processor sp"
"coInterpreter shortPrintFrameAndCallers: processor fp"
"self disassembleMethodFor: processor pc"
coInterpreter changed: #byteCountText.
self halt: 'machine code breakpoint at ', processor pc hex]] value]. "So that the Debugger's Over steps over all this"
singleStep
ifTrue: [processor
singleStepIn: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd]
ifFalse: [processor
runInMemory: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd].
((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
[(self confirm: 'continue?') ifFalse:
[self halt]].
true] whileTrue]
on: ProcessorSimulationTrap
do: [:ex| self handleSimulationTrap: ex].
true] whileTrue!
Item was changed:
----- Method: Cogit>>simulateEnilopmart:numArgs: (in category 'simulation only') -----
simulateEnilopmart: enilopmartAddress numArgs: n
<doNotGenerate>
"Enter Cog code, popping the class reg and receiver from the stack
and then returning to the address beneath them.
In the actual VM the enilopmart is a function pointer and so senders
of this method end up calling the enilopmart to enter machine code.
In simulation we either need to start simulating execution (if we're in
the interpreter) or return to the simulation (if we're in the run-time
called from machine code. We should also smash the register state
since, being an abnormal entry, no saved registers will be restored."
self assert: (coInterpreter isOnRumpCStack: processor sp).
self assert: ((coInterpreter stackValue: n) between: guardPageSize and: methodZone freeStart - 1).
(printInstructions or: [printRegisters]) ifTrue:
[coInterpreter printExternalHeadFrame].
processor
smashRegistersWithValuesFrom: 16r80000000 by: BytesPerWord;
simulateLeafCallOf: enilopmartAddress
nextpc: 16rBADF00D
memory: coInterpreter memory.
"If we're already simulating in the context of machine code then
this will take us back to handleCallSimulationTrap:. Otherwise
start executing machine code in the simulator."
(ReenterMachineCode new returnValue: #continueNoReturn) signal.
self simulateCogCodeAt: enilopmartAddress.
"We should either longjmp back to the interpreter or
stay in machine code so control should not reach here."
self assert: false!
Item was changed:
----- Method: Cogit>>simulateLeafCallOf: (in category 'simulation only') -----
simulateLeafCallOf: someFunction
"Simulate execution of machine code that leaf-calls someFunction,
answering the result returned by someFunction."
<doNotGenerate>
| spOnEntry |
self recordRegisters.
processor
simulateLeafCallOf: someFunction
nextpc: 16rBADF00D5
memory: coInterpreter memory.
spOnEntry := processor sp.
self recordInstruction: {'(simulated call of '. someFunction. ')'}.
[[processor pc between: 0 and: methodZone zoneEnd] whileTrue:
[singleStep
ifTrue: [self recordProcessing.
processor
singleStepIn: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd]
ifFalse: [processor
runInMemory: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd]]]
on: ProcessorSimulationTrap
do: [:ex| | retpc |
"If the ip is out of bounds the return has already occurred."
((processor pc between: 0 and: methodZone zoneEnd)
and: [processor sp <= spOnEntry]) ifTrue:
[retpc := processor leafRetpcIn: coInterpreter memory.
self assert: retpc = 16rBADF00D5.
self recordInstruction: {'(simulated return to '. retpc. ')'.
processor simulateLeafReturnIn: coInterpreter memory}.
self recordRegisters]].
^processor cResultRegister!
Item was changed:
----- Method: Cogit>>tryLockVMOwner (in category 'multi-threading') -----
tryLockVMOwner
<api>
"ceTryLockVMOwner does an atomic swap of the lock with 1 and
then subtracts 1from lock's value. So if the result is 0 the lock was
already held. Anything else (in fact -1) implies we hold the lock."
<cmacro: '() (ceTryLockVMOwner() !!= 0)'>
^(self simulateLeafCallOf: ceTryLockVMOwner) ~= 0!
Item was changed:
----- Method: Cogit>>unlockVMOwner (in category 'multi-threading') -----
unlockVMOwner
<api>
<cmacro: '() ceUnlockVMOwner()'>
^self simulateLeafCallOf: ceUnlockVMOwner!
Item was changed:
----- Method: CurrentImageCoInterpreterFacade>>addressCouldBeObj: (in category 'debug support') -----
addressCouldBeObj: address
^(address bitAnd: 3) = 0
and: [self addressCouldBeOop: address]!
Item was changed:
----- Method: CurrentImageCoInterpreterFacade>>addressCouldBeOop: (in category 'debug support') -----
addressCouldBeOop: anOop
[self objectForOop: anOop]
on: Error
do: [:ex| ^false].
^true!
Item was changed:
----- Method: CurrentImageCoInterpreterFacade>>cCoerceSimple:to: (in category 'debug support') -----
cCoerceSimple: value to: cTypeString
"Type coercion for translation and simulation.
For simulation answer a suitable surrogate for the struct types"
^cTypeString
caseOf:
{ [#'CogMethod *'] -> [cogit cogMethodSurrogateAt: value asUnsignedInteger].
[#'CogBlockMethod *'] -> [cogit cogBlockMethodSurrogateAt: value asUnsignedInteger] }
otherwise: [super cCoerceSimple: value to: cTypeString]!
Item was changed:
----- Method: CurrentImageCoInterpreterFacade>>compilationBreak:point: (in category 'debug support') -----
compilationBreak: aString point: length
^self!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>fetchPointer:ofObject: (in category 'accessing') -----
+ fetchPointer: index ofObject: anOop
+ | obj |
+ obj := (objectMap keyAtValue: anOop).
+ ^obj isCompiledMethod
+ ifTrue: [obj objectAt: index + 1]
+ ifFalse: [obj instVarAt: index + 1]!
Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>fetchPointer:ofObject: (in category 'accessing') -----
- fetchPointer: index ofObject: anOop
- | obj |
- obj := (objectMap keyAtValue: anOop).
- ^obj isCompiledMethod
- ifTrue: [obj objectAt: index + 1]
- ifFalse: [obj instVarAt: index + 1]!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>long32At:put: (in category 'accessing') -----
+ long32At: index put: value
+ ^memory longAt: index + 1 put: value bigEndian: false!
Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>long32At:put: (in category 'accessing') -----
- long32At: index put: value
- ^memory longAt: index + 1 put: value bigEndian: false!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>longAt: (in category 'accessing') -----
+ longAt: index
+ ^memory unsignedLongAt: index + 1!
Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>longAt: (in category 'accessing') -----
- longAt: index
- ^memory unsignedLongAt: index + 1!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>longAt:put: (in category 'accessing') -----
+ longAt: index put: value
+ ^memory longAt: index + 1 put: value bigEndian: false!
Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>longAt:put: (in category 'accessing') -----
- longAt: index put: value
- ^memory longAt: index + 1 put: value bigEndian: false!
Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>storePointerUnchecked:ofObject:withValue: (in category 'accessing') -----
- storePointerUnchecked: zeroRelativeIndex ofObject: targetOop withValue: valueOop
- (self objectForOop: targetOop) at: zeroRelativeIndex + 1 put: (self objectForOop: valueOop)!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>storePointerUnchecked:ofObject:withValue: (in category 'accessing') -----
+ storePointerUnchecked: zeroRelativeIndex ofObject: targetOop withValue: valueOop
+ (self objectForOop: targetOop) at: zeroRelativeIndex + 1 put: (self objectForOop: valueOop)!
Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>unalignedLongAt: (in category 'accessing') -----
- unalignedLongAt: index
- ^memory unsignedLongAt: index + 1!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>unalignedLongAt: (in category 'accessing') -----
+ unalignedLongAt: index
+ ^memory unsignedLongAt: index + 1!
Item was changed:
----- Method: FloatMathPluginSimulator>>isnan: (in category 'float primitives') -----
isnan: result
^result isNaN!
Item was changed:
----- Method: IA32ABIPlugin class>>simulatorClass (in category 'simulation only') -----
simulatorClass
^NewspeakVM ifFalse: [IA32ABIPluginSimulator]!
Item was removed:
- ----- Method: IA32ABIPluginSimulator>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- ^interpreterProxy longAt: byteAddress!
Item was added:
+ ----- Method: IA32ABIPluginSimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ ^interpreterProxy longAt: byteAddress!
Item was removed:
- ----- Method: IA32ABIPluginSimulator>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a32BitValue
- ^interpreterProxy longAt: byteAddress put: a32BitValue!
Item was added:
+ ----- Method: IA32ABIPluginSimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ ^interpreterProxy longAt: byteAddress put: a32BitValue!
Item was changed:
----- Method: Interpreter>>allAccessibleObjectsOkay (in category 'debug support') -----
allAccessibleObjectsOkay
"Ensure that all accessible objects in the heap are okay."
| oop ok |
ok := true.
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[ok := ok & (self okayFields: oop).
oop := self accessibleObjectAfter: oop].
^ok!
Item was added:
+ ----- Method: Interpreter>>arrayValueOf: (in category 'utilities') -----
+ arrayValueOf: arrayOop
+ "Return the address of first indexable field of resulting array object, or fail if the instance variable does not contain an indexable bytes or words object."
+ "Note: May be called by translated primitive code."
+
+ <returnTypeC: 'void *'>
+ ((self isIntegerObject: arrayOop) not and:
+ [self isWordsOrBytes: arrayOop])
+ ifTrue: [^ self cCode: '(void *)pointerForOop(arrayOop + BaseHeaderSize)'].
+ self primitiveFail.
+ !
Item was removed:
- ----- Method: Interpreter>>arrayValueOf: (in category 'utilities') -----
- arrayValueOf: arrayOop
- "Return the address of first indexable field of resulting array object, or fail if the instance variable does not contain an indexable bytes or words object."
- "Note: May be called by translated primitive code."
-
- <returnTypeC: 'void *'>
- ((self isIntegerObject: arrayOop) not and:
- [self isWordsOrBytes: arrayOop])
- ifTrue: [^ self cCode: '(void *)pointerForOop(arrayOop + BaseHeaderSize)'].
- self primitiveFail.
- !
Item was changed:
----- Method: Interpreter>>balancedStack:afterPrimitive:withArgs: (in category 'debug support') -----
balancedStack: delta afterPrimitive: primIdx withArgs: nArgs
"Return true if the stack is still balanced after executing primitive primIndex with nArgs args. Delta is 'stackPointer - activeContext' which is a relative measure for the stack pointer (so we don't have to relocate it during the primitive)"
(primIdx >= 81 and:[primIdx <= 88]) ifTrue:[^true].
"81-88 are control primitives after which the stack may look unbalanced"
successFlag ifTrue:[
"Successful prim, stack must have exactly nArgs arguments popped off"
^(stackPointer - activeContext + (nArgs * BytesPerWord)) = delta
].
"Failed prim must leave stack intact"
^(stackPointer - activeContext) = delta
!
Item was removed:
- ----- Method: Interpreter>>booleanValueOf: (in category 'utilities') -----
- booleanValueOf: obj
- "convert true and false (Smalltalk) to true or false(C)"
- obj = trueObj ifTrue: [ ^ true ].
- obj = falseObj ifTrue: [ ^ false ].
- successFlag := false.
- ^ nil!
Item was added:
+ ----- Method: Interpreter>>booleanValueOf: (in category 'utilities') -----
+ booleanValueOf: obj
+ "convert true and false (Smalltalk) to true or false(C)"
+ obj = trueObj ifTrue: [ ^ true ].
+ obj = falseObj ifTrue: [ ^ false ].
+ successFlag := false.
+ ^ nil!
Item was changed:
----- Method: Interpreter>>byteSwapByteObjects (in category 'image save/restore') -----
byteSwapByteObjects
"Byte-swap the words of all bytes objects in the image. This returns these objects to their original byte ordering after blindly byte-swapping the entire image."
self byteSwapByteObjectsFrom: self firstObject to: endOfMemory!
Item was changed:
----- Method: Interpreter>>byteSwapByteObjectsFrom:to: (in category 'image save/restore') -----
byteSwapByteObjectsFrom: startOop to: stopAddr
"Byte-swap the words of all bytes objects in a range of the
image, including Strings, ByteArrays, and CompiledMethods.
This returns these objects to their original byte ordering
after blindly byte-swapping the entire image. For compiled
methods, byte-swap only their bytecodes part."
| oop fmt wordAddr methodHeader |
oop := startOop.
[self oop: oop isLessThan: stopAddr]
whileTrue: [(self isFreeObject: oop)
ifFalse: [fmt := self formatOf: oop.
fmt >= 8
ifTrue: ["oop contains bytes"
wordAddr := oop + BaseHeaderSize.
fmt >= 12
ifTrue: ["compiled method; start after methodHeader and literals"
methodHeader := self longAt: oop + BaseHeaderSize.
wordAddr := wordAddr + BytesPerWord + ((methodHeader >> 10 bitAnd: 255) * BytesPerWord)].
self reverseBytesFrom: wordAddr to: oop + (self sizeBitsOf: oop)].
(fmt = 6 and: [BytesPerWord = 8])
ifTrue: ["Object contains 32-bit half-words packed into 64-bit machine words."
wordAddr := oop + BaseHeaderSize.
self reverseWordsFrom: wordAddr to: oop + (self sizeBitsOf: oop)]].
oop := self objectAfter: oop]!
Item was changed:
----- Method: Interpreter>>capturePendingFinalizationSignals (in category 'debug support') -----
capturePendingFinalizationSignals
statPendingFinalizationSignals := pendingFinalizationSignals.
!
Item was changed:
----- Method: Interpreter>>checkImageVersionFrom:startingAt: (in category 'image save/restore') -----
checkImageVersionFrom: f startingAt: imageOffset
"Read and verify the image file version number and return true if the the given image file needs to be byte-swapped. As a side effect, position the file stream just after the version number of the image header. This code prints a warning and does a hard-exit if it cannot find a valid version number."
"This code is based on C code by Ian Piumarta."
| version firstVersion |
<var: #f type: 'sqImageFile '>
<var: #imageOffset type: 'squeakFileOffsetType '>
"check the version number"
self sqImageFile: f Seek: imageOffset.
version := firstVersion := self getLongFromFile: f swap: false.
(self readableFormat: version) ifTrue: [^ false].
"try with bytes reversed"
self sqImageFile: f Seek: imageOffset.
version := self getLongFromFile: f swap: true.
(self readableFormat: version) ifTrue: [^ true].
"Note: The following is only meaningful if not reading an embedded image"
imageOffset = 0 ifTrue:[
"try skipping the first 512 bytes (prepended by certain Mac file transfer utilities)"
self sqImageFile: f Seek: 512.
version := self getLongFromFile: f swap: false.
(self readableFormat: version) ifTrue: [^ false].
"try skipping the first 512 bytes with bytes reversed"
self sqImageFile: f Seek: 512.
version := self getLongFromFile: f swap: true.
(self readableFormat: version) ifTrue: [^ true]].
"hard failure; abort"
self print: 'This interpreter (vers. '.
self printNum: self imageFormatVersion.
self print: ') cannot read image file (vers. '.
self printNum: firstVersion.
self print: ').'.
self cr.
self print: 'Press CR to quit...'.
self getchar.
self ioExit.
!
Item was removed:
- ----- Method: Interpreter>>checkedIntegerValueOf: (in category 'utilities') -----
- checkedIntegerValueOf: intOop
- "Note: May be called by translated primitive code."
-
- (self isIntegerObject: intOop)
- ifTrue: [ ^ self integerValueOf: intOop ]
- ifFalse: [ self primitiveFail. ^ 0 ]!
Item was added:
+ ----- Method: Interpreter>>checkedIntegerValueOf: (in category 'utilities') -----
+ checkedIntegerValueOf: intOop
+ "Note: May be called by translated primitive code."
+
+ (self isIntegerObject: intOop)
+ ifTrue: [ ^ self integerValueOf: intOop ]
+ ifFalse: [ self primitiveFail. ^ 0 ]!
Item was changed:
----- Method: Interpreter>>dumpImage: (in category 'image save/restore') -----
dumpImage: fileName
"Dump the entire image out to the given file. Intended for debugging only."
| f dataSize result |
<export: true>
<var: #f type: 'sqImageFile'>
f := self cCode: 'sqImageFileOpen(fileName, "wb")'.
f = nil ifTrue: [^-1].
dataSize := endOfMemory - self startOfMemory.
result := self cCode: 'sqImageFileWrite(pointerForOop(memory()), sizeof(unsigned char), dataSize, f)'.
self cCode: 'sqImageFileClose(f)'.
^result
!
Item was added:
+ ----- Method: Interpreter>>fetchInteger:ofObject: (in category 'utilities') -----
+ fetchInteger: fieldIndex ofObject: objectPointer
+ "Note: May be called by translated primitive code."
+
+ | intOop |
+ <inline: false>
+ intOop := self fetchPointer: fieldIndex ofObject: objectPointer.
+ ^self checkedIntegerValueOf: intOop!
Item was removed:
- ----- Method: Interpreter>>fetchInteger:ofObject: (in category 'utilities') -----
- fetchInteger: fieldIndex ofObject: objectPointer
- "Note: May be called by translated primitive code."
-
- | intOop |
- <inline: false>
- intOop := self fetchPointer: fieldIndex ofObject: objectPointer.
- ^self checkedIntegerValueOf: intOop!
Item was changed:
----- Method: Interpreter>>findClassOfMethod:forReceiver: (in category 'debug support') -----
findClassOfMethod: meth forReceiver: rcvr
| currClass classDict classDictSize methodArray i done |
currClass := self fetchClassOf: rcvr.
done := false.
[done] whileFalse: [
classDict := self fetchPointer: MethodDictionaryIndex ofObject: currClass.
classDictSize := self fetchWordLengthOf: classDict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i < (classDictSize - SelectorStart)] whileTrue: [
meth = (self fetchPointer: i ofObject: methodArray) ifTrue: [ ^currClass ].
i := i + 1.
].
currClass := self fetchPointer: SuperclassIndex ofObject: currClass.
done := currClass = nilObj.
].
^self fetchClassOf: rcvr "method not found in superclass chain"!
Item was changed:
----- Method: Interpreter>>findSelectorOfMethod:forReceiver: (in category 'debug support') -----
findSelectorOfMethod: meth forReceiver: rcvr
| currClass done classDict classDictSize methodArray i |
currClass := self fetchClassOf: rcvr.
done := false.
[done] whileFalse: [
classDict := self fetchPointer: MethodDictionaryIndex ofObject: currClass.
classDictSize := self fetchWordLengthOf: classDict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i <= (classDictSize - SelectorStart)] whileTrue: [
meth = (self fetchPointer: i ofObject: methodArray) ifTrue: [
^(self fetchPointer: i + SelectorStart ofObject: classDict)
].
i := i + 1.
].
currClass := self fetchPointer: SuperclassIndex ofObject: currClass.
done := currClass = nilObj.
].
^ nilObj "method not found in superclass chain"!
Item was changed:
----- Method: Interpreter>>getLongFromFile:swap: (in category 'image save/restore') -----
getLongFromFile: aFile swap: swapFlag
"Answer the next word read from aFile, byte-swapped according to the swapFlag."
| w |
<var: #aFile type: 'sqImageFile '>
w := 0.
self cCode: 'sqImageFileRead(&w, sizeof(w), 1, aFile)'.
swapFlag
ifTrue: [^ self byteSwapped: w]
ifFalse: [^ w].
!
Item was removed:
- ----- Method: Interpreter>>getThisSessionID (in category 'plugin support') -----
- getThisSessionID
- "return the global session ID value"
- <inline: false>
- ^globalSessionID!
Item was added:
+ ----- Method: Interpreter>>getThisSessionID (in category 'plugin support') -----
+ getThisSessionID
+ "return the global session ID value"
+ <inline: false>
+ ^globalSessionID!
Item was changed:
----- Method: Interpreter>>imageFormatCompatibilityVersion (in category 'image save/restore') -----
imageFormatCompatibilityVersion
"This VM is backward-compatible with the immediately preceeding non-closure version."
BytesPerWord == 4
ifTrue: [^6502]
ifFalse: [^68000]!
Item was changed:
----- Method: Interpreter>>imageFormatVersion (in category 'image save/restore') -----
imageFormatVersion
"Return a magic constant that changes when the image format changes. Since the image reading code uses this to detect byte ordering, one must avoid version numbers that are invariant under byte reversal."
BytesPerWord == 4
ifTrue: [^6504]
ifFalse: [^68002]!
Item was removed:
- ----- Method: Interpreter>>is:KindOf: (in category 'plugin primitive support') -----
- is: oop KindOf: className
- "Support for external primitives."
- | oopClass |
- <var: #className type:'char *'>
- oopClass := self fetchClassOf: oop.
- [oopClass == nilObj] whileFalse:[
- (self classNameOf: oopClass Is: className) ifTrue:[^true].
- oopClass := self superclassOf: oopClass].
- ^false!
Item was added:
+ ----- Method: Interpreter>>is:KindOf: (in category 'plugin primitive support') -----
+ is: oop KindOf: className
+ "Support for external primitives."
+ | oopClass |
+ <var: #className type:'char *'>
+ oopClass := self fetchClassOf: oop.
+ [oopClass == nilObj] whileFalse:[
+ (self classNameOf: oopClass Is: className) ifTrue:[^true].
+ oopClass := self superclassOf: oopClass].
+ ^false!
Item was removed:
- ----- Method: Interpreter>>mapInterpreterOops (in category 'object memory support') -----
- mapInterpreterOops
- "Map all oops in the interpreter's state to their new values
- during garbage collection or a become: operation."
- "Assume: All traced variables contain valid oops."
- | oop |
- compilerInitialized ifFalse:
- [stackPointer := stackPointer - activeContext. "*rel to active"
- activeContext := self remap: activeContext.
- stackPointer := stackPointer + activeContext. "*rel to active"
- theHomeContext := self remap: theHomeContext].
- instructionPointer := instructionPointer - method. "*rel to method"
- method := self remap: method.
- instructionPointer := instructionPointer + method. "*rel to method"
- receiver := self remap: receiver.
- messageSelector := self remap: messageSelector.
- newMethod := self remap: newMethod.
- lkupClass := self remap: lkupClass.
- receiverClass := self remap: receiverClass.
- profileProcess := self remap: profileProcess.
- profileMethod := self remap: profileMethod.
- profileSemaphore := self remap: profileSemaphore.
-
- "Callback support - trace suspended callback list"
- 1 to: jmpDepth do:[:i|
- oop := suspendedCallbacks at: i.
- (self isIntegerObject: oop)
- ifFalse:[suspendedCallbacks at: i put: (self remap: oop)].
- oop := suspendedMethods at: i.
- (self isIntegerObject: oop)
- ifFalse:[suspendedMethods at: i put: (self remap: oop)].
- ].
- !
Item was added:
+ ----- Method: Interpreter>>mapInterpreterOops (in category 'object memory support') -----
+ mapInterpreterOops
+ "Map all oops in the interpreter's state to their new values
+ during garbage collection or a become: operation."
+ "Assume: All traced variables contain valid oops."
+ | oop |
+ compilerInitialized ifFalse:
+ [stackPointer := stackPointer - activeContext. "*rel to active"
+ activeContext := self remap: activeContext.
+ stackPointer := stackPointer + activeContext. "*rel to active"
+ theHomeContext := self remap: theHomeContext].
+ instructionPointer := instructionPointer - method. "*rel to method"
+ method := self remap: method.
+ instructionPointer := instructionPointer + method. "*rel to method"
+ receiver := self remap: receiver.
+ messageSelector := self remap: messageSelector.
+ newMethod := self remap: newMethod.
+ lkupClass := self remap: lkupClass.
+ receiverClass := self remap: receiverClass.
+ profileProcess := self remap: profileProcess.
+ profileMethod := self remap: profileMethod.
+ profileSemaphore := self remap: profileSemaphore.
+
+ "Callback support - trace suspended callback list"
+ 1 to: jmpDepth do:[:i|
+ oop := suspendedCallbacks at: i.
+ (self isIntegerObject: oop)
+ ifFalse:[suspendedCallbacks at: i put: (self remap: oop)].
+ oop := suspendedMethods at: i.
+ (self isIntegerObject: oop)
+ ifFalse:[suspendedMethods at: i put: (self remap: oop)].
+ ].
+ !
Item was added:
+ ----- Method: Interpreter>>methodArgumentCount (in category 'plugin primitive support') -----
+ methodArgumentCount
+ ^argumentCount!
Item was removed:
- ----- Method: Interpreter>>methodArgumentCount (in category 'plugin primitive support') -----
- methodArgumentCount
- ^argumentCount!
Item was changed:
----- Method: Interpreter>>okayActiveProcessStack (in category 'debug support') -----
okayActiveProcessStack
| cntxt |
cntxt := activeContext.
[cntxt = nilObj] whileFalse: [
self okayFields: cntxt.
cntxt := (self fetchPointer: SenderIndex ofObject: cntxt).
].!
Item was changed:
----- Method: Interpreter>>okayFields: (in category 'debug support') -----
okayFields: oop
"Check if the argument is an ok object.
If this is a pointers object, check that its fields are all okay oops."
| i fieldOop |
(oop = nil or: [oop = 0]) ifTrue: [ ^true ].
(self isIntegerObject: oop) ifTrue: [ ^true ].
(self okayOop: oop) ifFalse: [ ^false ].
(self oopHasOkayClass: oop) ifFalse: [ ^false ].
((self isPointers: oop) or: [self isCompiledMethod: oop]) ifFalse: [ ^true ].
(self isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart - 1]
ifFalse:
[(self isContext: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
ifFalse: [i := (self lengthOf: oop) - 1]].
[i >= 0] whileTrue: [
fieldOop := self fetchPointer: i ofObject: oop.
(self isIntegerObject: fieldOop) ifFalse: [
(self okayOop: fieldOop) ifFalse: [ ^false ].
(self oopHasOkayClass: fieldOop) ifFalse: [ ^false ].
].
i := i - 1.
].
^true!
Item was changed:
----- Method: Interpreter>>okayInterpreterObjects (in category 'debug support') -----
okayInterpreterObjects
| oopOrZero oop |
self okayFields: nilObj.
self okayFields: falseObj.
self okayFields: trueObj.
self okayFields: specialObjectsOop.
self okayFields: activeContext.
self okayFields: method.
self okayFields: receiver.
self okayFields: theHomeContext.
self okayFields: messageSelector.
self okayFields: newMethod.
self okayFields: lkupClass.
0 to: MethodCacheEntries - 1 by: MethodCacheEntrySize do: [ :i |
oopOrZero := methodCache at: i + MethodCacheSelector.
oopOrZero = 0 ifFalse: [
self okayFields: (methodCache at: i + MethodCacheSelector).
self okayFields: (methodCache at: i + MethodCacheClass).
self okayFields: (methodCache at: i + MethodCacheMethod).
].
].
1 to: remapBufferCount do: [ :i |
oop := remapBuffer at: i.
(self isIntegerObject: oop) ifFalse: [
self okayFields: oop.
].
].
self okayActiveProcessStack.!
Item was changed:
----- Method: Interpreter>>oopHasOkayClass: (in category 'debug support') -----
oopHasOkayClass: signedOop
"Attempt to verify that the given oop has a reasonable behavior. The class must be a valid, non-integer oop and must not be nilObj. It must be a pointers object with three or more fields. Finally, the instance specification field of the behavior must match that of the instance."
| oop oopClass formatMask behaviorFormatBits oopFormatBits |
<var: #oop type: 'usqInt'>
<var: #oopClass type: 'usqInt'>
oop := self cCoerce: signedOop to: 'usqInt'.
self okayOop: oop.
oopClass := self cCoerce: (self fetchClassOf: oop) to: 'usqInt'.
(self isIntegerObject: oopClass)
ifTrue: [ self error: 'a SmallInteger is not a valid class or behavior'. ^false ].
(self okayOop: oopClass)
ifFalse: [ self error: 'class oop is not ok'. ^false ].
((self isPointers: oopClass) and: [(self lengthOf: oopClass) >= 3])
ifFalse: [ self error: 'a class (behavior) must be a pointers object of size >= 3'. ^false ].
(self isBytes: oop)
ifTrue: [ formatMask := 16rC00 ] "ignore extra bytes size bits"
ifFalse: [ formatMask := 16rF00 ].
behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
oopFormatBits := (self baseHeader: oop) bitAnd: formatMask.
behaviorFormatBits = oopFormatBits
ifFalse: [ self error: 'object and its class (behavior) formats differ'. ^false ].
^true!
Item was added:
+ ----- Method: Interpreter>>pop:thenPush: (in category 'contexts') -----
+ pop: nItems thenPush: oop
+
+ | sp |
+ self longAt: (sp := stackPointer - ((nItems - 1) * BytesPerWord)) put: oop.
+ stackPointer := sp.
+ !
Item was removed:
- ----- Method: Interpreter>>pop:thenPush: (in category 'contexts') -----
- pop: nItems thenPush: oop
-
- | sp |
- self longAt: (sp := stackPointer - ((nItems - 1) * BytesPerWord)) put: oop.
- stackPointer := sp.
- !
Item was removed:
- ----- Method: Interpreter>>positive32BitIntegerFor: (in category 'primitive support') -----
- positive32BitIntegerFor: integerValue
-
- | newLargeInteger |
- "Note - integerValue is interpreted as POSITIVE, eg, as the result of
- Bitmap>at:, or integer>bitAnd:."
- integerValue >= 0
- ifTrue: [(self isIntegerValue: integerValue)
- ifTrue: [^ self integerObjectOf: integerValue]].
-
- BytesPerWord = 4
- ifTrue: ["Faster instantiateSmallClass: currently only works with integral word size."
- newLargeInteger := self instantiateSmallClass: (self splObj: ClassLargePositiveInteger)
- sizeInBytes: BaseHeaderSize + 4]
- ifFalse: ["Cant use instantiateSmallClass: due to integral word requirement."
- newLargeInteger := self instantiateClass: (self splObj: ClassLargePositiveInteger)
- indexableSize: 4].
- self storeByte: 3 ofObject: newLargeInteger withValue: ((integerValue >> 24) bitAnd: 16rFF).
- self storeByte: 2 ofObject: newLargeInteger withValue: ((integerValue >> 16) bitAnd: 16rFF).
- self storeByte: 1 ofObject: newLargeInteger withValue: ((integerValue >> 8) bitAnd: 16rFF).
- self storeByte: 0 ofObject: newLargeInteger withValue: (integerValue bitAnd: 16rFF).
- ^ newLargeInteger!
Item was added:
+ ----- Method: Interpreter>>positive32BitIntegerFor: (in category 'primitive support') -----
+ positive32BitIntegerFor: integerValue
+
+ | newLargeInteger |
+ "Note - integerValue is interpreted as POSITIVE, eg, as the result of
+ Bitmap>at:, or integer>bitAnd:."
+ integerValue >= 0
+ ifTrue: [(self isIntegerValue: integerValue)
+ ifTrue: [^ self integerObjectOf: integerValue]].
+
+ BytesPerWord = 4
+ ifTrue: ["Faster instantiateSmallClass: currently only works with integral word size."
+ newLargeInteger := self instantiateSmallClass: (self splObj: ClassLargePositiveInteger)
+ sizeInBytes: BaseHeaderSize + 4]
+ ifFalse: ["Cant use instantiateSmallClass: due to integral word requirement."
+ newLargeInteger := self instantiateClass: (self splObj: ClassLargePositiveInteger)
+ indexableSize: 4].
+ self storeByte: 3 ofObject: newLargeInteger withValue: ((integerValue >> 24) bitAnd: 16rFF).
+ self storeByte: 2 ofObject: newLargeInteger withValue: ((integerValue >> 16) bitAnd: 16rFF).
+ self storeByte: 1 ofObject: newLargeInteger withValue: ((integerValue >> 8) bitAnd: 16rFF).
+ self storeByte: 0 ofObject: newLargeInteger withValue: (integerValue bitAnd: 16rFF).
+ ^ newLargeInteger!
Item was added:
+ ----- Method: Interpreter>>positive32BitValueOf: (in category 'primitive support') -----
+ positive32BitValueOf: oop
+ "Convert the given object into an integer value.
+ The object may be either a positive ST integer or a four-byte LargePositiveInteger."
+
+ | sz value |
+ (self isIntegerObject: oop) ifTrue: [
+ value := self integerValueOf: oop.
+ value < 0 ifTrue: [^ self primitiveFail].
+ ^ value].
+
+ self assertClassOf: oop is: (self splObj: ClassLargePositiveInteger).
+ successFlag ifTrue: [
+ sz := self lengthOf: oop.
+ sz = 4 ifFalse: [^ self primitiveFail]].
+ successFlag ifTrue: [
+ ^ (self fetchByte: 0 ofObject: oop) +
+ ((self fetchByte: 1 ofObject: oop) << 8) +
+ ((self fetchByte: 2 ofObject: oop) << 16) +
+ ((self fetchByte: 3 ofObject: oop) << 24) ].!
Item was removed:
- ----- Method: Interpreter>>positive32BitValueOf: (in category 'primitive support') -----
- positive32BitValueOf: oop
- "Convert the given object into an integer value.
- The object may be either a positive ST integer or a four-byte LargePositiveInteger."
-
- | sz value |
- (self isIntegerObject: oop) ifTrue: [
- value := self integerValueOf: oop.
- value < 0 ifTrue: [^ self primitiveFail].
- ^ value].
-
- self assertClassOf: oop is: (self splObj: ClassLargePositiveInteger).
- successFlag ifTrue: [
- sz := self lengthOf: oop.
- sz = 4 ifFalse: [^ self primitiveFail]].
- successFlag ifTrue: [
- ^ (self fetchByte: 0 ofObject: oop) +
- ((self fetchByte: 1 ofObject: oop) << 8) +
- ((self fetchByte: 2 ofObject: oop) << 16) +
- ((self fetchByte: 3 ofObject: oop) << 24) ].!
Item was removed:
- ----- Method: Interpreter>>positive64BitIntegerFor: (in category 'primitive support') -----
- positive64BitIntegerFor: integerValue
-
- | newLargeInteger value highWord sz |
- "Note - integerValue is interpreted as POSITIVE, eg, as the result of
- Bitmap>at:, or integer>bitAnd:."
- <var: 'integerValue' type: 'sqLong'>
-
- (self sizeof: integerValue) = 4 ifTrue: [^self positive32BitIntegerFor: integerValue].
-
-
- highWord := self cCode: '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 := self instantiateClass: (self splObj: ClassLargePositiveInteger) indexableSize: sz.
- 0 to: sz-1 do: [:i |
- value := self cCode: '(integerValue >> (i * 8)) & 255'.
- self storeByte: i ofObject: newLargeInteger withValue: value].
- ^ newLargeInteger
- !
Item was added:
+ ----- Method: Interpreter>>positive64BitIntegerFor: (in category 'primitive support') -----
+ positive64BitIntegerFor: integerValue
+
+ | newLargeInteger value highWord sz |
+ "Note - integerValue is interpreted as POSITIVE, eg, as the result of
+ Bitmap>at:, or integer>bitAnd:."
+ <var: 'integerValue' type: 'sqLong'>
+
+ (self sizeof: integerValue) = 4 ifTrue: [^self positive32BitIntegerFor: integerValue].
+
+
+ highWord := self cCode: '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 := self instantiateClass: (self splObj: ClassLargePositiveInteger) indexableSize: sz.
+ 0 to: sz-1 do: [:i |
+ value := self cCode: '(integerValue >> (i * 8)) & 255'.
+ self storeByte: i ofObject: newLargeInteger withValue: value].
+ ^ newLargeInteger
+ !
Item was removed:
- ----- Method: Interpreter>>postGCAction: (in category 'object memory support') -----
- postGCAction: gcModeArg
- "Mark the active and home contexts as roots if old. This
- allows the interpreter to use storePointerUnchecked to
- store into them."
-
- compilerInitialized
- ifTrue: [self compilerPostGC]
- ifFalse: [(self oop: activeContext isLessThan: youngStart)
- ifTrue: [self beRootIfOld: activeContext].
- (self oop: theHomeContext isLessThan: youngStart)
- ifTrue: [self beRootIfOld: theHomeContext]].
- (self sizeOfFree: freeBlock) > shrinkThreshold
- ifTrue: ["Attempt to shrink memory after successfully
- reclaiming lots of memory"
- self shrinkObjectMemory: (self sizeOfFree: freeBlock) - growHeadroom].
-
- self signalSemaphoreWithIndex: gcSemaphoreIndex.
- !
Item was added:
+ ----- Method: Interpreter>>postGCAction: (in category 'object memory support') -----
+ postGCAction: gcModeArg
+ "Mark the active and home contexts as roots if old. This
+ allows the interpreter to use storePointerUnchecked to
+ store into them."
+
+ compilerInitialized
+ ifTrue: [self compilerPostGC]
+ ifFalse: [(self oop: activeContext isLessThan: youngStart)
+ ifTrue: [self beRootIfOld: activeContext].
+ (self oop: theHomeContext isLessThan: youngStart)
+ ifTrue: [self beRootIfOld: theHomeContext]].
+ (self sizeOfFree: freeBlock) > shrinkThreshold
+ ifTrue: ["Attempt to shrink memory after successfully
+ reclaiming lots of memory"
+ self shrinkObjectMemory: (self sizeOfFree: freeBlock) - growHeadroom].
+
+ self signalSemaphoreWithIndex: gcSemaphoreIndex.
+ !
Item was added:
+ ----- Method: Interpreter>>preGCAction: (in category 'object memory support') -----
+ preGCAction: gcMode
+
+ compilerInitialized
+ ifTrue: [self compilerPreGC: gcMode = GCModeFull]
+ ifFalse: [self storeContextRegisters: activeContext].!
Item was removed:
- ----- Method: Interpreter>>preGCAction: (in category 'object memory support') -----
- preGCAction: gcMode
-
- compilerInitialized
- ifTrue: [self compilerPreGC: gcMode = GCModeFull]
- ifFalse: [self storeContextRegisters: activeContext].!
Item was changed:
----- Method: Interpreter>>primitiveFloatGreaterOrEqual (in category 'float primitives') -----
primitiveFloatGreaterOrEqual
| aBool |
aBool := self primitiveFloatGreaterOrEqual: (self stackValue: 1) toArg: self stackTop.
successFlag ifTrue: [self pop: 2. self pushBool: aBool].!
Item was changed:
----- Method: Interpreter>>primitiveFloatGreaterOrEqual:toArg: (in category 'float primitives') -----
primitiveFloatGreaterOrEqual: rcvrOop toArg: argOop
| rcvr arg |
<var: #rcvr type: #double>
<var: #arg type: #double>
rcvr := self loadFloatOrIntFrom: rcvrOop.
arg := self loadFloatOrIntFrom: argOop.
successFlag ifTrue: [^ rcvr >= arg].!
Item was changed:
----- Method: Interpreter>>primitiveFloatLessOrEqual (in category 'float primitives') -----
primitiveFloatLessOrEqual
| aBool |
aBool := self primitiveFloatLessOrEqual: (self stackValue: 1) toArg: self stackTop.
successFlag ifTrue: [self pop: 2. self pushBool: aBool].!
Item was changed:
----- Method: Interpreter>>primitiveFloatLessOrEqual:toArg: (in category 'float primitives') -----
primitiveFloatLessOrEqual: rcvrOop toArg: argOop
| rcvr arg |
<var: #rcvr type: #double>
<var: #arg type: #double>
rcvr := self loadFloatOrIntFrom: rcvrOop.
arg := self loadFloatOrIntFrom: argOop.
successFlag ifTrue: [^ rcvr <= arg].
!
Item was added:
+ ----- Method: Interpreter>>printChar: (in category 'debug printing') -----
+ printChar: aByte
+ "For testing in Smalltalk, this method should be overridden in a subclass."
+
+ self putchar: aByte.!
Item was removed:
- ----- Method: Interpreter>>printChar: (in category 'debug printing') -----
- printChar: aByte
- "For testing in Smalltalk, this method should be overridden in a subclass."
-
- self putchar: aByte.!
Item was added:
+ ----- Method: Interpreter>>printOop: (in category 'debug printing') -----
+ printOop: oop
+
+ | fmt lastIndex |
+ <inline: false>
+ self printNum: oop.
+ (self isIntegerObject: oop) ifTrue:
+ [^self cCode: 'printf("=%ld\n", (long)integerValueOf(oop))' inSmalltalk: [self shortPrint: oop]].
+ self print: ': a(n) '.
+ self printNameOfClass: (self fetchClassOf: oop) count: 5.
+ self cr.
+ fmt := self formatOf: oop.
+ (fmt > 4 and: [fmt < 12]) ifTrue:
+ [^self printStringOf: oop].
+ lastIndex := 64 min: ((self lastPointerOf: oop) / BytesPerWord).
+ lastIndex > 0 ifTrue:
+ [1 to: lastIndex do:
+ [:index|
+ self cCode: 'printf(" %ld", fetchPointerofObject(index - 1, oop))'
+ inSmalltalk: [self space; print: (self fetchPointer: index - 1 ofObject: oop) printString; space.
+ self print: (self shortPrint: (self fetchPointer: index - 1 ofObject: oop))].
+ (index \\ 8) = 0 ifTrue:
+ [self cr]].
+ (lastIndex \\ 8) = 0 ifFalse:
+ [self cr]]!
Item was removed:
- ----- Method: Interpreter>>printOop: (in category 'debug printing') -----
- printOop: oop
-
- | fmt lastIndex |
- <inline: false>
- self printNum: oop.
- (self isIntegerObject: oop) ifTrue:
- [^self cCode: 'printf("=%ld\n", (long)integerValueOf(oop))' inSmalltalk: [self shortPrint: oop]].
- self print: ': a(n) '.
- self printNameOfClass: (self fetchClassOf: oop) count: 5.
- self cr.
- fmt := self formatOf: oop.
- (fmt > 4 and: [fmt < 12]) ifTrue:
- [^self printStringOf: oop].
- lastIndex := 64 min: ((self lastPointerOf: oop) / BytesPerWord).
- lastIndex > 0 ifTrue:
- [1 to: lastIndex do:
- [:index|
- self cCode: 'printf(" %ld", fetchPointerofObject(index - 1, oop))'
- inSmalltalk: [self space; print: (self fetchPointer: index - 1 ofObject: oop) printString; space.
- self print: (self shortPrint: (self fetchPointer: index - 1 ofObject: oop))].
- (index \\ 8) = 0 ifTrue:
- [self cr]].
- (lastIndex \\ 8) = 0 ifFalse:
- [self cr]]!
Item was removed:
- ----- Method: Interpreter>>pushFloat: (in category 'stack bytecodes') -----
- pushFloat: f
-
- <var: #f type: 'double '>
- self push: (self floatObjectOf: f).!
Item was added:
+ ----- Method: Interpreter>>pushFloat: (in category 'stack bytecodes') -----
+ pushFloat: f
+
+ <var: #f type: 'double '>
+ self push: (self floatObjectOf: f).!
Item was added:
+ ----- Method: Interpreter>>pushInteger: (in category 'contexts') -----
+ pushInteger: integerValue
+ self push: (self integerObjectOf: integerValue).
+ ^nil!
Item was removed:
- ----- Method: Interpreter>>pushInteger: (in category 'contexts') -----
- pushInteger: integerValue
- self push: (self integerObjectOf: integerValue).
- ^nil!
Item was added:
+ ----- Method: Interpreter>>putLong:toFile: (in category 'image save/restore') -----
+ putLong: aWord toFile: aFile
+ "Append aWord to aFile in this platforms 'natural' byte order. (Bytes will be swapped, if
+ necessary, when the image is read on a different platform.) Set successFlag to false if
+ the write fails."
+
+ | objectsWritten |
+ <var: #aFile type: 'sqImageFile '>
+
+ objectsWritten := self cCode: 'sqImageFileWrite(&aWord, sizeof(aWord), 1, aFile)'.
+ self success: objectsWritten = 1.
+ !
Item was removed:
- ----- Method: Interpreter>>putLong:toFile: (in category 'image save/restore') -----
- putLong: aWord toFile: aFile
- "Append aWord to aFile in this platforms 'natural' byte order. (Bytes will be swapped, if
- necessary, when the image is read on a different platform.) Set successFlag to false if
- the write fails."
-
- | objectsWritten |
- <var: #aFile type: 'sqImageFile '>
-
- objectsWritten := self cCode: 'sqImageFileWrite(&aWord, sizeof(aWord), 1, aFile)'.
- self success: objectsWritten = 1.
- !
Item was changed:
----- Method: Interpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize |
<var: #f type: 'sqImageFile '>
<var: #desiredHeapSize type: 'usqInt'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #dataSize type: 'size_t '>
<var: #imageOffset type: 'squeakFileOffsetType '>
metaclassSizeBits := 6 * BytesPerWord. "guess (Metaclass instSize * BPW)"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
specialObjectsOop := self getLongFromFile: f swap: swapBytes.
lastHash := self getLongFromFile: f swap: swapBytes.
savedWindowSize := self getLongFromFile: f swap: swapBytes.
fullScreenFlag := self getLongFromFile: f swap: swapBytes.
extraVMMemory := self getLongFromFile: f swap: swapBytes.
lastHash = 0 ifTrue: [
"lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
lastHash := 999].
"decrease Squeak object heap to leave extra memory for the VM"
heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
"compare memory requirements with availability".
minimumMemory := dataSize + 100000. "need at least 100K of breathing room"
heapSize < minimumMemory ifTrue: [
self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap"
memory := self cCode: 'sqAllocateMemory(minimumMemory, heapSize)'.
memory = nil ifTrue: [self insufficientMemoryAvailableError].
memStart := self startOfMemory.
self setMemoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety"
self setEndOfMemory: memStart + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
bytesRead := self cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
swapBytes ifTrue: [self reverseBytesInImage].
"compute difference between old and new memory base addresses"
bytesToShift := memStart - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
^ dataSize
!
Item was changed:
----- Method: Interpreter>>readableFormat: (in category 'image save/restore') -----
readableFormat: imageVersion
"Anwer true if images of the given format are readable by this interpreter. Allows a virtual machine to accept selected older image formats."
^ imageVersion = self imageFormatVersion
or: [imageVersion = self imageFormatCompatibilityVersion]
"
Example of multiple formats:
^ (imageVersion = self imageFormatVersion) or: [imageVersion = 6504]
"!
Item was changed:
----- Method: Interpreter>>reverseBytesInImage (in category 'image save/restore') -----
reverseBytesInImage
"Byte-swap all words in memory after reading in the entire image file with bulk read. Contributed by Tim Rowledge."
"First, byte-swap every word in the image. This fixes objects headers."
self reverseBytesFrom: self startOfMemory to: endOfMemory.
"Second, return the bytes of bytes-type objects to their orginal order."
self byteSwapByteObjects.!
Item was removed:
- ----- Method: Interpreter>>showDisplayBits:Left:Top:Right:Bottom: (in category 'I/O primitive support') -----
- showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
- "Repaint the portion of the Smalltalk screen bounded by the affected rectangle. Used to synchronize the screen after a Bitblt to the Smalltalk Display object."
- deferDisplayUpdates ifTrue: [^ nil].
- self displayBitsOf: aForm Left: l Top: t Right: r Bottom: b!
Item was added:
+ ----- Method: Interpreter>>showDisplayBits:Left:Top:Right:Bottom: (in category 'I/O primitive support') -----
+ showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
+ "Repaint the portion of the Smalltalk screen bounded by the affected rectangle. Used to synchronize the screen after a Bitblt to the Smalltalk Display object."
+ deferDisplayUpdates ifTrue: [^ nil].
+ self displayBitsOf: aForm Left: l Top: t Right: r Bottom: b!
Item was added:
+ ----- Method: Interpreter>>signalFinalization: (in category 'process primitive support') -----
+ signalFinalization: weakReferenceOop
+ "If it is not there already, record the given semaphore index in the list of semaphores to be signaled at the next convenient moment. Force a real interrupt check as soon as possible."
+
+ self forceInterruptCheck.
+ pendingFinalizationSignals := pendingFinalizationSignals + 1.!
Item was removed:
- ----- Method: Interpreter>>signalFinalization: (in category 'process primitive support') -----
- signalFinalization: weakReferenceOop
- "If it is not there already, record the given semaphore index in the list of semaphores to be signaled at the next convenient moment. Force a real interrupt check as soon as possible."
-
- self forceInterruptCheck.
- pendingFinalizationSignals := pendingFinalizationSignals + 1.!
Item was removed:
- ----- Method: Interpreter>>signed32BitIntegerFor: (in category 'primitive support') -----
- signed32BitIntegerFor: integerValue
- "Return a full 32 bit integer object for the given integer value"
- | newLargeInteger value largeClass |
- <inline: false>
- (self isIntegerValue: integerValue)
- ifTrue: [^ self integerObjectOf: integerValue].
- integerValue < 0
- ifTrue:[ largeClass := self classLargeNegativeInteger.
- value := 0 - integerValue]
- ifFalse:[ largeClass := self classLargePositiveInteger.
- value := integerValue].
- newLargeInteger := self instantiateClass: largeClass indexableSize: 4.
- self storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF).
- self storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF).
- self storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF).
- self storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF).
- ^ newLargeInteger!
Item was added:
+ ----- Method: Interpreter>>signed32BitIntegerFor: (in category 'primitive support') -----
+ signed32BitIntegerFor: integerValue
+ "Return a full 32 bit integer object for the given integer value"
+ | newLargeInteger value largeClass |
+ <inline: false>
+ (self isIntegerValue: integerValue)
+ ifTrue: [^ self integerObjectOf: integerValue].
+ integerValue < 0
+ ifTrue:[ largeClass := self classLargeNegativeInteger.
+ value := 0 - integerValue]
+ ifFalse:[ largeClass := self classLargePositiveInteger.
+ value := integerValue].
+ newLargeInteger := self instantiateClass: largeClass indexableSize: 4.
+ self storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF).
+ self storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF).
+ self storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF).
+ self storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF).
+ ^ newLargeInteger!
Item was added:
+ ----- Method: Interpreter>>signed32BitValueOf: (in category 'primitive support') -----
+ signed32BitValueOf: oop
+ "Convert the given object into an integer value.
+ The object may be either a positive ST integer or a four-byte LargeInteger."
+ | sz value largeClass negative |
+ <inline: false>
+ <returnTypeC: #int>
+ <var: #value type: #int>
+ (self isIntegerObject: oop) ifTrue: [^self integerValueOf: oop].
+ largeClass := self fetchClassOf: oop.
+ largeClass = self classLargePositiveInteger
+ ifTrue:[negative := false]
+ ifFalse:[largeClass = self classLargeNegativeInteger
+ ifTrue:[negative := true]
+ ifFalse:[^self primitiveFail]].
+ sz := self lengthOf: oop.
+ sz = 4 ifFalse: [^ self primitiveFail].
+ value := (self fetchByte: 0 ofObject: oop) +
+ ((self fetchByte: 1 ofObject: oop) << 8) +
+ ((self fetchByte: 2 ofObject: oop) << 16) +
+ ((self fetchByte: 3 ofObject: oop) << 24).
+ self cCode: []
+ inSmalltalk:
+ [(value anyMask: 16r80000000) ifTrue:
+ [value := value - 16r100000000]].
+ "Filter out values out of range for the signed interpretation such as
+ 16rFFFFFFFF (positive w/ bit 32 set) and -16rFFFFFFFF (negative w/ bit
+ 32 set). Since the sign is implicit in the class we require that the high
+ bit of the magnitude is not set which is a simple test here. Note that
+ we have to handle the most negative 32-bit value -2147483648 specially."
+ value < 0 ifTrue:
+ [self assert: (self sizeof: value) == 4.
+ "Don't fail for -16r80000000/-2147483648
+ Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
+ overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
+ (negative and: [0 = (self cCode: [value << 1]
+ inSmalltalk: [value << 1 bitAnd: (1 << 32) - 1])]) ifTrue:
+ [^value].
+ ^self primitiveFail].
+ ^negative
+ ifTrue: [0 - value]
+ ifFalse: [value]!
Item was removed:
- ----- Method: Interpreter>>signed32BitValueOf: (in category 'primitive support') -----
- signed32BitValueOf: oop
- "Convert the given object into an integer value.
- The object may be either a positive ST integer or a four-byte LargeInteger."
- | sz value largeClass negative |
- <inline: false>
- <returnTypeC: #int>
- <var: #value type: #int>
- (self isIntegerObject: oop) ifTrue: [^self integerValueOf: oop].
- largeClass := self fetchClassOf: oop.
- largeClass = self classLargePositiveInteger
- ifTrue:[negative := false]
- ifFalse:[largeClass = self classLargeNegativeInteger
- ifTrue:[negative := true]
- ifFalse:[^self primitiveFail]].
- sz := self lengthOf: oop.
- sz = 4 ifFalse: [^ self primitiveFail].
- value := (self fetchByte: 0 ofObject: oop) +
- ((self fetchByte: 1 ofObject: oop) << 8) +
- ((self fetchByte: 2 ofObject: oop) << 16) +
- ((self fetchByte: 3 ofObject: oop) << 24).
- self cCode: []
- inSmalltalk:
- [(value anyMask: 16r80000000) ifTrue:
- [value := value - 16r100000000]].
- "Filter out values out of range for the signed interpretation such as
- 16rFFFFFFFF (positive w/ bit 32 set) and -16rFFFFFFFF (negative w/ bit
- 32 set). Since the sign is implicit in the class we require that the high
- bit of the magnitude is not set which is a simple test here. Note that
- we have to handle the most negative 32-bit value -2147483648 specially."
- value < 0 ifTrue:
- [self assert: (self sizeof: value) == 4.
- "Don't fail for -16r80000000/-2147483648
- Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
- overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
- (negative and: [0 = (self cCode: [value << 1]
- inSmalltalk: [value << 1 bitAnd: (1 << 32) - 1])]) ifTrue:
- [^value].
- ^self primitiveFail].
- ^negative
- ifTrue: [0 - value]
- ifFalse: [value]!
Item was changed:
----- Method: Interpreter>>snapshot: (in category 'image save/restore') -----
snapshot: embedded
"update state of active context"
| activeProc dataSize rcvr setMacType |
<var: #setMacType type: 'void *'>
compilerInitialized
ifTrue: [self compilerPreSnapshot]
ifFalse: [self storeContextRegisters: activeContext].
"update state of active process"
activeProc := self fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer.
self
storePointer: SuspendedContextIndex
ofObject: activeProc
withValue: activeContext.
"compact memory and compute the size of the memory actually in use"
self incrementalGC.
"maximimize space for forwarding table"
self fullGC.
self snapshotCleanUp.
dataSize := freeBlock - self startOfMemory. "Assume all objects are below the start of the free block"
successFlag
ifTrue: [rcvr := self popStack.
"pop rcvr"
self push: trueObj.
self writeImageFile: dataSize.
embedded
ifFalse: ["set Mac file type and creator; this is a noop on other platforms"
setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'.
setMacType = 0
ifFalse: [self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']].
self pop: 1].
"activeContext was unmarked in #snapshotCleanUp, mark it old "
self beRootIfOld: activeContext.
successFlag
ifTrue: [self push: falseObj]
ifFalse: [self push: rcvr].
compilerInitialized
ifTrue: [self compilerPostSnapshot]!
Item was changed:
----- Method: Interpreter>>snapshotCleanUp (in category 'image save/restore') -----
snapshotCleanUp
"Clean up right before saving an image, sweeping memory and:
* nilling out all fields of contexts above the stack pointer.
* flushing external primitives
* clearing the root bit of any object in the root table "
| oop header fmt sz |
oop := self firstObject.
[self oop: oop isLessThan: endOfMemory]
whileTrue: [(self isFreeObject: oop)
ifFalse: [header := self longAt: oop.
fmt := header >> 8 bitAnd: 15.
"Clean out context"
(fmt = 3 and: [self isContextHeader: header])
ifTrue: [sz := self sizeBitsOf: oop.
(self lastPointerOf: oop) + BytesPerWord
to: sz - BaseHeaderSize by: BytesPerWord
do: [:i | self longAt: oop + i put: nilObj]].
"Clean out external functions"
fmt >= 12
ifTrue: ["This is a compiled method"
(self primitiveIndexOf: oop) = PrimitiveExternalCallIndex
ifTrue: ["It's primitiveExternalCall"
self flushExternalPrimitiveOf: oop]]].
oop := self objectAfter: oop].
self clearRootsTable!
Item was removed:
- ----- Method: Interpreter>>stObject:at: (in category 'array primitive support') -----
- stObject: array at: index
- "Return what ST would return for <obj> at: index."
-
- | hdr fmt totalLength fixedFields stSize |
- <inline: false>
- hdr := self baseHeader: array.
- fmt := (hdr >> 8) bitAnd: 16rF.
- totalLength := self lengthOf: array baseHeader: hdr format: fmt.
- fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
- (fmt = 3 and: [self isContextHeader: hdr])
- ifTrue: [stSize := self fetchStackPointerOf: array]
- ifFalse: [stSize := totalLength - fixedFields].
- ((self oop: index isGreaterThanOrEqualTo: 1)
- and: [self oop: index isLessThanOrEqualTo: stSize])
- ifTrue: [^ self subscript: array with: (index + fixedFields) format: fmt]
- ifFalse: [successFlag := false. ^ 0].!
Item was added:
+ ----- Method: Interpreter>>stObject:at: (in category 'array primitive support') -----
+ stObject: array at: index
+ "Return what ST would return for <obj> at: index."
+
+ | hdr fmt totalLength fixedFields stSize |
+ <inline: false>
+ hdr := self baseHeader: array.
+ fmt := (hdr >> 8) bitAnd: 16rF.
+ totalLength := self lengthOf: array baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
+ (fmt = 3 and: [self isContextHeader: hdr])
+ ifTrue: [stSize := self fetchStackPointerOf: array]
+ ifFalse: [stSize := totalLength - fixedFields].
+ ((self oop: index isGreaterThanOrEqualTo: 1)
+ and: [self oop: index isLessThanOrEqualTo: stSize])
+ ifTrue: [^ self subscript: array with: (index + fixedFields) format: fmt]
+ ifFalse: [successFlag := false. ^ 0].!
Item was removed:
- ----- Method: Interpreter>>stObject:at:put: (in category 'array primitive support') -----
- stObject: array at: index put: value
- "Do what ST would return for <obj> at: index put: value."
- | hdr fmt totalLength fixedFields stSize |
- <inline: false>
- hdr := self baseHeader: array.
- fmt := (hdr >> 8) bitAnd: 16rF.
- totalLength := self lengthOf: array baseHeader: hdr format: fmt.
- fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
- (fmt = 3 and: [self isContextHeader: hdr])
- ifTrue: [stSize := self fetchStackPointerOf: array]
- ifFalse: [stSize := totalLength - fixedFields].
- ((self oop: index isGreaterThanOrEqualTo: 1)
- and: [self oop: index isLessThanOrEqualTo: stSize])
- ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
- ifFalse: [successFlag := false].
- ^value!
Item was added:
+ ----- Method: Interpreter>>stObject:at:put: (in category 'array primitive support') -----
+ stObject: array at: index put: value
+ "Do what ST would return for <obj> at: index put: value."
+ | hdr fmt totalLength fixedFields stSize |
+ <inline: false>
+ hdr := self baseHeader: array.
+ fmt := (hdr >> 8) bitAnd: 16rF.
+ totalLength := self lengthOf: array baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
+ (fmt = 3 and: [self isContextHeader: hdr])
+ ifTrue: [stSize := self fetchStackPointerOf: array]
+ ifFalse: [stSize := totalLength - fixedFields].
+ ((self oop: index isGreaterThanOrEqualTo: 1)
+ and: [self oop: index isLessThanOrEqualTo: stSize])
+ ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
+ ifFalse: [successFlag := false].
+ ^value!
Item was removed:
- ----- Method: Interpreter>>stackIntegerValue: (in category 'contexts') -----
- stackIntegerValue: offset
- | integerPointer |
- integerPointer := self longAt: stackPointer - (offset*BytesPerWord).
- ^self checkedIntegerValueOf: integerPointer!
Item was added:
+ ----- Method: Interpreter>>stackIntegerValue: (in category 'contexts') -----
+ stackIntegerValue: offset
+ | integerPointer |
+ integerPointer := self longAt: stackPointer - (offset*BytesPerWord).
+ ^self checkedIntegerValueOf: integerPointer!
Item was removed:
- ----- Method: Interpreter>>stackValue: (in category 'contexts') -----
- stackValue: offset
- ^ self longAt: stackPointer - (offset*BytesPerWord)!
Item was added:
+ ----- Method: Interpreter>>stackValue: (in category 'contexts') -----
+ stackValue: offset
+ ^ self longAt: stackPointer - (offset*BytesPerWord)!
Item was changed:
----- Method: Interpreter>>symbolicMethod: (in category 'debug support') -----
symbolicMethod: aMethod
<doNotGenerate>
| ts prim |
(ts := self transcript) ensureCr.
(prim := self primitiveIndexOf: aMethod) > 0 ifTrue:
[ts nextPutAll: '<primitive: '; print: prim; nextPut: $>.
(self isQuickPrimitiveIndex: prim) ifTrue:
[ts nextPutAll: ' quick method'; cr; flush.
^self].
ts cr].
(InstructionPrinter
on: (VMCompiledMethodProxy new
for: method
coInterpreter: self
objectMemory: self))
indent: 0;
printInstructionsOn: ts.
ts flush!
Item was changed:
----- Method: Interpreter>>wordSwapped: (in category 'image save/restore') -----
wordSwapped: w
"Return the given 64-bit integer with its halves in the reverse order."
BytesPerWord = 8 ifFalse: [self error: 'This cannot happen.'].
^ ((w bitShift: Byte4ShiftNegated) bitAnd: Bytes3to0Mask)
+ ((w bitShift: Byte4Shift ) bitAnd: Bytes7to4Mask)
!
Item was changed:
----- Method: Interpreter>>writeImageFile: (in category 'image save/restore') -----
writeImageFile: imageBytes
| fn |
<var: #fn type: 'void *'>
self writeImageFileIO: imageBytes.
"set Mac file type and creator; this is a noop on other platforms"
fn := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'.
fn = 0 ifFalse:[
self cCode:'((sqInt (*)(char*, char*, char*))fn)(imageName, "STim", "FAST")'.
].
!
Item was changed:
----- Method: Interpreter>>writeImageFileIO: (in category 'image save/restore') -----
writeImageFileIO: imageBytes
| headerStart headerSize f bytesWritten sCWIfn okToWrite |
<var: #f type: 'sqImageFile'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #sCWIfn type: 'void *'>
"If the security plugin can be loaded, use it to check for write permission.
If not, assume it's ok"
sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
sCWIfn ~= 0 ifTrue:[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
okToWrite ifFalse:[^self primitiveFail]].
"local constants"
headerStart := 0.
headerSize := 64. "header size in bytes; do not change!!"
f := self cCode: 'sqImageFileOpen(imageName, "wb")'.
f = nil ifTrue: [
"could not open the image file for writing"
self success: false.
^ nil].
headerStart := self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+imageBytes)'.
self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
"position file to start of header"
self sqImageFile: f Seek: headerStart.
self putLong: (self imageFormatVersion) toFile: f.
self putLong: headerSize toFile: f.
self putLong: imageBytes toFile: f.
self putLong: (self startOfMemory) toFile: f.
self putLong: specialObjectsOop toFile: f.
self putLong: lastHash toFile: f.
self putLong: (self ioScreenSize) toFile: f.
self putLong: fullScreenFlag toFile: f.
self putLong: extraVMMemory toFile: f.
1 to: 7 do: [:i | self putLong: 0 toFile: f]. "fill remaining header words with zeros"
successFlag ifFalse: [
"file write or seek failure"
self cCode: 'sqImageFileClose(f)'.
^ nil].
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"write the image data"
bytesWritten := self cCode: 'sqImageFileWrite(pointerForOop(memory), sizeof(unsigned char), imageBytes, f)'.
self success: bytesWritten = imageBytes.
self cCode: 'sqImageFileClose(f)'.
!
Item was added:
+ ----- Method: InterpreterPrimitives>>positive32BitValueOf: (in category 'primitive support') -----
+ positive32BitValueOf: oop
+ "Convert the given object into an integer value.
+ The object may be either a positive SmallInteger or a four-byte LargePositiveInteger."
+
+ | value ok |
+ (objectMemory isIntegerObject: oop)
+ ifTrue:
+ [value := objectMemory integerValueOf: oop.
+ value < 0 ifTrue: [self primitiveFail. value := 0].
+ ^value]
+ ifFalse:
+ [(objectMemory hasSpurMemoryManagerAPI
+ and: [objectMemory isImmediate: oop]) ifTrue:
+ [self primitiveFail.
+ ^0]].
+
+ ok := objectMemory isClassOfNonImm: oop
+ equalTo: (objectMemory splObj: ClassLargePositiveInteger)
+ compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ (ok and: [(objectMemory lengthOf: oop) = 4]) ifFalse:
+ [self primitiveFail.
+ ^0].
+ ^(objectMemory fetchByte: 0 ofObject: oop)
+ + ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ + ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ + ((objectMemory fetchByte: 3 ofObject: oop) << 24)!
Item was removed:
- ----- Method: InterpreterPrimitives>>positive32BitValueOf: (in category 'primitive support') -----
- positive32BitValueOf: oop
- "Convert the given object into an integer value.
- The object may be either a positive SmallInteger or a four-byte LargePositiveInteger."
-
- | value ok |
- (objectMemory isIntegerObject: oop)
- ifTrue:
- [value := objectMemory integerValueOf: oop.
- value < 0 ifTrue: [self primitiveFail. value := 0].
- ^value]
- ifFalse:
- [(objectMemory hasSpurMemoryManagerAPI
- and: [objectMemory isImmediate: oop]) ifTrue:
- [self primitiveFail.
- ^0]].
-
- ok := objectMemory isClassOfNonImm: oop
- equalTo: (objectMemory splObj: ClassLargePositiveInteger)
- compactClassIndex: ClassLargePositiveIntegerCompactIndex.
- (ok and: [(objectMemory lengthOf: oop) = 4]) ifFalse:
- [self primitiveFail.
- ^0].
- ^(objectMemory fetchByte: 0 ofObject: oop)
- + ((objectMemory fetchByte: 1 ofObject: oop) << 8)
- + ((objectMemory fetchByte: 2 ofObject: oop) << 16)
- + ((objectMemory fetchByte: 3 ofObject: oop) << 24)!
Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveAllInstances (in category 'object access primitives') -----
+ primitiveAllInstances
+ "Answer an array of all instances of the receiver that exist
+ when the primitive is called, excluding any that may be
+ garbage collected as a side effect of allocating the result array."
+
+ <export: true>
+ | result |
+ result := objectMemory allInstancesOf: self stackTop.
+ (objectMemory isIntegerObject: result) ifTrue:
+ [objectMemory growToAccomodateContainerWithNumSlots: (objectMemory integerValueOf: result).
+ result := objectMemory allInstancesOf: self stackTop.
+ (objectMemory isIntegerObject: result) ifTrue:
+ [^self primitiveFailFor: PrimErrNoMemory]].
+ self pop: argumentCount+1 thenPush: result!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveAllObjects (in category 'object access primitives') -----
primitiveAllObjects
"Answer an array of all objects that exist when the primitive
is called, excluding those that may be garbage collected as
a side effect of allocating the result array."
<export: true>
| result |
result := objectMemory allObjects.
+ (objectMemory isIntegerObject: result) ifTrue:
+ [objectMemory growToAccomodateContainerWithNumSlots: (objectMemory integerValueOf: result).
+ result := objectMemory allObjects.
+ (objectMemory isIntegerObject: result) ifTrue:
+ [^self primitiveFailFor: PrimErrNoMemory]].
- result = 0 ifTrue:
- [^self primitiveFailFor: PrimErrNoMemory].
self pop: argumentCount+1 thenPush: result!
Item was removed:
- ----- Method: InterpreterPrimitives>>primitiveFailureCode (in category 'primitive support') -----
- primitiveFailureCode
- <api>
- ^primFailCode!
Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveFailureCode (in category 'primitive support') -----
+ primitiveFailureCode
+ <api>
+ ^primFailCode!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveLocalMicrosecondClock (in category 'system control primitives') -----
primitiveLocalMicrosecondClock
"Return the value of the microsecond clock as an integer. The microsecond clock is at
least 60 bits wide which means it'll get to around August 38435 before it wraps around."
+ self pop: 1 thenPush: (self positive64BitIntegerFor: self ioLocalMicrosecondsNow)!
- self pop: 1 thenPush: (self positive64BitIntegerFor: self ioLocalMicroseconds)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSecondsClock (in category 'system control primitives') -----
primitiveSecondsClock
"Return the number of seconds since January 1, 1901 as an integer."
+ self pop: 1 thenPush: (self positive32BitIntegerFor: self ioSecondsNow)!
- self pop: 1 thenPush: (self positive32BitIntegerFor: self ioSeconds).!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveUTCMicrosecondClock (in category 'system control primitives') -----
primitiveUTCMicrosecondClock
"Return the value of the microsecond clock as an integer. The microsecond clock is at
least 60 bits wide which means it'll get to around August 38435 before it wraps around."
+ self pop: 1 thenPush: (self positive64BitIntegerFor: self ioUTCMicrosecondsNow)!
- self pop: 1 thenPush: (self positive64BitIntegerFor: self ioUTCMicroseconds)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveUtcWithOffset (in category 'system control primitives') -----
primitiveUtcWithOffset
"Answer an array with UTC microseconds since the Posix epoch and
the current seconds offset from GMT in the local time zone.
This is a named (not numbered) primitive in the null module (ie the VM)"
| resultArray |
<export: true>
"2177452800000000 = '1/1/1970' asDate asSeconds - '1/1/1901' asDate asSeconds * 1,000,000"
+ objectMemory pushRemappableOop: (self positive64BitIntegerFor: self ioUTCMicrosecondsNow - 2177452800000000).
- objectMemory pushRemappableOop: (self positive64BitIntegerFor: self ioUTCMicroseconds - 2177452800000000).
resultArray := objectMemory instantiateClass: objectMemory classArray indexableSize: 2.
self storePointer: 0 ofObject: resultArray withValue: objectMemory popRemappableOop.
self storePointerUnchecked: 1 ofObject: resultArray withValue: (objectMemory integerObjectOf: self ioLocalSecondsOffset).
self pop: 1 thenPush: resultArray
!
Item was removed:
- ----- Method: InterpreterPrimitives>>signed32BitValueOf: (in category 'primitive support') -----
- signed32BitValueOf: oop
- "Convert the given object into an integer value.
- The object may be either a positive SmallInteger or a four-byte LargeInteger."
- | value negative ok |
- <inline: false>
- <returnTypeC: #int>
- <var: #value type: #int>
- (objectMemory isIntegerObject: oop) ifTrue:
- [^objectMemory integerValueOf: oop].
-
- ok := objectMemory isClassOfNonImm: oop
- equalTo: (objectMemory splObj: ClassLargePositiveInteger)
- compactClassIndex: ClassLargePositiveIntegerCompactIndex.
- ok
- ifTrue: [negative := false]
- ifFalse:
- [negative := true.
- ok := objectMemory isClassOfNonImm: oop
- equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
- compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
- ok ifFalse: [^self primitiveFail]].
- (objectMemory lengthOf: oop) > 4 ifTrue:
- [^self primitiveFail].
-
- value := (objectMemory fetchByte: 0 ofObject: oop) +
- ((objectMemory fetchByte: 1 ofObject: oop) << 8) +
- ((objectMemory fetchByte: 2 ofObject: oop) << 16) +
- ((objectMemory fetchByte: 3 ofObject: oop) << 24).
- self cCode: []
- inSmalltalk:
- [(value anyMask: 16r80000000) ifTrue:
- [value := value - 16r100000000]].
- "Filter out values out of range for the signed interpretation such as
- 16rFFFFFFFF (positive w/ bit 32 set) and -16rFFFFFFFF (negative w/ bit
- 32 set). Since the sign is implicit in the class we require that the high
- bit of the magnitude is not set which is a simple test here. Note that
- we have to handle the most negative 32-bit value -2147483648 specially."
- value < 0 ifTrue:
- [self assert: (self sizeof: value) == 4.
- "Don't fail for -16r80000000/-2147483648
- Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
- overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
- (negative and: [0 = (self cCode: [value << 1]
- inSmalltalk: [value << 1 bitAnd: (1 << 32) - 1])]) ifTrue:
- [^value].
- ^self primitiveFail].
- ^negative
- ifTrue: [0 - value]
- ifFalse: [value]!
Item was added:
+ ----- Method: InterpreterPrimitives>>signed32BitValueOf: (in category 'primitive support') -----
+ signed32BitValueOf: oop
+ "Convert the given object into an integer value.
+ The object may be either a positive SmallInteger or a four-byte LargeInteger."
+ | value negative ok |
+ <inline: false>
+ <returnTypeC: #int>
+ <var: #value type: #int>
+ (objectMemory isIntegerObject: oop) ifTrue:
+ [^objectMemory integerValueOf: oop].
+
+ ok := objectMemory isClassOfNonImm: oop
+ equalTo: (objectMemory splObj: ClassLargePositiveInteger)
+ compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ ok
+ ifTrue: [negative := false]
+ ifFalse:
+ [negative := true.
+ ok := objectMemory isClassOfNonImm: oop
+ equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
+ compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
+ ok ifFalse: [^self primitiveFail]].
+ (objectMemory lengthOf: oop) > 4 ifTrue:
+ [^self primitiveFail].
+
+ value := (objectMemory fetchByte: 0 ofObject: oop) +
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8) +
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16) +
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24).
+ self cCode: []
+ inSmalltalk:
+ [(value anyMask: 16r80000000) ifTrue:
+ [value := value - 16r100000000]].
+ "Filter out values out of range for the signed interpretation such as
+ 16rFFFFFFFF (positive w/ bit 32 set) and -16rFFFFFFFF (negative w/ bit
+ 32 set). Since the sign is implicit in the class we require that the high
+ bit of the magnitude is not set which is a simple test here. Note that
+ we have to handle the most negative 32-bit value -2147483648 specially."
+ value < 0 ifTrue:
+ [self assert: (self sizeof: value) == 4.
+ "Don't fail for -16r80000000/-2147483648
+ Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
+ overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
+ (negative and: [0 = (self cCode: [value << 1]
+ inSmalltalk: [value << 1 bitAnd: (1 << 32) - 1])]) ifTrue:
+ [^value].
+ ^self primitiveFail].
+ ^negative
+ ifTrue: [0 - value]
+ ifFalse: [value]!
Item was added:
+ ----- Method: InterpreterProxy>>arrayValueOf: (in category 'object access') -----
+ arrayValueOf: oop
+ <returnTypeC: 'void *'>
+ self success: (self isWordsOrBytes: oop).
+ ^CArrayAccessor on: oop.!
Item was removed:
- ----- Method: InterpreterProxy>>arrayValueOf: (in category 'object access') -----
- arrayValueOf: oop
- <returnTypeC: 'void *'>
- self success: (self isWordsOrBytes: oop).
- ^CArrayAccessor on: oop.!
Item was removed:
- ----- Method: InterpreterProxy>>booleanValueOf: (in category 'converting') -----
- booleanValueOf: obj
- obj == true ifTrue:[^true].
- obj == false ifTrue:[^false].
- self primitiveFail.
- ^nil!
Item was added:
+ ----- Method: InterpreterProxy>>booleanValueOf: (in category 'converting') -----
+ booleanValueOf: obj
+ obj == true ifTrue:[^true].
+ obj == false ifTrue:[^false].
+ self primitiveFail.
+ ^nil!
Item was added:
+ ----- Method: InterpreterProxy>>checkedIntegerValueOf: (in category 'converting') -----
+ checkedIntegerValueOf: intOop
+ (self isIntegerObject: intOop)
+ ifTrue:[^self integerValueOf: intOop]
+ ifFalse:[self primitiveFail. ^0].!
Item was removed:
- ----- Method: InterpreterProxy>>checkedIntegerValueOf: (in category 'converting') -----
- checkedIntegerValueOf: intOop
- (self isIntegerObject: intOop)
- ifTrue:[^self integerValueOf: intOop]
- ifFalse:[self primitiveFail. ^0].!
Item was added:
+ ----- Method: InterpreterProxy>>fetchInteger:ofObject: (in category 'object access') -----
+ fetchInteger: fieldIndex ofObject: objectPointer
+ "Note: May be called by translated primitive code."
+
+ | intOop |
+ <inline: false>
+ intOop := self fetchPointer: fieldIndex ofObject: objectPointer.
+ ^self checkedIntegerValueOf: intOop!
Item was removed:
- ----- Method: InterpreterProxy>>fetchInteger:ofObject: (in category 'object access') -----
- fetchInteger: fieldIndex ofObject: objectPointer
- "Note: May be called by translated primitive code."
-
- | intOop |
- <inline: false>
- intOop := self fetchPointer: fieldIndex ofObject: objectPointer.
- ^self checkedIntegerValueOf: intOop!
Item was removed:
- ----- Method: InterpreterProxy>>fetchPointer:ofObject: (in category 'object access') -----
- fetchPointer: index ofObject: oop
- ^oop instVarAt: index+1!
Item was added:
+ ----- Method: InterpreterProxy>>fetchPointer:ofObject: (in category 'object access') -----
+ fetchPointer: index ofObject: oop
+ ^oop instVarAt: index+1!
Item was removed:
- ----- Method: InterpreterProxy>>firstIndexableField: (in category 'object access') -----
- firstIndexableField: oop
- <returnTypeC:'void *'>
- ^CArrayAccessor on: oop!
Item was added:
+ ----- Method: InterpreterProxy>>firstIndexableField: (in category 'object access') -----
+ firstIndexableField: oop
+ <returnTypeC:'void *'>
+ ^CArrayAccessor on: oop!
Item was removed:
- ----- Method: InterpreterProxy>>fullGC (in category 'other') -----
- fullGC
- Smalltalk garbageCollect.!
Item was added:
+ ----- Method: InterpreterProxy>>fullGC (in category 'other') -----
+ fullGC
+ Smalltalk garbageCollect.!
Item was removed:
- ----- Method: InterpreterProxy>>getThisSessionID (in category 'other') -----
- getThisSessionID
- "Answer a session identifier which represents the current instance of Squeak.
- The identifier is expected to be unique among all instances of Squeak on a
- network at any point in time."
-
- [thisSessionID = 0]
- whileTrue:
- [thisSessionID := (Random new next * SmallInteger maxVal) asInteger].
- ^ thisSessionID
- !
Item was added:
+ ----- Method: InterpreterProxy>>getThisSessionID (in category 'other') -----
+ getThisSessionID
+ "Answer a session identifier which represents the current instance of Squeak.
+ The identifier is expected to be unique among all instances of Squeak on a
+ network at any point in time."
+
+ [thisSessionID = 0]
+ whileTrue:
+ [thisSessionID := (Random new next * SmallInteger maxVal) asInteger].
+ ^ thisSessionID
+ !
Item was removed:
- ----- Method: InterpreterProxy>>incrementalGC (in category 'other') -----
- incrementalGC
- Smalltalk garbageCollectMost.!
Item was added:
+ ----- Method: InterpreterProxy>>incrementalGC (in category 'other') -----
+ incrementalGC
+ Smalltalk garbageCollectMost.!
Item was removed:
- ----- Method: InterpreterProxy>>ioLoadFunction:From: (in category 'FFI support') -----
- ioLoadFunction: functionName From: moduleName
- <returnTypeC: #'void *'>
- <var: #functionName type: #'char *'>
- <var: #moduleName type: #'char *'>
- "Dummy - provided by support code"
- ^0!
Item was added:
+ ----- Method: InterpreterProxy>>ioLoadFunction:From: (in category 'FFI support') -----
+ ioLoadFunction: functionName From: moduleName
+ <returnTypeC: #'void *'>
+ <var: #functionName type: #'char *'>
+ <var: #moduleName type: #'char *'>
+ "Dummy - provided by support code"
+ ^0!
Item was removed:
- ----- Method: InterpreterProxy>>is:KindOf: (in category 'testing') -----
- is: oop KindOf: aString
- "InterpreterProxy new is: 42 KindOf: 'Number'"
- | theClass |
- <var: #aString type:'char *'>
- theClass := Smalltalk at: aString asSymbol ifAbsent:[nil].
- ^theClass isNil
- ifTrue:[false]
- ifFalse:[^oop isKindOf: theClass]!
Item was added:
+ ----- Method: InterpreterProxy>>is:KindOf: (in category 'testing') -----
+ is: oop KindOf: aString
+ "InterpreterProxy new is: 42 KindOf: 'Number'"
+ | theClass |
+ <var: #aString type:'char *'>
+ theClass := Smalltalk at: aString asSymbol ifAbsent:[nil].
+ ^theClass isNil
+ ifTrue:[false]
+ ifFalse:[^oop isKindOf: theClass]!
Item was added:
+ ----- Method: InterpreterProxy>>longAt: (in category 'private') -----
+ longAt: accessor
+ ^accessor longAt: 0!
Item was removed:
- ----- Method: InterpreterProxy>>longAt: (in category 'private') -----
- longAt: accessor
- ^accessor longAt: 0!
Item was added:
+ ----- Method: InterpreterProxy>>longAt:put: (in category 'private') -----
+ longAt: accessor put: value
+ ^accessor longAt: 0 put: value!
Item was removed:
- ----- Method: InterpreterProxy>>longAt:put: (in category 'private') -----
- longAt: accessor put: value
- ^accessor longAt: 0 put: value!
Item was added:
+ ----- Method: InterpreterProxy>>methodArgumentCount (in category 'object access') -----
+ methodArgumentCount
+ ^argumentCount!
Item was removed:
- ----- Method: InterpreterProxy>>methodArgumentCount (in category 'object access') -----
- methodArgumentCount
- ^argumentCount!
Item was added:
+ ----- Method: InterpreterProxy>>pop:thenPush: (in category 'stack access') -----
+ pop: nItems thenPush: oop
+ self pop: nItems.
+ self push: oop.!
Item was removed:
- ----- Method: InterpreterProxy>>pop:thenPush: (in category 'stack access') -----
- pop: nItems thenPush: oop
- self pop: nItems.
- self push: oop.!
Item was added:
+ ----- Method: InterpreterProxy>>positive32BitIntegerFor: (in category 'converting') -----
+ positive32BitIntegerFor: integerValue
+ integerValue isInteger ifFalse:[self error:'Not an Integer object'].
+ ^integerValue > 0
+ ifTrue:[integerValue]
+ ifFalse:[ (1 bitShift: 32) + integerValue]!
Item was removed:
- ----- Method: InterpreterProxy>>positive32BitIntegerFor: (in category 'converting') -----
- positive32BitIntegerFor: integerValue
- integerValue isInteger ifFalse:[self error:'Not an Integer object'].
- ^integerValue > 0
- ifTrue:[integerValue]
- ifFalse:[ (1 bitShift: 32) + integerValue]!
Item was removed:
- ----- Method: InterpreterProxy>>positive32BitValueOf: (in category 'converting') -----
- positive32BitValueOf: oop
- oop isInteger ifFalse:[self error:'Not an integer object'].
- oop < 0
- ifTrue:[self primitiveFail. ^0]
- ifFalse:[^oop]!
Item was added:
+ ----- Method: InterpreterProxy>>positive32BitValueOf: (in category 'converting') -----
+ positive32BitValueOf: oop
+ oop isInteger ifFalse:[self error:'Not an integer object'].
+ oop < 0
+ ifTrue:[self primitiveFail. ^0]
+ ifFalse:[^oop]!
Item was removed:
- ----- Method: InterpreterProxy>>positive64BitIntegerFor: (in category 'converting') -----
- positive64BitIntegerFor: integerValue
- <returnTypeC: #sqInt> "...because answering the 64-bit argument causes the type inferencer to say this answers 64-bits."
- <var: 'integerValue' type: #sqLong>
- integerValue isInteger ifFalse:[self error:'Not an Integer object'].
- ^integerValue > 0
- ifTrue:[integerValue]
- ifFalse:[ (1 bitShift: 64) + integerValue]!
Item was added:
+ ----- Method: InterpreterProxy>>positive64BitIntegerFor: (in category 'converting') -----
+ positive64BitIntegerFor: integerValue
+ <returnTypeC: #sqInt> "...because answering the 64-bit argument causes the type inferencer to say this answers 64-bits."
+ <var: 'integerValue' type: #sqLong>
+ integerValue isInteger ifFalse:[self error:'Not an Integer object'].
+ ^integerValue > 0
+ ifTrue:[integerValue]
+ ifFalse:[ (1 bitShift: 64) + integerValue]!
Item was added:
+ ----- Method: InterpreterProxy>>primitiveFailureCode (in category 'other') -----
+ primitiveFailureCode
+ ^primFailCode!
Item was removed:
- ----- Method: InterpreterProxy>>primitiveFailureCode (in category 'other') -----
- primitiveFailureCode
- ^primFailCode!
Item was removed:
- ----- Method: InterpreterProxy>>pushFloat: (in category 'stack access') -----
- pushFloat: f
- <var: #f type: 'double '>
- f class == Float ifFalse:[^self error:'Not a Float'].
- self push: f.!
Item was added:
+ ----- Method: InterpreterProxy>>pushFloat: (in category 'stack access') -----
+ pushFloat: f
+ <var: #f type: 'double '>
+ f class == Float ifFalse:[^self error:'Not a Float'].
+ self push: f.!
Item was removed:
- ----- Method: InterpreterProxy>>pushInteger: (in category 'stack access') -----
- pushInteger: integerValue
- self push: (self integerObjectOf: integerValue).!
Item was added:
+ ----- Method: InterpreterProxy>>pushInteger: (in category 'stack access') -----
+ pushInteger: integerValue
+ self push: (self integerObjectOf: integerValue).!
Item was removed:
- ----- Method: InterpreterProxy>>showDisplayBits:Left:Top:Right:Bottom: (in category 'other') -----
- showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
- aForm == Display ifTrue:[
- Display forceToScreen: (Rectangle left: l right: r top: t bottom: b)].!
Item was added:
+ ----- Method: InterpreterProxy>>showDisplayBits:Left:Top:Right:Bottom: (in category 'other') -----
+ showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
+ aForm == Display ifTrue:[
+ Display forceToScreen: (Rectangle left: l right: r top: t bottom: b)].!
Item was removed:
- ----- Method: InterpreterProxy>>signed32BitIntegerFor: (in category 'converting') -----
- signed32BitIntegerFor: integerValue
- integerValue isInteger ifFalse:[self error:'Not an Integer object'].
- ^integerValue!
Item was added:
+ ----- Method: InterpreterProxy>>signed32BitIntegerFor: (in category 'converting') -----
+ signed32BitIntegerFor: integerValue
+ integerValue isInteger ifFalse:[self error:'Not an Integer object'].
+ ^integerValue!
Item was added:
+ ----- Method: InterpreterProxy>>signed32BitValueOf: (in category 'converting') -----
+ signed32BitValueOf: oop
+ <returnTypeC: #int>
+ oop isInteger ifFalse:[self error:'Not an integer object'].
+ ^oop!
Item was removed:
- ----- Method: InterpreterProxy>>signed32BitValueOf: (in category 'converting') -----
- signed32BitValueOf: oop
- <returnTypeC: #int>
- oop isInteger ifFalse:[self error:'Not an integer object'].
- ^oop!
Item was removed:
- ----- Method: InterpreterProxy>>stObject:at: (in category 'object access') -----
- stObject: array at: index
- ^array at: index!
Item was added:
+ ----- Method: InterpreterProxy>>stObject:at: (in category 'object access') -----
+ stObject: array at: index
+ ^array at: index!
Item was added:
+ ----- Method: InterpreterProxy>>stObject:at:put: (in category 'object access') -----
+ stObject: array at: index put: value
+ ^array at: index put: value!
Item was removed:
- ----- Method: InterpreterProxy>>stObject:at:put: (in category 'object access') -----
- stObject: array at: index put: value
- ^array at: index put: value!
Item was added:
+ ----- Method: InterpreterProxy>>stackIntegerValue: (in category 'stack access') -----
+ stackIntegerValue: offset
+ | oop |
+ oop := self stackValue: offset.
+ (self isIntegerObject: oop) ifFalse: [self primitiveFail. ^0].
+ ^oop!
Item was removed:
- ----- Method: InterpreterProxy>>stackIntegerValue: (in category 'stack access') -----
- stackIntegerValue: offset
- | oop |
- oop := self stackValue: offset.
- (self isIntegerObject: oop) ifFalse: [self primitiveFail. ^0].
- ^oop!
Item was added:
+ ----- Method: InterpreterProxy>>stackValue: (in category 'stack access') -----
+ stackValue: offset
+ ^stack at: stack size - offset.!
Item was removed:
- ----- Method: InterpreterProxy>>stackValue: (in category 'stack access') -----
- stackValue: offset
- ^stack at: stack size - offset.!
Item was added:
+ ----- Method: InterpreterProxy>>vmEndianness (in category 'other') -----
+ vmEndianness
+ "return 0 for little endian, 1 for big endian"
+ ^SmalltalkImage current endianness =#big ifTrue:[1] ifFalse:[0]!
Item was removed:
- ----- Method: InterpreterProxy>>vmEndianness (in category 'other') -----
- vmEndianness
- "return 0 for little endian, 1 for big endian"
- ^SmalltalkImage current endianness =#big ifTrue:[1] ifFalse:[0]!
Item was changed:
----- Method: InterpreterSimulator>>allObjectsSelect: (in category 'debug support') -----
allObjectsSelect: objBlock
"self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]"
| oop selected |
oop := self firstObject.
selected := OrderedCollection new.
[oop < endOfMemory] whileTrue:
[(self isFreeObject: oop)
ifFalse: [(objBlock value: oop) ifTrue: [selected addLast: oop]].
oop := self objectAfter: oop].
^ selected!
Item was changed:
----- Method: InterpreterSimulator>>allocate:headerSize:h1:h2:h3:doFill:format: (in category 'debugging traps') -----
allocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOop h3: extendedSize doFill: doFill format: format
| newObj |
newObj := super allocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOop h3: extendedSize doFill: doFill format: format.
"byteCount < 600000 ifTrue: [^ newObj]."
"(self baseHeader: newObj) = 16r0FCC0600 ifTrue: [self halt]."
^ newObj!
Item was changed:
----- Method: InterpreterSimulator>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
^self subclassResponsibility!
Item was changed:
----- Method: InterpreterSimulator>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
^self subclassResponsibility!
Item was removed:
- ----- Method: InterpreterSimulator>>byteAtPointer: (in category 'memory access') -----
- byteAtPointer: pointer
- "This gets implemented by Macros in C, where its types will also be checked.
- pointer is a raw address, and byte is an 8-bit quantity."
-
- ^ self byteAt: pointer!
Item was added:
+ ----- Method: InterpreterSimulator>>byteAtPointer: (in category 'memory access') -----
+ byteAtPointer: pointer
+ "This gets implemented by Macros in C, where its types will also be checked.
+ pointer is a raw address, and byte is an 8-bit quantity."
+
+ ^ self byteAt: pointer!
Item was added:
+ ----- Method: InterpreterSimulator>>byteAtPointer:put: (in category 'memory access') -----
+ byteAtPointer: pointer put: byteValue
+ "This gets implemented by Macros in C, where its types will also be checked.
+ pointer is a raw address, and byteValue is an 8-bit quantity."
+
+ ^ self byteAt: pointer put: byteValue!
Item was removed:
- ----- Method: InterpreterSimulator>>byteAtPointer:put: (in category 'memory access') -----
- byteAtPointer: pointer put: byteValue
- "This gets implemented by Macros in C, where its types will also be checked.
- pointer is a raw address, and byteValue is an 8-bit quantity."
-
- ^ self byteAt: pointer put: byteValue!
Item was changed:
----- Method: InterpreterSimulator>>byteCount (in category 'debug support') -----
byteCount
"So you can call this from temp debug statements in, eg, Interpreter, such as
self byteCount = 12661 ifTrue: [self halt].
"
^ byteCount!
Item was changed:
----- Method: InterpreterSimulator>>cCoerce:to: (in category 'memory access') -----
cCoerce: value to: cTypeString
"Type coercion for translation only; just return the value when running in Smalltalk."
^value == nil
ifTrue: [value]
ifFalse: [value coerceTo: cTypeString sim: self]!
Item was added:
+ ----- Method: InterpreterSimulator>>charsOfLong: (in category 'debug support') -----
+ charsOfLong: long
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: InterpreterSimulator>>charsOfLong: (in category 'debug support') -----
- charsOfLong: long
- ^self subclassResponsibility!
Item was changed:
----- Method: InterpreterSimulator>>checkForInterrupts (in category 'debug support') -----
checkForInterrupts
"Prevent interrupts so that traces are consistent during detailed debugging"
"self halt."
true ifTrue:
[interruptCheckCounter := 1000.
^self].
^ super checkForInterrupts!
Item was changed:
----- Method: InterpreterSimulator>>classAndSelectorOfMethod:forReceiver: (in category 'debug support') -----
classAndSelectorOfMethod: meth forReceiver: rcvr
| mClass dict length methodArray |
mClass := self fetchClassOf: rcvr.
[dict := self fetchPointer: MethodDictionaryIndex ofObject: mClass.
length := self fetchWordLengthOf: dict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: dict.
0 to: length-SelectorStart-1 do:
[:index |
meth = (self fetchPointer: index ofObject: methodArray)
ifTrue: [^ Array
with: mClass
with: (self fetchPointer: index + SelectorStart ofObject: dict)]].
mClass := self fetchPointer: SuperclassIndex ofObject: mClass.
mClass = nilObj]
whileFalse: [].
^ Array
with: (self fetchClassOf: rcvr)
with: (self splObj: SelectorDoesNotUnderstand)!
Item was changed:
----- Method: InterpreterSimulator>>commonSend (in category 'debugging traps') -----
commonSend
| i |
printSends ifTrue:
[self print: byteCount; space; printStringOf: messageSelector; cr].
(i := breakSelector basicSize) = (self lengthOf: messageSelector) ifTrue:
[[i > 0] whileTrue:
[(self fetchByte: i - 1 ofObject: messageSelector) = (breakSelector at: i) asInteger
ifTrue: [(i := i - 1) = 0 ifTrue: [self halt: 'Send of ', breakSelector]]
ifFalse: [i := 0]]].
^super commonSend!
Item was changed:
----- Method: InterpreterSimulator>>dumpHeader: (in category 'debug support') -----
dumpHeader: hdr
| cc |
^ String streamContents: [:strm |
cc := (hdr bitAnd: CompactClassMask) >> 12.
strm nextPutAll: '<cc=', cc hex.
cc > 0 ifTrue:
[strm nextPutAll: ':' , (self nameOfClass: (self compactClassAt: cc))].
strm nextPutAll: '>'.
strm nextPutAll: '<ft=', ((hdr bitShift: -8) bitAnd: 16rF) hex , '>'.
strm nextPutAll: '<sz=', (hdr bitAnd: SizeMask) hex , '>'.
strm nextPutAll: '<hdr=', (#(big class gcMark short) at: (hdr bitAnd: 3) +1) , '>']
!
Item was changed:
----- Method: InterpreterSimulator>>dumpMethodHeader: (in category 'debug support') -----
dumpMethodHeader: hdr
^ String streamContents:
[:strm |
strm nextPutAll: '<nArgs=', ((hdr >> 25) bitAnd: 16r1F) printString , '>'.
strm nextPutAll: '<nTemps=', ((hdr >> 19) bitAnd: 16r3F) printString , '>'.
strm nextPutAll: '<lgCtxt=', ((hdr >> 18) bitAnd: 16r1) printString , '>'.
strm nextPutAll: '<nLits=', ((hdr >> 10) bitAnd: 16rFF) printString , '>'.
strm nextPutAll: '<prim=', ((hdr >> 1) bitAnd: 16r1FF) printString , '>'.
]!
Item was added:
+ ----- Method: InterpreterSimulator>>fetchFloatAt:into: (in category 'float primitives') -----
+ fetchFloatAt: floatBitsAddress into: aFloat
+
+ aFloat at: 1 put: (self long32At: floatBitsAddress).
+ aFloat at: 2 put: (self long32At: floatBitsAddress+4).
+ !
Item was removed:
- ----- Method: InterpreterSimulator>>fetchFloatAt:into: (in category 'float primitives') -----
- fetchFloatAt: floatBitsAddress into: aFloat
-
- aFloat at: 1 put: (self long32At: floatBitsAddress).
- aFloat at: 2 put: (self long32At: floatBitsAddress+4).
- !
Item was removed:
- ----- Method: InterpreterSimulator>>firstIndexableField: (in category 'memory access') -----
- firstIndexableField: oop
- "NOTE: overridden from ObjectMemory to add coercion to CArray, so please duplicate any changes"
- | hdr fmt totalLength fixedFields |
- <returnTypeC: #'void *'>
- hdr := self baseHeader: oop.
- fmt := self formatOfHeader: hdr.
- fmt <= 4 ifTrue: "<= 4 pointer"
- ["pointer; may need to delve into the class format word"
- totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
- fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
- ^self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)) to: 'oop *'].
- ^self
- cCoerce: (self pointerForOop: oop + BaseHeaderSize)
- to: (fmt < 8
- ifTrue: [fmt = 6
- ifTrue: ["32 bit field objects" 'int *']
- ifFalse: ["full word objects (bits)" 'oop *']]
- ifFalse: ["byte objects (including CompiledMethod" 'char *'])!
Item was added:
+ ----- Method: InterpreterSimulator>>firstIndexableField: (in category 'memory access') -----
+ firstIndexableField: oop
+ "NOTE: overridden from ObjectMemory to add coercion to CArray, so please duplicate any changes"
+ | hdr fmt totalLength fixedFields |
+ <returnTypeC: #'void *'>
+ hdr := self baseHeader: oop.
+ fmt := self formatOfHeader: hdr.
+ fmt <= 4 ifTrue: "<= 4 pointer"
+ ["pointer; may need to delve into the class format word"
+ totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
+ ^self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)) to: 'oop *'].
+ ^self
+ cCoerce: (self pointerForOop: oop + BaseHeaderSize)
+ to: (fmt < 8
+ ifTrue: [fmt = 6
+ ifTrue: ["32 bit field objects" 'int *']
+ ifFalse: ["full word objects (bits)" 'oop *']]
+ ifFalse: ["byte objects (including CompiledMethod" 'char *'])!
Item was changed:
----- Method: InterpreterSimulator>>fullDisplayUpdate (in category 'debug support') -----
fullDisplayUpdate
"Preserve successFlag when call asynchronously from Simulator"
| s |
s := successFlag.
successFlag := true.
super fullDisplayUpdate.
successFlag := s!
Item was removed:
- ----- Method: InterpreterSimulator>>fullGC (in category 'debug support') -----
- fullGC
- transcript cr; show:'<Running full GC ...'.
- super fullGC.
- transcript show: ' done>'.!
Item was added:
+ ----- Method: InterpreterSimulator>>fullGC (in category 'debug support') -----
+ fullGC
+ transcript cr; show:'<Running full GC ...'.
+ super fullGC.
+ transcript show: ' done>'.!
Item was removed:
- ----- Method: InterpreterSimulator>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- ^self subclassResponsibility!
Item was added:
+ ----- Method: InterpreterSimulator>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: InterpreterSimulator>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: InterpreterSimulator>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- ^self subclassResponsibility!
Item was changed:
----- Method: InterpreterSimulator>>headerStart: (in category 'debug support') -----
headerStart: oop
^ (self extraHeaderBytes: oop) negated!
Item was changed:
----- Method: InterpreterSimulator>>hexDump100: (in category 'debug support') -----
hexDump100: oop
| byteSize val |
^ String streamContents:
[:strm |
byteSize := 256.
(self headerStart: oop) to: byteSize by: 4 do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: (oop+a) hex8; space; space;
nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space; nextPutAll: val hex8;
space; space.
strm nextPutAll: (self charsOfLong: val).
strm space; space; nextPutAll: (oop+a) printString]]!
Item was changed:
----- Method: InterpreterSimulator>>hexDump: (in category 'debug support') -----
hexDump: oop
| byteSize val |
(self isIntegerObject: oop) ifTrue: [^ self shortPrint: oop].
^ String streamContents:
[:strm |
byteSize := 256 min: (self sizeBitsOf: oop)-4.
(self headerStart: oop) to: byteSize by: 4 do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space; nextPutAll: val hex8;
space; space.
a=0
ifTrue: [strm nextPutAll: (self dumpHeader: val)]
ifFalse: [strm nextPutAll: (self charsOfLong: val)]]]!
Item was removed:
- ----- Method: InterpreterSimulator>>incrementalGC (in category 'debug support') -----
- incrementalGC
- transcript cr; nextPutAll: 'incrementalGC ('; print: byteCount; nextPut: $); flush.
- ^super incrementalGC!
Item was added:
+ ----- Method: InterpreterSimulator>>incrementalGC (in category 'debug support') -----
+ incrementalGC
+ transcript cr; nextPutAll: 'incrementalGC ('; print: byteCount; nextPut: $); flush.
+ ^super incrementalGC!
Item was changed:
----- Method: InterpreterSimulator>>integerAt: (in category 'memory access') -----
integerAt: byteAddress
"Note: Adjusted for Smalltalk's 1-based array indexing."
^memory integerAt: (byteAddress // 4) + 1!
Item was changed:
----- Method: InterpreterSimulator>>integerAt:put: (in category 'memory access') -----
integerAt: byteAddress put: a32BitValue
"Note: Adjusted for Smalltalk's 1-based array indexing."
^memory integerAt: (byteAddress // 4) + 1 put: a32BitValue!
Item was removed:
- ----- Method: InterpreterSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
- ioLoadFunction: functionString From: pluginString
- "Load and return the requested function from a module"
- | plugin fnSymbol |
- fnSymbol := functionString asSymbol.
- transcript cr; show:'Looking for ', functionString, ' in '.
- pluginString isEmpty
- ifTrue:[transcript show: 'vm']
- ifFalse:[transcript show: pluginString].
- plugin := pluginList
- detect:[:any| any key = pluginString asString]
- ifNone:[self loadNewPlugin: pluginString].
- plugin ifNil:[
- "Transcript cr; show:'Failed ... no plugin found'." ^ 0].
- plugin := plugin value.
- mappedPluginEntries doWithIndex:[:pluginAndName :index|
- ((pluginAndName at: 1) == plugin
- and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:[
- "Transcript show:' ... okay'." ^ index]].
- (plugin respondsTo: fnSymbol) ifFalse:[
- "Transcript cr; show:'Failed ... primitive not in plugin'." ^ 0].
- mappedPluginEntries := mappedPluginEntries copyWith: (Array with: plugin with: fnSymbol).
- "Transcript show:' ... okay'."
- ^ mappedPluginEntries size!
Item was added:
+ ----- Method: InterpreterSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
+ ioLoadFunction: functionString From: pluginString
+ "Load and return the requested function from a module"
+ | plugin fnSymbol |
+ fnSymbol := functionString asSymbol.
+ transcript cr; show:'Looking for ', functionString, ' in '.
+ pluginString isEmpty
+ ifTrue:[transcript show: 'vm']
+ ifFalse:[transcript show: pluginString].
+ plugin := pluginList
+ detect:[:any| any key = pluginString asString]
+ ifNone:[self loadNewPlugin: pluginString].
+ plugin ifNil:[
+ "Transcript cr; show:'Failed ... no plugin found'." ^ 0].
+ plugin := plugin value.
+ mappedPluginEntries doWithIndex:[:pluginAndName :index|
+ ((pluginAndName at: 1) == plugin
+ and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:[
+ "Transcript show:' ... okay'." ^ index]].
+ (plugin respondsTo: fnSymbol) ifFalse:[
+ "Transcript cr; show:'Failed ... primitive not in plugin'." ^ 0].
+ mappedPluginEntries := mappedPluginEntries copyWith: (Array with: plugin with: fnSymbol).
+ "Transcript show:' ... okay'."
+ ^ mappedPluginEntries size!
Item was added:
+ ----- Method: InterpreterSimulator>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+ "Return the 32-bit word at byteAddress which must be 0 mod 4."
+
+ ^ self longAt: byteAddress!
Item was removed:
- ----- Method: InterpreterSimulator>>long32At: (in category 'memory access') -----
- long32At: byteAddress
- "Return the 32-bit word at byteAddress which must be 0 mod 4."
-
- ^ self longAt: byteAddress!
Item was added:
+ ----- Method: InterpreterSimulator>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ "Store the 32-bit value at byteAddress which must be 0 mod 4."
+
+ ^ self longAt: byteAddress put: a32BitValue!
Item was removed:
- ----- Method: InterpreterSimulator>>long32At:put: (in category 'memory access') -----
- long32At: byteAddress put: a32BitValue
- "Store the 32-bit value at byteAddress which must be 0 mod 4."
-
- ^ self longAt: byteAddress put: a32BitValue!
Item was added:
+ ----- Method: InterpreterSimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+
+ ^memory at: (byteAddress // 4) + 1!
Item was removed:
- ----- Method: InterpreterSimulator>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- ^memory at: (byteAddress // 4) + 1!
Item was added:
+ ----- Method: InterpreterSimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+
+ ^memory at: (byteAddress // 4) + 1 put: a32BitValue!
Item was removed:
- ----- Method: InterpreterSimulator>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a32BitValue
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- ^memory at: (byteAddress // 4) + 1 put: a32BitValue!
Item was changed:
----- Method: InterpreterSimulator>>longPrint: (in category 'debug support') -----
longPrint: oop
| lastPtr val lastLong hdrType prevVal |
(self isIntegerObject: oop) ifTrue: [^ self shortPrint: oop].
^ String streamContents:
[:strm |
lastPtr := 64*BytesPerWord min: (self lastPointerOf: oop).
hdrType := self headerType: oop.
hdrType = 2 ifTrue: [lastPtr := 0].
prevVal := 0.
(self headerStart: oop) to: lastPtr by: BytesPerWord do:
[:a | val := self longAt: oop+a.
(a > 0 and: [(val = prevVal) & (a ~= lastPtr)])
ifTrue:
[prevVal = (self longAt: oop+a-(BytesPerWord*2)) ifFalse: [strm cr; nextPutAll: ' ...etc...']]
ifFalse:
[strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space; nextPutAll: val hex8; space; space.
a = (BytesPerWord*2) negated ifTrue:
[strm nextPutAll: 'size = ' , (val - hdrType) hex].
a = BytesPerWord negated ifTrue:
[strm nextPutAll: '<' , (self nameOfClass: (val - hdrType)) , '>'].
a = 0 ifTrue: [strm cr; tab; nextPutAll: (self dumpHeader: val)].
a > 0 ifTrue: [strm nextPutAll: (self shortPrint: val)].
a = BytesPerWord ifTrue:
[(self isCompiledMethod: oop) ifTrue:
[strm cr; tab; nextPutAll: (self dumpMethodHeader: val)]]].
prevVal := val].
lastLong := 256 min: (self sizeBitsOf: oop) - BaseHeaderSize.
hdrType = 2
ifTrue:
["free" strm cr; nextPutAll: (oop+(self longAt: oop)-2) hex;
space; space; nextPutAll: (oop+(self longAt: oop)-2) printString]
ifFalse:
[(self formatOf: oop) = 3
ifTrue:
[strm cr; tab; nextPutAll: '/ next 3 fields are above SP... /'.
lastPtr+BytesPerWord to: lastPtr+(3*BytesPerWord) by: BytesPerWord do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: a hex;
space; space; space; nextPutAll: val hex8; space; space.
(self validOop: val) ifTrue: [strm nextPutAll: (self shortPrint: val)]]]
ifFalse:
[lastPtr+BytesPerWord to: lastLong by: BytesPerWord do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space.
strm nextPutAll: val hex8; space; space;
nextPutAll: (self charsOfLong: val)]]].
]!
Item was changed:
----- Method: InterpreterSimulator>>nameOfClass: (in category 'debug support') -----
nameOfClass: classOop
(self sizeBitsOf: classOop) = (Metaclass instSize +1*BytesPerWord) ifTrue:
[^ (self nameOfClass:
(self fetchPointer: 5 "thisClass" ofObject: classOop)) , ' class'].
^ self stringOf: (self fetchPointer: 6 "name" ofObject: classOop)!
Item was removed:
- ----- Method: InterpreterSimulator>>nextLongFrom: (in category 'initialization') -----
- nextLongFrom: aStream
- "Read a 32-bit quantity from the given (binary) stream."
- ^self subclassResponsibility!
Item was added:
+ ----- Method: InterpreterSimulator>>nextLongFrom: (in category 'initialization') -----
+ nextLongFrom: aStream
+ "Read a 32-bit quantity from the given (binary) stream."
+ ^self subclassResponsibility!
Item was changed:
----- Method: InterpreterSimulator>>normalSend (in category 'debugging traps') -----
normalSend
"Catch errors before we start the whole morphic error process"
"(byteCount > 4000000 and: [(self stringOf: messageSelector) = 'sorts:before:'])
ifTrue: [self halt]."
^ super normalSend!
Item was changed:
----- Method: InterpreterSimulator>>primitiveResume (in category 'debugging traps') -----
primitiveResume
"Catch errors before we start the whole morphic error process"
byteCount > 1000000 ifTrue: [self halt]. "Ignore early process activity"
^ super primitiveResume!
Item was changed:
----- Method: InterpreterSimulator>>primitiveSuspend (in category 'debugging traps') -----
primitiveSuspend
"Catch errors before we start the whole morphic error process"
byteCount > 1000000 ifTrue: [self halt]. "Ignore early process activity"
^ super primitiveSuspend!
Item was added:
+ ----- Method: InterpreterSimulator>>printChar: (in category 'debug printing') -----
+ printChar: aByte
+
+ traceOn ifTrue: [ transcript nextPut: aByte asCharacter ].!
Item was removed:
- ----- Method: InterpreterSimulator>>printChar: (in category 'debug printing') -----
- printChar: aByte
-
- traceOn ifTrue: [ transcript nextPut: aByte asCharacter ].!
Item was changed:
----- Method: InterpreterSimulator>>printStack (in category 'debug support') -----
printStack
^ self printStack: false!
Item was changed:
----- Method: InterpreterSimulator>>printStack: (in category 'debug support') -----
printStack: includeTemps
| ctxt |
ctxt := activeContext.
^ String streamContents:
[:strm |
[self printStackFrame: ctxt onStream: strm.
includeTemps ifTrue: [self printStackTemps: ctxt onStream: strm].
(ctxt := (self fetchPointer: SenderIndex ofObject: ctxt)) = nilObj]
whileFalse: [].
]!
Item was changed:
----- Method: InterpreterSimulator>>printStackFrame:onStream: (in category 'debug support') -----
printStackFrame: ctxt onStream: strm
| classAndSel home |
home := (self fetchClassOf: ctxt) = (self splObj: ClassBlockContext)
ifTrue: [self fetchPointer: HomeIndex ofObject: ctxt]
ifFalse: [ctxt].
classAndSel := self
classAndSelectorOfMethod: (self fetchPointer: MethodIndex ofObject: home)
forReceiver: (self fetchPointer: ReceiverIndex ofObject: home).
strm cr; nextPutAll: ctxt hex8.
ctxt = home ifFalse: [strm nextPutAll: ' [] in'].
strm space; nextPutAll: (self nameOfClass: classAndSel first).
strm nextPutAll: '>>'; nextPutAll: (self shortPrint: classAndSel last).
!
Item was changed:
----- Method: InterpreterSimulator>>printStackTemps:onStream: (in category 'debug support') -----
printStackTemps: ctxt onStream: strm
| home cMethod nArgs nTemps oop |
home := (self fetchClassOf: ctxt) = (self splObj: ClassBlockContext)
ifTrue: [self fetchPointer: HomeIndex ofObject: ctxt]
ifFalse: [ctxt].
cMethod := self fetchPointer: MethodIndex ofObject: home.
nArgs := nTemps := 0.
home = ctxt ifTrue:
[strm cr; tab; nextPutAll: 'args: '.
nArgs := self argumentCountOf: cMethod.
1 to: nArgs do:
[:i | oop := self fetchPointer: TempFrameStart + i-1 ofObject: ctxt.
strm nextPutAll: oop hex; space].
strm cr; tab; nextPutAll: 'temps: '.
nTemps := self tempCountOf: cMethod.
nArgs+1 to: nTemps do:
[:i | oop := self fetchPointer: TempFrameStart + i-1 ofObject: ctxt.
strm nextPutAll: oop hex; space]].
strm cr; tab; nextPutAll: 'stack: '.
nTemps + 1 to: (self lastPointerOf: ctxt)//BytesPerWord - TempFrameStart do:
[:i | oop := self fetchPointer: TempFrameStart + i-1 ofObject: ctxt.
strm nextPutAll: oop hex; space].
!
Item was changed:
----- Method: InterpreterSimulator>>printStackWithTemps (in category 'debug support') -----
printStackWithTemps
^ self printStack: true!
Item was changed:
----- Method: InterpreterSimulator>>printTop: (in category 'debug support') -----
printTop: n
"Print important fields of the top n contexts"
| ctxt classAndSel home top ip sp |
ctxt := activeContext.
^ String streamContents:
[:strm | 1 to: n do:
[:i |
home := (self fetchClassOf: ctxt) = (self splObj: ClassBlockContext)
ifTrue: [self fetchPointer: HomeIndex ofObject: ctxt]
ifFalse: [ctxt].
classAndSel := self
classAndSelectorOfMethod: (self fetchPointer: MethodIndex ofObject: home)
forReceiver: (self fetchPointer: ReceiverIndex ofObject: home).
strm cr; nextPutAll: ctxt hex8.
ctxt = home ifFalse: [strm nextPutAll: ' [] in'].
strm space; nextPutAll: (self nameOfClass: classAndSel first).
strm nextPutAll: '>>'; nextPutAll: (self shortPrint: classAndSel last).
ctxt = activeContext
ifTrue: [ip := instructionPointer - method - (BaseHeaderSize - 2).
sp := self stackPointerIndex - TempFrameStart + 1.
top := self stackTop]
ifFalse: [ip := self integerValueOf:
(self fetchPointer: InstructionPointerIndex ofObject: ctxt).
sp := self integerValueOf:
(self fetchPointer: StackPointerIndex ofObject: ctxt).
top := self longAt: ctxt + (self lastPointerOf: ctxt)].
strm cr; tab; nextPutAll: 'ip = '; print: ip.
strm cr; tab; nextPutAll: 'sp = '; print: sp.
strm cr; tab; nextPutAll: 'top = '; nextPutAll: (self shortPrint: top).
(ctxt := (self fetchPointer: SenderIndex ofObject: ctxt)) = nilObj
ifTrue: [^strm contents].
].
]!
Item was removed:
- ----- Method: InterpreterSimulator>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
- "Return the half-word at byteAddress which must be even."
- ^self subclassResponsibility!
Item was added:
+ ----- Method: InterpreterSimulator>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+ "Return the half-word at byteAddress which must be even."
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: InterpreterSimulator>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- ^ self subclassResponsibility!
Item was added:
+ ----- Method: InterpreterSimulator>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ ^ self subclassResponsibility!
Item was changed:
----- Method: InterpreterSimulator>>shortPrint: (in category 'debug support') -----
shortPrint: oop
| name classOop |
(self isIntegerObject: oop) ifTrue: [^ '=' , (self integerValueOf: oop) printString ,
' (' , (self integerValueOf: oop) hex , ')'].
classOop := self fetchClassOf: oop.
(self sizeBitsOf: classOop) = (Metaclass instSize +1*BytesPerWord) ifTrue: [
^ 'class ' , (self nameOfClass: oop)].
name := self nameOfClass: classOop.
name size = 0 ifTrue: [name := '??'].
name = 'String' ifTrue: [^ (self stringOf: oop) printString].
name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'Character' ifTrue: [^ '=' , (Character value: (self integerValueOf:
(self fetchPointer: 0 ofObject: oop))) printString].
name = 'UndefinedObject' ifTrue: [^ 'nil'].
name = 'False' ifTrue: [^ 'false'].
name = 'True' ifTrue: [^ 'true'].
name = 'Float' ifTrue: [successFlag := true. ^ '=' , (self floatValueOf: oop) printString].
name = 'Association' ifTrue: [^ '(' ,
(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
' -> ' ,
(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
('AEIOU' includes: name first)
ifTrue: [^ 'an ' , name]
ifFalse: [^ 'a ' , name]!
Item was changed:
----- Method: InterpreterSimulator>>sqGrowMemory:By: (in category 'memory access') -----
sqGrowMemory: oldLimit By: delta
transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr.
memory := memory , (memory class new: delta // 4).
^ memory size * 4!
Item was added:
+ ----- Method: InterpreterSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
+ sqMemoryExtraBytesLeft: includingSwap
+ ^0!
Item was removed:
- ----- Method: InterpreterSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- ^0!
Item was added:
+ ----- Method: InterpreterSimulator>>sqShrinkMemory:By: (in category 'memory access') -----
+ sqShrinkMemory: oldLimit By: delta
+ transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr.
+
+ ^ oldLimit!
Item was removed:
- ----- Method: InterpreterSimulator>>sqShrinkMemory:By: (in category 'memory access') -----
- sqShrinkMemory: oldLimit By: delta
- transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr.
-
- ^ oldLimit!
Item was removed:
- ----- Method: InterpreterSimulator>>storeFloatAt:from: (in category 'float primitives') -----
- storeFloatAt: floatBitsAddress from: aFloat
-
- self long32At: floatBitsAddress put: (aFloat at: 1).
- self long32At: floatBitsAddress+4 put: (aFloat at: 2).
- !
Item was added:
+ ----- Method: InterpreterSimulator>>storeFloatAt:from: (in category 'float primitives') -----
+ storeFloatAt: floatBitsAddress from: aFloat
+
+ self long32At: floatBitsAddress put: (aFloat at: 1).
+ self long32At: floatBitsAddress+4 put: (aFloat at: 2).
+ !
Item was changed:
----- Method: InterpreterSimulator>>stringOf: (in category 'debug support') -----
stringOf: oop
| size long nLongs chars |
^ String streamContents:
[:strm |
size := 100 min: (self stSizeOf: oop).
nLongs := size-1//BytesPerWord+1.
1 to: nLongs do:
[:i | long := self longAt: oop + BaseHeaderSize + (i-1*BytesPerWord).
chars := self charsOfLong: long.
strm nextPutAll: (i=nLongs
ifTrue: [chars copyFrom: 1 to: size-1\\BytesPerWord+1]
ifFalse: [chars])]]!
Item was changed:
----- Method: InterpreterSimulator>>tenuringIncrementalGC (in category 'debug support') -----
tenuringIncrementalGC
transcript cr; nextPutAll: 'tenuringIncrementalGC ('; print: byteCount; nextPut: $); flush.
^super tenuringIncrementalGC!
Item was removed:
- ----- Method: InterpreterSimulator>>validOop: (in category 'testing') -----
- validOop: oop
- " Return true if oop appears to be valid "
- (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
- (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
- oop >= endOfMemory ifTrue: [^ false]. "Out of range"
- "could test if within the first large freeblock"
- (self longAt: oop) = 4 ifTrue: [^ false].
- (self headerType: oop) = 2 ifTrue: [^ false]. "Free object"
- ^ true!
Item was added:
+ ----- Method: InterpreterSimulator>>validOop: (in category 'testing') -----
+ validOop: oop
+ " Return true if oop appears to be valid "
+ (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
+ (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
+ oop >= endOfMemory ifTrue: [^ false]. "Out of range"
+ "could test if within the first large freeblock"
+ (self longAt: oop) = 4 ifTrue: [^ false].
+ (self headerType: oop) = 2 ifTrue: [^ false]. "Free object"
+ ^ true!
Item was changed:
----- Method: InterpreterSimulator>>warning: (in category 'debug support') -----
warning: aString
Transcript cr; nextPutAll: aString; flush!
Item was changed:
----- Method: InterpreterSimulator>>writeImageFileIO: (in category 'image save/restore') -----
writeImageFileIO: numberOfBytesToWrite
"Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
| headerSize file |
BytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
headerSize := 64.
[
file := (FileStream fileNamed: imageName) binary.
file == nil ifTrue: [^nil].
{
self imageFormatVersion.
headerSize.
numberOfBytesToWrite.
self startOfMemory.
specialObjectsOop.
lastHash.
self ioScreenSize.
fullScreenFlag.
extraVMMemory
}
do: [:long | self putLong: long toFile: file].
"Pad the rest of the header."
7 timesRepeat: [self putLong: 0 toFile: file].
"Position the file after the header."
file position: headerSize.
"Write the object memory."
1
to: numberOfBytesToWrite // 4
do: [:index |
self
putLong: (memory at: index)
toFile: file].
self success: true
]
ensure: [file close]!
Item was changed:
----- Method: InterpreterSimulatorLSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits long |
lowBits := byteAddress bitAnd: 3.
long := self longAt: byteAddress - lowBits.
^(lowBits caseOf: {
[0] -> [ long ].
[1] -> [ long bitShift: -8 ].
[2] -> [ long bitShift: -16 ].
[3] -> [ long bitShift: -24 ]
}) bitAnd: 16rFF
!
Item was changed:
----- Method: InterpreterSimulatorLSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| lowBits long longAddress |
lowBits := byteAddress bitAnd: 3.
longAddress := byteAddress - lowBits.
long := self longAt: longAddress.
long := (lowBits caseOf: {
[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16) ].
[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24) ]
}).
self longAt: longAddress put: long.
^byte!
Item was added:
+ ----- Method: InterpreterSimulatorLSB>>charsOfLong: (in category 'debug support') -----
+ charsOfLong: long
+ ^ (1 to: 4) collect:
+ [:i | ((long digitAt: i) between: 14 and: 126)
+ ifTrue: [(long digitAt: i) asCharacter]
+ ifFalse: [$?]]!
Item was removed:
- ----- Method: InterpreterSimulatorLSB>>charsOfLong: (in category 'debug support') -----
- charsOfLong: long
- ^ (1 to: 4) collect:
- [:i | ((long digitAt: i) between: 14 and: 126)
- ifTrue: [(long digitAt: i) asCharacter]
- ifFalse: [$?]]!
Item was removed:
- ----- Method: InterpreterSimulatorLSB>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitAnd: 16rFFFF!
Item was added:
+ ----- Method: InterpreterSimulatorLSB>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitAnd: 16rFFFF!
Item was removed:
- ----- Method: InterpreterSimulatorLSB>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitShift: -16!
Item was added:
+ ----- Method: InterpreterSimulatorLSB>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitShift: -16!
Item was removed:
- ----- Method: InterpreterSimulatorLSB>>nextLongFrom: (in category 'initialization') -----
- nextLongFrom: aStream
- "Read a 32- or 64-bit quantity from the given (binary) stream."
-
- ^ aStream nextLittleEndianNumber: BytesPerWord!
Item was added:
+ ----- Method: InterpreterSimulatorLSB>>nextLongFrom: (in category 'initialization') -----
+ nextLongFrom: aStream
+ "Read a 32- or 64-bit quantity from the given (binary) stream."
+
+ ^ aStream nextLittleEndianNumber: BytesPerWord!
Item was removed:
- ----- Method: InterpreterSimulatorLSB>>putLong:toFile: (in category 'image save/restore') -----
- putLong: n toFile: f
- "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
-
- | remainingValue |
-
- remainingValue := n.
- 4 timesRepeat: [
- f nextPut: (remainingValue bitAnd: 16rFF).
- remainingValue := remainingValue bitShift: -8].
-
- self success: true!
Item was added:
+ ----- Method: InterpreterSimulatorLSB>>putLong:toFile: (in category 'image save/restore') -----
+ putLong: n toFile: f
+ "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
+
+ | remainingValue |
+
+ remainingValue := n.
+ 4 timesRepeat: [
+ f nextPut: (remainingValue bitAnd: 16rFF).
+ remainingValue := remainingValue bitShift: -8].
+
+ self success: true!
Item was added:
+ ----- Method: InterpreterSimulatorLSB>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+ "Return the half-word at byteAddress which must be even."
+ | lowBits long |
+ lowBits := byteAddress bitAnd: 2.
+ long := self longAt: byteAddress - lowBits.
+ ^ lowBits = 2
+ ifTrue: [ long bitShift: -16 ]
+ ifFalse: [ long bitAnd: 16rFFFF ].
+ !
Item was removed:
- ----- Method: InterpreterSimulatorLSB>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
- "Return the half-word at byteAddress which must be even."
- | lowBits long |
- lowBits := byteAddress bitAnd: 2.
- long := self longAt: byteAddress - lowBits.
- ^ lowBits = 2
- ifTrue: [ long bitShift: -16 ]
- ifFalse: [ long bitAnd: 16rFFFF ].
- !
Item was added:
+ ----- Method: InterpreterSimulatorLSB>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ "Return the half-word at byteAddress which must be even."
+ | lowBits long longAddress |
+ lowBits := byteAddress bitAnd: 2.
+ lowBits = 0
+ ifTrue:
+ [ "storing into LS word"
+ long := self longAt: byteAddress.
+ self longAt: byteAddress
+ put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)
+ ]
+ ifFalse:
+ [longAddress := byteAddress - 2.
+ long := self longAt: longAddress.
+ self longAt: longAddress
+ put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))
+ ]!
Item was removed:
- ----- Method: InterpreterSimulatorLSB>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- "Return the half-word at byteAddress which must be even."
- | lowBits long longAddress |
- lowBits := byteAddress bitAnd: 2.
- lowBits = 0
- ifTrue:
- [ "storing into LS word"
- long := self longAt: byteAddress.
- self longAt: byteAddress
- put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)
- ]
- ifFalse:
- [longAddress := byteAddress - 2.
- long := self longAt: longAddress.
- self longAt: longAddress
- put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))
- ]!
Item was added:
+ ----- Method: InterpreterSimulatorLSB>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ "return 0 for little endian, 1 for big endian"
+ ^0!
Item was removed:
- ----- Method: InterpreterSimulatorLSB>>vmEndianness (in category 'memory access') -----
- vmEndianness
- "return 0 for little endian, 1 for big endian"
- ^0!
Item was added:
+ ----- Method: InterpreterSimulatorLSB64>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+
+ "Return the 32-bit word at byteAddress which must be 0 mod 4."
+ | lowBits long |
+ lowBits := byteAddress bitAnd: 4.
+ long := self longAt: byteAddress - lowBits.
+ ^ lowBits = 4
+ ifTrue: [ long bitShift: -32 ]
+ ifFalse: [ long bitAnd: 16rFFFFFFFF ].
+ !
Item was removed:
- ----- Method: InterpreterSimulatorLSB64>>long32At: (in category 'memory access') -----
- long32At: byteAddress
-
- "Return the 32-bit word at byteAddress which must be 0 mod 4."
- | lowBits long |
- lowBits := byteAddress bitAnd: 4.
- long := self longAt: byteAddress - lowBits.
- ^ lowBits = 4
- ifTrue: [ long bitShift: -32 ]
- ifFalse: [ long bitAnd: 16rFFFFFFFF ].
- !
Item was added:
+ ----- Method: InterpreterSimulatorLSB64>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ "Store the 32-bit value at byteAddress which must be 0 mod 4."
+ | lowBits long64 longAddress |
+ lowBits := byteAddress bitAnd: 4.
+ lowBits = 0
+ ifTrue:
+ [ "storing into LS word"
+ long64 := self longAt: byteAddress.
+ self longAt: byteAddress
+ put: ((long64 bitAnd: 16rFFFFFFFF00000000) bitOr: a32BitValue)
+ ]
+ ifFalse:
+ [longAddress := byteAddress - 4.
+ long64 := self longAt: longAddress.
+ self longAt: longAddress
+ put: ((long64 bitAnd: 16rFFFFFFFF) bitOr: (a32BitValue bitShift: 32))
+ ]!
Item was removed:
- ----- Method: InterpreterSimulatorLSB64>>long32At:put: (in category 'memory access') -----
- long32At: byteAddress put: a32BitValue
- "Store the 32-bit value at byteAddress which must be 0 mod 4."
- | lowBits long64 longAddress |
- lowBits := byteAddress bitAnd: 4.
- lowBits = 0
- ifTrue:
- [ "storing into LS word"
- long64 := self longAt: byteAddress.
- self longAt: byteAddress
- put: ((long64 bitAnd: 16rFFFFFFFF00000000) bitOr: a32BitValue)
- ]
- ifFalse:
- [longAddress := byteAddress - 4.
- long64 := self longAt: longAddress.
- self longAt: longAddress
- put: ((long64 bitAnd: 16rFFFFFFFF) bitOr: (a32BitValue bitShift: 32))
- ]!
Item was changed:
----- Method: InterpreterSimulatorLSB64>>wordSize (in category 'memory access') -----
wordSize
"overridden for 64-bit images..."
^8!
Item was changed:
----- Method: InterpreterSimulatorMSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits bpwMinus1 |
bpwMinus1 := BytesPerWord-1.
lowBits := byteAddress bitAnd: bpwMinus1.
^ ((self longAt: byteAddress - lowBits)
bitShift: (lowBits - bpwMinus1) * 8)
bitAnd: 16rFF!
Item was changed:
----- Method: InterpreterSimulatorMSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| longWord shift lowBits bpwMinus1 longAddress |
bpwMinus1 := BytesPerWord-1.
lowBits := byteAddress bitAnd: bpwMinus1.
longAddress := byteAddress - lowBits.
longWord := self longAt: longAddress.
shift := (bpwMinus1 - lowBits) * 8.
longWord := longWord
- (longWord bitAnd: (16rFF bitShift: shift))
+ (byte bitShift: shift).
self longAt: longAddress put: longWord.
^byte!
Item was removed:
- ----- Method: InterpreterSimulatorMSB>>charsOfLong: (in category 'debug support') -----
- charsOfLong: long
- ^ (BytesPerWord to: 1 by: -1) collect:
- [:i | ((long digitAt: i) between: 14 and: 126)
- ifTrue: [(long digitAt: i) asCharacter]
- ifFalse: [$?]]!
Item was added:
+ ----- Method: InterpreterSimulatorMSB>>charsOfLong: (in category 'debug support') -----
+ charsOfLong: long
+ ^ (BytesPerWord to: 1 by: -1) collect:
+ [:i | ((long digitAt: i) between: 14 and: 126)
+ ifTrue: [(long digitAt: i) asCharacter]
+ ifFalse: [$?]]!
Item was added:
+ ----- Method: InterpreterSimulatorMSB>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitShift: -16!
Item was removed:
- ----- Method: InterpreterSimulatorMSB>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitShift: -16!
Item was added:
+ ----- Method: InterpreterSimulatorMSB>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitAnd: 16rFFFF!
Item was removed:
- ----- Method: InterpreterSimulatorMSB>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitAnd: 16rFFFF!
Item was added:
+ ----- Method: InterpreterSimulatorMSB>>nextLongFrom: (in category 'initialization') -----
+ nextLongFrom: aStream
+ "Read a 32- or 64-bit quantity from the given (binary) stream."
+
+ ^ aStream nextNumber: BytesPerWord!
Item was removed:
- ----- Method: InterpreterSimulatorMSB>>nextLongFrom: (in category 'initialization') -----
- nextLongFrom: aStream
- "Read a 32- or 64-bit quantity from the given (binary) stream."
-
- ^ aStream nextNumber: BytesPerWord!
Item was added:
+ ----- Method: InterpreterSimulatorMSB>>putLong:toFile: (in category 'image save/restore') -----
+ putLong: n toFile: f
+ "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
+
+ f
+ nextPut: (n bitShift: -24);
+ nextPut: ((n bitShift: -16) bitAnd: 16rFF);
+ nextPut: ((n bitShift: -8) bitAnd: 16rFF);
+ nextPut: (n bitAnd: 16rFF).
+
+ self success: true!
Item was removed:
- ----- Method: InterpreterSimulatorMSB>>putLong:toFile: (in category 'image save/restore') -----
- putLong: n toFile: f
- "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
-
- f
- nextPut: (n bitShift: -24);
- nextPut: ((n bitShift: -16) bitAnd: 16rFF);
- nextPut: ((n bitShift: -8) bitAnd: 16rFF);
- nextPut: (n bitAnd: 16rFF).
-
- self success: true!
Item was removed:
- ----- Method: InterpreterSimulatorMSB>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
- "Return the half-word at byteAddress which must be even."
- | lowBits bpwMinus2 |
- bpwMinus2 := BytesPerWord-2.
- lowBits := byteAddress bitAnd: bpwMinus2.
- ^ ((self longAt: byteAddress - lowBits)
- bitShift: (lowBits - bpwMinus2) * 8)
- bitAnd: 16rFFFF
- !
Item was added:
+ ----- Method: InterpreterSimulatorMSB>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+ "Return the half-word at byteAddress which must be even."
+ | lowBits bpwMinus2 |
+ bpwMinus2 := BytesPerWord-2.
+ lowBits := byteAddress bitAnd: bpwMinus2.
+ ^ ((self longAt: byteAddress - lowBits)
+ bitShift: (lowBits - bpwMinus2) * 8)
+ bitAnd: 16rFFFF
+ !
Item was added:
+ ----- Method: InterpreterSimulatorMSB>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ "Return the half-word at byteAddress which must be even."
+ | longWord shift lowBits bpwMinus2 longAddress |
+ bpwMinus2 := BytesPerWord-2.
+ lowBits := byteAddress bitAnd: bpwMinus2.
+ longAddress := byteAddress - lowBits.
+ longWord := self longAt: longAddress.
+ shift := (bpwMinus2 - lowBits) * 8.
+ longWord := longWord
+ - (longWord bitAnd: (16rFFFF bitShift: shift))
+ + (a16BitValue bitShift: shift).
+ self longAt: longAddress put: longWord
+ !
Item was removed:
- ----- Method: InterpreterSimulatorMSB>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- "Return the half-word at byteAddress which must be even."
- | longWord shift lowBits bpwMinus2 longAddress |
- bpwMinus2 := BytesPerWord-2.
- lowBits := byteAddress bitAnd: bpwMinus2.
- longAddress := byteAddress - lowBits.
- longWord := self longAt: longAddress.
- shift := (bpwMinus2 - lowBits) * 8.
- longWord := longWord
- - (longWord bitAnd: (16rFFFF bitShift: shift))
- + (a16BitValue bitShift: shift).
- self longAt: longAddress put: longWord
- !
Item was added:
+ ----- Method: InterpreterSimulatorMSB>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ "return 0 for little endian, 1 for big endian"
+ ^1!
Item was removed:
- ----- Method: InterpreterSimulatorMSB>>vmEndianness (in category 'memory access') -----
- vmEndianness
- "return 0 for little endian, 1 for big endian"
- ^1!
Item was changed:
----- Method: InterpreterSimulatorMSB64>>byteSwapped: (in category 'memory access') -----
byteSwapped: w
"Return the given integer with its bytes in the reverse order."
^ (super byteSwapped: ((w bitShift: -32) bitAnd: 16rFFFFFFFF)) +
((super byteSwapped: (w bitAnd: 16rFFFFFFFF)) bitShift: 32)!
Item was added:
+ ----- Method: InterpreterSimulatorMSB64>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+ "Return the 32-bit word at byteAddress which must be 0 mod 4."
+
+ ^ super longAt: byteAddress!
Item was removed:
- ----- Method: InterpreterSimulatorMSB64>>long32At: (in category 'memory access') -----
- long32At: byteAddress
- "Return the 32-bit word at byteAddress which must be 0 mod 4."
-
- ^ super longAt: byteAddress!
Item was added:
+ ----- Method: InterpreterSimulatorMSB64>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ "Store the 32-bit value at byteAddress which must be 0 mod 4."
+
+ super longAt: byteAddress put: a32BitValue!
Item was removed:
- ----- Method: InterpreterSimulatorMSB64>>long32At:put: (in category 'memory access') -----
- long32At: byteAddress put: a32BitValue
- "Store the 32-bit value at byteAddress which must be 0 mod 4."
-
- super longAt: byteAddress put: a32BitValue!
Item was removed:
- ----- Method: InterpreterSimulatorMSB64>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- ^ ((super longAt: byteAddress) bitShift: 32) bitOr: (super longAt: byteAddress + 4)!
Item was added:
+ ----- Method: InterpreterSimulatorMSB64>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+
+ ^ ((super longAt: byteAddress) bitShift: 32) bitOr: (super longAt: byteAddress + 4)!
Item was removed:
- ----- Method: InterpreterSimulatorMSB64>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a64BitValue
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- super longAt: byteAddress put: (a64BitValue bitShift: -32).
- super longAt: byteAddress + 4 put: (a64BitValue bitAnd: 16rFFFFFFFF).
- ^ a64BitValue!
Item was added:
+ ----- Method: InterpreterSimulatorMSB64>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a64BitValue
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+
+ super longAt: byteAddress put: (a64BitValue bitShift: -32).
+ super longAt: byteAddress + 4 put: (a64BitValue bitAnd: 16rFFFFFFFF).
+ ^ a64BitValue!
Item was changed:
----- Method: InterpreterSimulatorMSB64>>wordSize (in category 'memory access') -----
wordSize
"overridden for 64-bit images..."
^8!
Item was removed:
- ----- Method: InterpreterStackPage class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a StackPage struct."
-
- self allInstVarNames do:
- [:ivn|
- ivn ~= 'stackPagesMemory' ifTrue:
- [aBinaryBlock
- value: ivn
- value: (ivn = 'trace'
- ifTrue: [#int]
- ifFalse:
- [(ivn endsWith: 'Page')
- ifTrue: ['struct _StackPage *']
- ifFalse: [#'char *']])]]!
Item was added:
+ ----- Method: InterpreterStackPage class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a StackPage struct."
+
+ self allInstVarNames do:
+ [:ivn|
+ ivn ~= 'stackPagesMemory' ifTrue:
+ [aBinaryBlock
+ value: ivn
+ value: (ivn = 'trace'
+ ifTrue: [#int]
+ ifFalse:
+ [(ivn endsWith: 'Page')
+ ifTrue: ['struct _StackPage *']
+ ifFalse: [#'char *']])]]!
Item was changed:
----- Method: InterpreterStackPage class>>surrogateClass (in category 'simulation only') -----
surrogateClass
^BytesPerWord = 4
ifTrue: [CogStackPageSurrogate32]
ifFalse: [CogStackPageSurrogate64]!
Item was changed:
----- Method: InterpreterStackPage>>address (in category 'simulation only') -----
address
<doNotGenerate>
^baseAddress!
Item was changed:
----- Method: InterpreterStackPages>>byteAt: (in category 'memory access') -----
byteAt: byteAddress "<Integer>"
self subclassResponsibility!
Item was removed:
- ----- Method: InterpreterStackPages>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
- self assert: (byteAddress bitAnd: BytesPerWord - 1) == 0.
- ^stackMemory at: byteAddress // BytesPerWord + indexOffset!
Item was added:
+ ----- Method: InterpreterStackPages>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+ self assert: (byteAddress bitAnd: BytesPerWord - 1) == 0.
+ ^stackMemory at: byteAddress // BytesPerWord + indexOffset!
Item was removed:
- ----- Method: InterpreterStackPages>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a32BitValue
- "Note: Adjusted for Smalltalk's 1-based array indexing."
- self assert: (byteAddress bitAnd: BytesPerWord - 1) == 0.
- ^stackMemory at: byteAddress // BytesPerWord + indexOffset put: a32BitValue!
Item was added:
+ ----- Method: InterpreterStackPages>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+ self assert: (byteAddress bitAnd: BytesPerWord - 1) == 0.
+ ^stackMemory at: byteAddress // BytesPerWord + indexOffset put: a32BitValue!
Item was changed:
----- Method: InterpreterStackPages>>writeEnableMemory (in category 'memory access') -----
writeEnableMemory
<doNotGenerate>
stackMemory := stackMemory array!
Item was changed:
----- Method: InterpreterStackPages>>writeProtectMemory (in category 'memory access') -----
writeProtectMemory
<doNotGenerate>
stackMemory := ReadOnlyArrayWrapper around: stackMemory!
Item was changed:
----- Method: InterpreterStackPagesLSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits long |
lowBits := byteAddress bitAnd: 3.
long := self longAt: byteAddress - lowBits.
^(lowBits caseOf: {
[0] -> [ long ].
[1] -> [ long bitShift: -8 ].
[2] -> [ long bitShift: -16 ].
[3] -> [ long bitShift: -24 ]
}) bitAnd: 16rFF!
Item was changed:
----- Method: InterpreterStackPagesLSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| lowBits long longAddress |
lowBits := byteAddress bitAnd: 3.
longAddress := byteAddress - lowBits.
long := self longAt: longAddress.
long := lowBits caseOf: {
[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16) ].
[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24) ]
}.
self longAt: longAddress put: long.
^byte!
Item was changed:
----- Method: InterpreterStackPagesMSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits bpwMinus1 |
bpwMinus1 := StackInterpreter wordSize - 1.
lowBits := byteAddress bitAnd: bpwMinus1.
^((self longAt: byteAddress - lowBits)
bitShift: (lowBits - bpwMinus1) * 8)
bitAnd: 16rFF!
Item was added:
+ ----- Method: LittleEndianBitmap>>longAt: (in category 'accessing') -----
+ longAt: byteIndex
+ ^self longAt: byteIndex bigEndian: false!
Item was removed:
- ----- Method: LittleEndianBitmap>>longAt: (in category 'accessing') -----
- longAt: byteIndex
- ^self longAt: byteIndex bigEndian: false!
Item was added:
+ ----- Method: LittleEndianBitmap>>longAt:put: (in category 'accessing') -----
+ longAt: byteIndex put: aValue
+ "Compatibility with the ByteArray method of the same name."
+ | lowBits wordIndex value mask |
+ lowBits := byteIndex - 1 bitAnd: 3.
+ wordIndex := byteIndex - 1 // 4 + 1.
+ value := aValue < 0
+ ifTrue: [16rFFFFFFFF bitAnd: aValue]
+ ifFalse: [16rFFFFFFFF < aValue ifTrue:
+ [self errorImproperStore].
+ aValue].
+ lowBits = 0 ifTrue:
+ [self at: wordIndex put: value.
+ ^aValue].
+ mask := 16rFFFFFFFF bitAnd: 16rFFFFFFFF << (lowBits * 8).
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask bitInvert) bitXor: (value << (lowBits * 8) bitAnd: mask)).
+ self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask) bitXor: (value >> (4 - lowBits * 8) bitAnd: mask bitInvert)).
+ ^aValue
+
+ "(1 to: 8) collect:
+ [:ba| | bm |
+ bm := LittleEndianBitmap new: 4.
+ bm at: 1 put: 16r55555555.
+ bm at: 2 put: 16rAAAAAAAA.
+ bm longAt: ba put: 16r04030201.
+ { (bm at: 1) hex. (bm at: 2) hex }]"!
Item was removed:
- ----- Method: LittleEndianBitmap>>longAt:put: (in category 'accessing') -----
- longAt: byteIndex put: aValue
- "Compatibility with the ByteArray method of the same name."
- | lowBits wordIndex value mask |
- lowBits := byteIndex - 1 bitAnd: 3.
- wordIndex := byteIndex - 1 // 4 + 1.
- value := aValue < 0
- ifTrue: [16rFFFFFFFF bitAnd: aValue]
- ifFalse: [16rFFFFFFFF < aValue ifTrue:
- [self errorImproperStore].
- aValue].
- lowBits = 0 ifTrue:
- [self at: wordIndex put: value.
- ^aValue].
- mask := 16rFFFFFFFF bitAnd: 16rFFFFFFFF << (lowBits * 8).
- self at: wordIndex put: (((self at: wordIndex) bitAnd: mask bitInvert) bitXor: (value << (lowBits * 8) bitAnd: mask)).
- self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask) bitXor: (value >> (4 - lowBits * 8) bitAnd: mask bitInvert)).
- ^aValue
-
- "(1 to: 8) collect:
- [:ba| | bm |
- bm := LittleEndianBitmap new: 4.
- bm at: 1 put: 16r55555555.
- bm at: 2 put: 16rAAAAAAAA.
- bm longAt: ba put: 16r04030201.
- { (bm at: 1) hex. (bm at: 2) hex }]"!
Item was changed:
----- Method: NewCoObjectMemory>>cheapAddressCouldBeInHeap: (in category 'debug support') -----
cheapAddressCouldBeInHeap: address
^(address bitAnd: self wordSize - 1) = 0
and: [(self oop: address isGreaterThanOrEqualTo: self startOfMemory)
and: [self oop: address isLessThan: freeStart]]!
Item was changed:
----- Method: NewCoObjectMemory>>clearLeakMapAndMapAccessibleObjects (in category 'debug support') -----
clearLeakMapAndMapAccessibleObjects
"Perform an integrity/leak check using the heapMap. Set a bit at each object's header.
Override to set a bit at each Cog method"
super clearLeakMapAndMapAccessibleObjects.
cogit addCogMethodsToHeapMap!
Item was changed:
----- Method: NewCoObjectMemory>>memoryBaseForImageRead (in category 'image save/restore') -----
memoryBaseForImageRead
"Answer the address to read the image into."
^coInterpreter heapBase!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator class>>new (in category 'instance creation') -----
+ new
+ ^self == NewCoObjectMemorySimulator
+ ifTrue: [SmalltalkImage current endianness == #big
+ ifTrue: [NewCoObjectMemorySimulatorMSB new]
+ ifFalse: [NewCoObjectMemorySimulatorLSB new]]
+ ifFalse: [super new]!
Item was removed:
- ----- Method: NewCoObjectMemorySimulator class>>new (in category 'instance creation') -----
- new
- ^self == NewCoObjectMemorySimulator
- ifTrue: [SmalltalkImage current endianness == #big
- ifTrue: [NewCoObjectMemorySimulatorMSB new]
- ifFalse: [NewCoObjectMemorySimulatorLSB new]]
- ifFalse: [super new]!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator class>>vmProxyMajorVersion (in category 'simulation only') -----
+ vmProxyMajorVersion
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^CoInterpreter vmProxyMajorVersion!
Item was removed:
- ----- Method: NewCoObjectMemorySimulator class>>vmProxyMajorVersion (in category 'simulation only') -----
- vmProxyMajorVersion
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^CoInterpreter vmProxyMajorVersion!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator class>>vmProxyMinorVersion (in category 'simulation only') -----
+ vmProxyMinorVersion
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^CoInterpreter vmProxyMinorVersion!
Item was removed:
- ----- Method: NewCoObjectMemorySimulator class>>vmProxyMinorVersion (in category 'simulation only') -----
- vmProxyMinorVersion
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^CoInterpreter vmProxyMinorVersion!
Item was changed:
----- Method: NewCoObjectMemorySimulatorMSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits bpwMinus1 |
bpwMinus1 := BytesPerWord-1.
lowBits := byteAddress bitAnd: bpwMinus1.
^ ((self longAt: byteAddress - lowBits)
bitShift: (lowBits - bpwMinus1) * 8)
bitAnd: 16rFF!
Item was changed:
----- Method: NewCoObjectMemorySimulatorMSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| longWord shift lowBits bpwMinus1 longAddress |
bpwMinus1 := BytesPerWord-1.
lowBits := byteAddress bitAnd: bpwMinus1.
longAddress := byteAddress - lowBits.
longWord := self longAt: longAddress.
shift := (bpwMinus1 - lowBits) * 8.
longWord := longWord
- (longWord bitAnd: (16rFF bitShift: shift))
+ (byte bitShift: shift).
self assert: longAddress < freeStart.
self longAt: longAddress put: longWord.
^byte!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>charsOfLong: (in category 'debug support') -----
+ charsOfLong: long
+ ^ (BytesPerWord to: 1 by: -1) collect:
+ [:i | ((long digitAt: i) between: 14 and: 126)
+ ifTrue: [(long digitAt: i) asCharacter]
+ ifFalse: [$?]]!
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>charsOfLong: (in category 'debug support') -----
- charsOfLong: long
- ^ (BytesPerWord to: 1 by: -1) collect:
- [:i | ((long digitAt: i) between: 14 and: 126)
- ifTrue: [(long digitAt: i) asCharacter]
- ifFalse: [$?]]!
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>fetchFloatAt:into: (in category 'float primitives') -----
- fetchFloatAt: floatBitsAddress into: aFloat
- aFloat at: 1 put: (self long32At: floatBitsAddress).
- aFloat at: 2 put: (self long32At: floatBitsAddress+4)!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>fetchFloatAt:into: (in category 'float primitives') -----
+ fetchFloatAt: floatBitsAddress into: aFloat
+ aFloat at: 1 put: (self long32At: floatBitsAddress).
+ aFloat at: 2 put: (self long32At: floatBitsAddress+4)!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitShift: -16!
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitShift: -16!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitAnd: 16rFFFF!
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitAnd: 16rFFFF!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>nextLongFrom: (in category 'image save/restore') -----
+ nextLongFrom: aStream
+ "Read a 32- or 64-bit quantity from the given (binary) stream."
+
+ ^ aStream nextNumber: BytesPerWord!
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>nextLongFrom: (in category 'image save/restore') -----
- nextLongFrom: aStream
- "Read a 32- or 64-bit quantity from the given (binary) stream."
-
- ^ aStream nextNumber: BytesPerWord!
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>nextShortFrom: (in category 'image save/restore') -----
- nextShortFrom: aStream
- "Read a 16-bit quantity from the given (binary) stream."
- ^aStream nextNumber: 2!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>nextShortFrom: (in category 'image save/restore') -----
+ nextShortFrom: aStream
+ "Read a 16-bit quantity from the given (binary) stream."
+ ^aStream nextNumber: 2!
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>putLong:toFile: (in category 'image save/restore') -----
- putLong: n toFile: f
- "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
-
- [f nextNumber: 4 put: n]
- on: Error
- do: [:ex| coInterpreter success: false]!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>putLong:toFile: (in category 'image save/restore') -----
+ putLong: n toFile: f
+ "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
+
+ [f nextNumber: 4 put: n]
+ on: Error
+ do: [:ex| coInterpreter success: false]!
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>putShort:toFile: (in category 'image save/restore') -----
- putShort: n toFile: f
- "Append the given 2-byte half-word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
-
- [f nextNumber: 2 put: n]
- on: Error
- do: [:ex| coInterpreter success: false]!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>putShort:toFile: (in category 'image save/restore') -----
+ putShort: n toFile: f
+ "Append the given 2-byte half-word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
+
+ [f nextNumber: 2 put: n]
+ on: Error
+ do: [:ex| coInterpreter success: false]!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+ "Return the half-word at byteAddress which must be even."
+ | lowBits bpwMinus2 |
+ bpwMinus2 := BytesPerWord-2.
+ lowBits := byteAddress bitAnd: bpwMinus2.
+ ^ ((self longAt: byteAddress - lowBits)
+ bitShift: (lowBits - bpwMinus2) * 8)
+ bitAnd: 16rFFFF
+ !
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
- "Return the half-word at byteAddress which must be even."
- | lowBits bpwMinus2 |
- bpwMinus2 := BytesPerWord-2.
- lowBits := byteAddress bitAnd: bpwMinus2.
- ^ ((self longAt: byteAddress - lowBits)
- bitShift: (lowBits - bpwMinus2) * 8)
- bitAnd: 16rFFFF
- !
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ "Return the half-word at byteAddress which must be even."
+ | longWord shift lowBits bpwMinus2 longAddress |
+ bpwMinus2 := BytesPerWord-2.
+ lowBits := byteAddress bitAnd: bpwMinus2.
+ longAddress := byteAddress - lowBits.
+ longWord := self longAt: longAddress.
+ shift := (bpwMinus2 - lowBits) * 8.
+ longWord := longWord
+ - (longWord bitAnd: (16rFFFF bitShift: shift))
+ + (a16BitValue bitShift: shift).
+ self longAt: longAddress put: longWord
+ !
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- "Return the half-word at byteAddress which must be even."
- | longWord shift lowBits bpwMinus2 longAddress |
- bpwMinus2 := BytesPerWord-2.
- lowBits := byteAddress bitAnd: bpwMinus2.
- longAddress := byteAddress - lowBits.
- longWord := self longAt: longAddress.
- shift := (bpwMinus2 - lowBits) * 8.
- longWord := longWord
- - (longWord bitAnd: (16rFFFF bitShift: shift))
- + (a16BitValue bitShift: shift).
- self longAt: longAddress put: longWord
- !
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>storeFloatAt:from: (in category 'float primitives') -----
- storeFloatAt: floatBitsAddress from: aFloat
-
- self long32At: floatBitsAddress put: (aFloat at: 1).
- self long32At: floatBitsAddress+4 put: (aFloat at: 2)!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>storeFloatAt:from: (in category 'float primitives') -----
+ storeFloatAt: floatBitsAddress from: aFloat
+
+ self long32At: floatBitsAddress put: (aFloat at: 1).
+ self long32At: floatBitsAddress+4 put: (aFloat at: 2)!
Item was added:
+ ----- Method: NewCoObjectMemorySimulatorMSB>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ "return 0 for little endian, 1 for big endian"
+ ^1!
Item was removed:
- ----- Method: NewCoObjectMemorySimulatorMSB>>vmEndianness (in category 'memory access') -----
- vmEndianness
- "return 0 for little endian, 1 for big endian"
- ^1!
Item was changed:
----- Method: NewObjectMemory>>addressCouldBeObj: (in category 'debug support') -----
addressCouldBeObj: address
<api>
"Answer if address appears to be that of an object, which implies it is
safe to fetch the class and size. For code disassembly and assertions."
^(address bitAnd: 3) = 0
and: [address asUnsignedInteger >= self startOfMemory
and: [address asUnsignedInteger < freeStart
and: [(self headerType: address) ~= HeaderTypeGC]]]!
Item was changed:
----- Method: NewObjectMemory>>addressCouldBeObjWhileForwarding: (in category 'debug support') -----
addressCouldBeObjWhileForwarding: address
"Answer if address appears to be that of an object, which implies it is
safe to fetch the class and size. For code disassembly and assertions."
^(address bitAnd: 3) = 0
and: [address asUnsignedInteger >= self startOfMemory
and: [address asUnsignedInteger < freeStart]]!
Item was added:
+ ----- Method: NewObjectMemory>>allInstancesOf: (in category 'primitive support') -----
+ allInstancesOf: aBehavior
+ "Attempt to answer all instances of aBehavior, failing if there is not enough room."
+ | count container fillPointer obj byteSize afterPreAllocatedObject |
+ "Allocate a large header Array of sufficient size to require a large header.
+ Reset its size later."
+ container := self instantiateClass: (self splObj: ClassArray) indexableSize: self minLargeHeaderSize.
+ self sizeHeader: container putBodySize: 0.
+ afterPreAllocatedObject := freeStart.
+ freeStart := fillPointer := (self firstFixedField: container) asInteger.
+ count := 0.
+ obj := self firstObject.
+ [self oop: obj isLessThan: container] whileTrue:
+ [(self isFreeObject: obj) ifFalse:
+ [(self fetchClassOfNonImm: obj) = aBehavior ifTrue:
+ [count := count + 1.
+ fillPointer < reserveStart ifTrue:
+ [self longAt: fillPointer put: obj.
+ fillPointer := fillPointer + BytesPerOop]]].
+ obj := self accessibleObjectAfter: obj].
+ fillPointer >= reserveStart ifTrue: "didn't fit. refill with allocation check pattern and answer count."
+ [self maybeFillWithAllocationCheckFillerFrom: freeStart to: fillPointer.
+ ^self integerObjectOf: count].
+ byteSize := fillPointer - (self firstFixedField: container) asInteger.
+ self sizeHeader: container putBodySize: byteSize.
+ "Need to refill with the allocation check pattern if we shortened the object."
+ fillPointer < afterPreAllocatedObject ifTrue:
+ [self maybeFillWithAllocationCheckFillerFrom: fillPointer to: afterPreAllocatedObject].
+ freeStart := fillPointer.
+ ^container!
Item was changed:
----- Method: NewObjectMemory>>checkHeapIntegrity (in category 'memory access') -----
checkHeapIntegrity
"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 obj sz hdr fmt fi fieldOop numRootsInHeap |
<inline: false>
ok := true.
numRootsInHeap := 0.
obj := self firstObject.
[self oop: obj isLessThan: self startOfFreeSpace] whileTrue:
[(self isFreeObject: obj)
ifTrue:
[sz := self sizeOfFree: obj]
ifFalse:
[hdr := self baseHeader: obj.
(self isYoungRootHeader: hdr) ifTrue:
[numRootsInHeap := numRootsInHeap + 1].
(self compactClassIndexOfHeader: hdr) = 0 ifTrue:
[fieldOop := (self classHeader: obj) bitAnd: AllButTypeMask.
((self isIntegerObject: fieldOop)
or: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
[self print: 'object leak in '; printHex: obj; print: ' class = '; printHex: fieldOop; cr.
self eek.
ok := false]].
fmt := self formatOfHeader: hdr.
(fmt <= 4 "pointers" or: [fmt >= 12 "compiled method"]) ifTrue:
[fmt >= 12
ifTrue: [fi := (self literalCountOf: obj) + LiteralStart]
ifFalse: [(fmt = 3 and: [self isContextHeader: hdr])
ifTrue: [fi := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: obj)]
ifFalse: [fi := self lengthOf: obj]].
[(fi := fi - 1) >= 0] whileTrue:
[fieldOop := self fetchPointer: fi ofObject: obj.
(self isNonIntegerObject: fieldOop) ifTrue:
[(fieldOop bitAnd: BytesPerWord - 1) ~= 0
ifTrue:
[self 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:
[self print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
self eek.
ok := false]]]]].
sz := self sizeBitsOf: obj].
obj := self oopFromChunk: obj + sz].
numRootsInHeap ~= rootTableCount ifTrue:
[self print: 'root count mismatch. #heap roots '; printNum: numRootsInHeap; print: '; #roots '; printNum: rootTableCount; cr.
"But the system copes with overflow..."
ok := rootTableOverflowed and: [needGCFlag]].
1 to: rootTableCount do:
[:ri|
obj := rootTable at: ri.
(obj bitAnd: BytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned oop in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[self print: 'object leak in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[hdr := self baseHeader: obj.
(self isYoungRootHeader: hdr) ifFalse:
[self print: 'non-root in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]]]].
1 to: remapBufferCount do:
[:ri|
obj := remapBuffer at: ri.
(obj bitAnd: BytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[self print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]]].
1 to: extraRootCount do:
[:ri|
obj := (extraRoots at: ri) at: 0.
(obj bitAnd: BytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[self print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
self eek.
ok := false]]].
^ok!
Item was changed:
----- Method: NewObjectMemory>>checkOkayOop: (in category 'debug support') -----
checkOkayOop: oop
"Verify that the given oop is legitimate. Check address, header, and size but not class.
Answer true if OK. Otherwise print reason and answer false."
<api>
<var: #oop type: #usqInt>
| sz type fmt unusedBit |
"address and size checks"
(self isIntegerObject: oop) ifTrue: [ ^true ].
((self oop: oop isGreaterThanOrEqualTo: self startOfMemory) and: [self oop: oop isLessThan: freeStart])
ifFalse: [ self print: 'oop '; printHex: oop; print: ' is not a valid address'; cr. ^false ].
((oop \\ BytesPerWord) = 0)
ifFalse: [ self print: 'oop '; printHex: oop; print: ' is not a word-aligned address'; cr. ^false ].
sz := self sizeBitsOf: oop.
(self oop: oop + sz isLessThanOrEqualTo: freeStart)
ifFalse: [ self print: 'oop '; printHex: oop; print: ' size would make it extend beyond the end of memory'; cr. ^false ].
"header type checks"
type := self headerType: oop.
type = HeaderTypeFree
ifTrue: [ self print: 'oop '; printHex: oop; print: ' is a free chunk, not an object'; cr. ^false ].
type = HeaderTypeShort ifTrue: [
(self compactClassIndexOf: oop) = 0
ifTrue: [ self print: 'oop '; printHex: oop; print: ' cannot have zero compact class field in a short header'; cr. ^false ].
].
type = HeaderTypeClass ifTrue: [
((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
ifFalse: [ self print: 'oop '; printHex: oop; print: ' class header word has wrong type'; cr. ^false ].
].
type = HeaderTypeSizeAndClass ifTrue: [
((oop >= (BytesPerWord*2)) and:
[(self headerType: oop - (BytesPerWord*2)) = type and:
[(self headerType: oop - BytesPerWord) = type]])
ifFalse: [ self print: 'oop '; printHex: oop; print: ' class header word has wrong type'; cr. ^false ].
].
"format check"
fmt := self formatOf: oop.
((fmt = 5) | (fmt = 7))
ifTrue: [ self print: 'oop '; printHex: oop; print: ' has an unknown format type'; cr. ^false ].
"mark and root bit checks"
unusedBit := 16r20000000.
BytesPerWord = 8
ifTrue:
[unusedBit := unusedBit << 16.
unusedBit := unusedBit << 16].
((self longAt: oop) bitAnd: unusedBit) = 0
ifFalse: [ self print: 'oop '; printHex: oop; print: ' unused header bit 30 is set; should be zero'; cr. ^false ].
"xxx
((self longAt: oop) bitAnd: MarkBit) = 0
ifFalse: [ self print: 'mark bit should not be set except during GC' ].
xxx"
((self isYoungRoot: oop) and: [oop >= youngStart])
ifTrue: [ self print: 'oop '; printHex: oop; print: ' root bit is set in a young object'; cr. ^false ].
^true
!
Item was changed:
----- Method: NewObjectMemory>>classForClassTag: (in category 'interpreter access') -----
classForClassTag: classObj
"Compatibility with SpurObjectMemory. In ObjectMemory there is no distinction between a
classTag in the first-level method cache and a class itself."
^classObj!
Item was changed:
----- Method: NewObjectMemory>>classTagForClass: (in category 'interpreter access') -----
classTagForClass: classObj
"Compatibility with SpurObjectMemory. In ObjectMemory there is no distinction between a
classTag in the first-level method cache and a class itself."
^classObj!
Item was changed:
----- Method: NewObjectMemory>>classTagForSpecialObjectsIndex:compactClassIndex: (in category 'interpreter access') -----
classTagForSpecialObjectsIndex: splObjIndex compactClassIndex: compactClassIndex
"For compatibility with Spur. Answer the class tag to use to lookup a method in the
first-level method lookup cache."
^self splObj: splObjIndex!
Item was changed:
----- Method: NewObjectMemory>>clearLeakMapAndMapAccessibleObjects (in category 'debug support') -----
clearLeakMapAndMapAccessibleObjects
"Perform an integrity/leak check using the heapMap. Set a bit at each object's header."
| obj sz nextHeader |
<inline: false>
<var: #obj type: #usqInt>
<var: #sz type: #usqInt>
<var: #nextHeader type: #usqInt>
heapMap clearHeapMap.
obj := self firstObject.
[self oop: obj isLessThan: freeStart] whileTrue:
[(self isFreeObject: obj)
ifTrue:
[sz := self sizeOfFree: obj]
ifFalse:
[heapMap heapMapAtWord: (self pointerForOop: obj) Put: 1.
sz := self sizeBitsOf: obj].
nextHeader := obj + sz.
obj := self oopFromChunk: nextHeader].!
Item was changed:
----- Method: NewObjectMemory>>decrementFullGCLock (in category 'interpreter access') -----
decrementFullGCLock
self assert: fullGCLock > 0.
(fullGCLock := fullGCLock - 1) < 0 ifTrue:
[fullGCLock := 0]!
Item was changed:
----- Method: NewObjectMemory>>eeInstantiateAndInitializeClass:indexableSize: (in category 'interpreter access') -----
eeInstantiateAndInitializeClass: classPointer indexableSize: size
"NOTE: This method supports the backward-compatible split instSize field of the
class format word. The sizeHiBits will go away and other shifts change by 2
when the split fields get merged in an (incompatible) image change.
Will *not* cause a GC. The instantiated object is initialized."
| hash header1 header2 cClass byteSize format binc header3 hdrSize sizeHiBits bm1 classFormat |
<inline: false>
"cannot have a negative indexable field count"
self assert: size >= 0.
hash := self newObjectHash.
classFormat := self formatOfClass: classPointer.
"Low 2 bits are 0"
header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
header2 := classPointer.
header3 := 0.
sizeHiBits := (classFormat bitAnd: 16r60000) >> 9.
cClass := header1 bitAnd: CompactClassMask. "compact class field from format word"
byteSize := (classFormat bitAnd: SizeMask + Size4Bit) + sizeHiBits.
"size in bytes -- low 2 bits are 0"
"Note this byteSize comes from the format word of the class which is pre-shifted
to 4 bytes per field. Need another shift for 8 bytes per word..."
byteSize := byteSize << (ShiftForWord-2).
format := self formatOfHeader: classFormat.
self flag: #sizeLowBits.
format < self firstByteFormat
ifTrue:
[format = self firstLongFormat
ifTrue: "long32 bitmaps"
[bm1 := BytesPerWord-1.
byteSize := byteSize + (size * 4) + bm1 bitAnd: LongSizeMask. "round up"
binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes"
"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
header1 := header1 bitOr: (binc bitAnd: 4)]
ifFalse: "Arrays and 64-bit bitmaps"
[byteSize := byteSize + (size * BytesPerWord)]]
ifFalse:
["Strings and Methods"
bm1 := BytesPerWord-1.
byteSize := byteSize + size + bm1 bitAnd: LongSizeMask. "round up"
binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes"
"low bits of byte size go in format field"
header1 := header1 bitOr: (binc bitAnd: 3) << self instFormatFieldLSB.
"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
header1 := header1 bitOr: (binc bitAnd: 4)].
byteSize > 255
ifTrue: "requires size header word"
[header3 := byteSize.
header1 := header1]
ifFalse: [header1 := header1 bitOr: byteSize].
hdrSize := header3 > 0
ifTrue: [3] "requires full header"
ifFalse: [cClass = 0 ifTrue: [2] ifFalse: [1]].
^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3 doFill: true format: format!
Item was changed:
----- Method: NewObjectMemory>>eeInstantiateClass:indexableSize: (in category 'interpreter access') -----
eeInstantiateClass: classPointer indexableSize: size
"NOTE: This method supports the backward-compatible split instSize field of the
class format word. The sizeHiBits will go away and other shifts change by 2
when the split fields get merged in an (incompatible) image change.
Will *not* cause a GC.
Note that the instantiated object IS NOT FILLED and must be completed before
returning it to Smalltalk. Since this call is used in routines that do just that we are
safe. Break this rule and die."
<api>
| hash header1 header2 cClass byteSize format binc header3 hdrSize sizeHiBits bm1 classFormat |
<inline: false>
"cannot have a negative indexable field count"
self assert: size >= 0.
hash := self newObjectHash.
classFormat := self formatOfClass: classPointer.
"Low 2 bits are 0"
header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
header2 := classPointer.
header3 := 0.
sizeHiBits := (classFormat bitAnd: 16r60000) >> 9.
cClass := header1 bitAnd: CompactClassMask. "compact class field from format word"
byteSize := (classFormat bitAnd: SizeMask + Size4Bit) + sizeHiBits.
"size in bytes -- low 2 bits are 0"
"Note this byteSize comes from the format word of the class which is pre-shifted
to 4 bytes per field. Need another shift for 8 bytes per word..."
byteSize := byteSize << (ShiftForWord-2).
format := self formatOfHeader: classFormat.
self flag: #sizeLowBits.
format < self firstByteFormat
ifTrue:
[format = self firstLongFormat
ifTrue: "long32 bitmaps"
[bm1 := BytesPerWord-1.
byteSize := byteSize + (size * 4) + bm1 bitAnd: LongSizeMask. "round up"
binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes"
"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
header1 := header1 bitOr: (binc bitAnd: 4)]
ifFalse: "Arrays and 64-bit bitmaps"
[byteSize := byteSize + (size * BytesPerWord)]]
ifFalse:
["Strings and Methods"
bm1 := BytesPerWord-1.
byteSize := byteSize + size + bm1 bitAnd: LongSizeMask. "round up"
binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes"
"low bits of byte size go in format field"
header1 := header1 bitOr: (binc bitAnd: 3) << self instFormatFieldLSB.
"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
header1 := header1 bitOr: (binc bitAnd: 4)].
byteSize > 255
ifTrue: "requires size header word"
[header3 := byteSize.
header1 := header1]
ifFalse: [header1 := header1 bitOr: byteSize].
hdrSize := header3 > 0
ifTrue: [3] "requires full header"
ifFalse: [cClass = 0 ifTrue: [2] ifFalse: [1]].
^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3!
Item was changed:
----- Method: NewObjectMemory>>eeInstantiateClassIndex:format:numSlots: (in category 'interpreter access') -----
eeInstantiateClassIndex: compactClassIndex format: objFormat numSlots: numSlots
"Instantiate an instance of a compact class. ee stands for execution engine and
implies that this allocation will *NOT* cause a GC. N.B. the instantiated object
IS NOT FILLED and must be completed before returning it to Smalltalk. Since this
call is used in routines that do just that we are safe. Break this rule and die in GC.
Result is guaranteed to be young."
<api>
| hash header1 header2 byteSize header3 hdrSize |
<inline: false>
"cannot have a negative indexable field count"
self assert: (numSlots >= 0 and: [compactClassIndex ~= 0]).
self assert: (objFormat < self firstByteFormat
ifTrue: [objFormat]
ifFalse: [objFormat bitAnd: self byteFormatMask])
= (self instSpecOfClass: (self compactClassAt: compactClassIndex)).
hash := self newObjectHash.
"Low 2 bits are 0"
header1 := (objFormat << self instFormatFieldLSB
bitOr: compactClassIndex << 12)
bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
self assert: "sizeHiBits" ((self formatOfClass: (self compactClassAt: compactClassIndex)) bitAnd: 16r60000) >> 9 = 0.
self flag: #sizeLowBits.
"size in bytes -- low 2 bits are 0; may need another shift if 64-bits.
strangely, size includes size of header, but only of single header.
why include header size at all? gives us an extra word."
byteSize := numSlots << (ShiftForWord + (ShiftForWord-2)) + BaseHeaderSize.
(BytesPerWord = 8 "David, please check this!!!!"
and: [objFormat >= self firstLongFormat "32-bit longs and byte objects"
and: [(numSlots bitAnd: 1) ~= 0]]) ifTrue:
["extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
header1 := header1 bitOr: 4].
byteSize > 255 "requires size header word/full header"
ifTrue: [header3 := byteSize. hdrSize := 3. header2 := self compactClassAt: compactClassIndex]
ifFalse: [header1 := header1 bitOr: byteSize. hdrSize := 1].
^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3!
Item was changed:
----- Method: NewObjectMemory>>eeInstantiateMethodContextSlots: (in category 'interpreter access') -----
eeInstantiateMethodContextSlots: numSlots
"This version of instantiateClass assumes that the total object
size is under 256 bytes, the limit for objects with only one or
two header words. Note that the size is specified in bytes
and should include four bytes for the base header word.
Will *not* cause a GC. Result is guaranteed to be young."
| sizeInBytes hash header1 |
self assert: (numSlots = SmallContextSlots or: [numSlots = LargeContextSlots]).
sizeInBytes := numSlots * BytesPerOop + BaseHeaderSize.
self assert: sizeInBytes <= SizeMask.
hash := self newObjectHash.
header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: self formatOfMethodContextMinusSize.
self assert: (header1 bitAnd: CompactClassMask) > 0. "contexts must be compact"
self assert: (header1 bitAnd: SizeMask) = 0.
"OR size into header1. Must not do this if size > SizeMask"
header1 := header1 + sizeInBytes.
^self eeAllocate: sizeInBytes headerSize: 1 h1: header1 h2: nil h3: nil!
Item was changed:
----- Method: NewObjectMemory>>eeInstantiateSmallClass:numSlots: (in category 'interpreter access') -----
eeInstantiateSmallClass: classPointer numSlots: numSlots
"This version of instantiateClass assumes that the total object size is under
256 bytes, the limit for objects with only one or two header words.
NOTE this code will only work for sizes that are an integral number of words
(hence not a 32-bit LargeInteger in a 64-bit system).
Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak.
Since this call is used in routines that do just that we are safe. Break this rule and die in GC.
Will *not* cause a GC. Result is guaranteed to be young."
| sizeInBytes hash header1 header2 hdrSize |
sizeInBytes := numSlots << ShiftForWord + BaseHeaderSize.
self assert: sizeInBytes <= 252.
hash := self newObjectHash.
header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: (self formatOfClass: classPointer).
header2 := classPointer.
hdrSize := (header1 bitAnd: CompactClassMask) > 0 "is this a compact class"
ifTrue: [1]
ifFalse: [2].
header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask+Size4Bit)).
^self eeAllocate: sizeInBytes headerSize: hdrSize h1: header1 h2: header2 h3: 0!
Item was changed:
----- Method: NewObjectMemory>>eeInstantiateSmallClassIndex:format:numSlots: (in category 'interpreter access') -----
eeInstantiateSmallClassIndex: compactClassIndex format: objFormat numSlots: numSlots
"This version of instantiateClass assumes that the total object size is under
256 bytes, the limit for objects with only one or two header words.
NOTE this code will only work for sizes that are an integral number of words
(hence not a 32-bit LargeInteger in a 64-bit system).
Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak.
Since this call is used in routines that do just that we are safe. Break this rule and die in GC.
Will *not* cause a GC. Result is guaranteed to be young."
| sizeInBytes hash header1 |
"cannot have a negative indexable field count"
self assert: (numSlots >= 0 and: [compactClassIndex ~= 0]).
self assert: (objFormat < self firstByteFormat
ifTrue: [objFormat]
ifFalse: [objFormat bitAnd: self byteFormatMask])
= (self instSpecOfClass: (self compactClassAt: compactClassIndex)).
sizeInBytes := numSlots << ShiftForWord + BaseHeaderSize.
self assert: sizeInBytes <= 252.
hash := self newObjectHash.
header1 := (objFormat << self instFormatFieldLSB
bitOr: compactClassIndex << 12)
bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask+Size4Bit)).
^self eeAllocate: sizeInBytes headerSize: 1 h1: header1 h2: 0 h3: 0!
Item was added:
+ ----- Method: NewObjectMemory>>eek (in category 'memory access') -----
+ eek
+ <inline: true>!
Item was removed:
- ----- Method: NewObjectMemory>>eek (in category 'memory access') -----
- eek
- <inline: true>!
Item was changed:
----- Method: NewObjectMemory>>fetchClassTagOf: (in category 'interpreter access') -----
fetchClassTagOf: oop
"Compatibility with SpurObjectMemory. In ObjectMemory there is no distinction between a
classTag in the first-level method cache and a class itself."
^self fetchClassOf: oop!
Item was changed:
----- Method: NewObjectMemory>>fetchClassTagOfNonImm: (in category 'interpreter access') -----
fetchClassTagOfNonImm: oop
"Compatibility with SpurObjectMemory. In ObjectMemory there is no distinction between a
classTag in the first-level method cache and a class itself."
^self fetchClassOfNonImm: oop!
Item was changed:
----- Method: NewObjectMemory>>findString: (in category 'debug support') -----
findString: aCString
"Print the oops of all string-like things that have the same characters as aCString"
<api>
<var: #aCString type: #'char *'>
| cssz obj sz |
cssz := self strlen: aCString.
obj := self firstObject.
[self oop: obj isLessThan: freeStart] whileTrue:
[(self isFreeObject: obj)
ifTrue:
[sz := self sizeOfFree: obj]
ifFalse:
[((self isBytesNonImm: obj)
and: [(self lengthOf: obj) = cssz
and: [(self str: aCString n: (self pointerForOop: obj + BaseHeaderSize) cmp: cssz) = 0]]) ifTrue:
[coInterpreter printHex: obj; space; printOopShort: obj; cr].
sz := self sizeBitsOf: obj].
obj := self oopFromChunk: obj + sz]!
Item was changed:
----- Method: NewObjectMemory>>findStringBeginningWith: (in category 'debug support') -----
findStringBeginningWith: aCString
"Print the oops of all string-like things that start with the same characters as aCString"
<api>
<var: #aCString type: #'char *'>
| cssz obj sz |
cssz := self strlen: aCString.
obj := self firstObject.
[self oop: obj isLessThan: freeStart] whileTrue:
[(self isFreeObject: obj)
ifTrue:
[sz := self sizeOfFree: obj]
ifFalse:
[((self isBytesNonImm: obj)
and: [(self lengthOf: obj) >= cssz
and: [(self str: aCString n: (self pointerForOop: obj + BaseHeaderSize) cmp: cssz) = 0]]) ifTrue:
[coInterpreter printHex: obj; space; printNum: (self lengthOf: obj); space; printOopShort: obj; cr].
sz := self sizeBitsOf: obj].
obj := self oopFromChunk: obj + sz]!
Item was added:
+ ----- Method: NewObjectMemory>>fullGC (in category 'garbage collection') -----
+ fullGC
+ "Do a mark/sweep garbage collection of the entire object memory.
+ Free inaccessible objects but do not move them."
+
+ <inline: false>
+ fullGCLock > 0 ifTrue:
+ [self warning: 'aborting fullGC because fullGCLock > 0'.
+ ^self].
+ self runLeakCheckerForFullGC: true.
+ self preGCAction: GCModeFull.
+ needGCFlag := false.
+ gcStartUsecs := self ioUTCMicrosecondsNow.
+ statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
+ self clearRootsTable.
+ self initWeakTableForIncrementalGC: false.
+ youngStart := self startOfMemory. "process all of memory"
+ self markPhase: true.
+ "Sweep phase returns the number of survivors.
+ Use the up-to-date version instead the one from startup."
+ totalObjectCount := self sweepPhaseForFullGC.
+ self runLeakCheckerForFullGC: true.
+ self fullCompaction.
+ statFullGCs := statFullGCs + 1.
+ statGCEndUsecs := self ioUTCMicrosecondsNow.
+ statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
+ self capturePendingFinalizationSignals.
+
+ youngStart := freeStart. "reset the young object boundary"
+ self postGCAction: GCModeFull.
+ self runLeakCheckerForFullGC: true!
Item was removed:
- ----- Method: NewObjectMemory>>fullGC (in category 'garbage collection') -----
- fullGC
- "Do a mark/sweep garbage collection of the entire object memory.
- Free inaccessible objects but do not move them."
-
- <inline: false>
- fullGCLock > 0 ifTrue:
- [self warning: 'aborting fullGC because fullGCLock > 0'.
- ^self].
- self runLeakCheckerForFullGC: true.
- self preGCAction: GCModeFull.
- needGCFlag := false.
- gcStartUsecs := self ioUTCMicrosecondsNow.
- statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
- self clearRootsTable.
- self initWeakTableForIncrementalGC: false.
- youngStart := self startOfMemory. "process all of memory"
- self markPhase: true.
- "Sweep phase returns the number of survivors.
- Use the up-to-date version instead the one from startup."
- totalObjectCount := self sweepPhaseForFullGC.
- self runLeakCheckerForFullGC: true.
- self fullCompaction.
- statFullGCs := statFullGCs + 1.
- statGCEndUsecs := self ioUTCMicrosecondsNow.
- statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
- self capturePendingFinalizationSignals.
-
- youngStart := freeStart. "reset the young object boundary"
- self postGCAction: GCModeFull.
- self runLeakCheckerForFullGC: true!
Item was changed:
----- Method: NewObjectMemory>>incrementFullGCLock (in category 'interpreter access') -----
incrementFullGCLock
fullGCLock := fullGCLock + 1!
Item was added:
+ ----- Method: NewObjectMemory>>incrementalGC (in category 'garbage collection') -----
+ incrementalGC
+ "Do a mark/sweep garbage collection of just the young object
+ area of object memory (i.e., objects above youngStart), using
+ the root table to identify objects containing pointers to
+ young objects from the old object area."
+ | survivorCount weDidGrow |
+ <inline: false>
+
+ rootTableOverflowed ifTrue:
+ ["root table overflow; cannot do an incremental GC because some roots are missing.
+ (this should be very rare)"
+ statRootTableOverflows := statRootTableOverflows + 1.
+ ^self fullGC].
+ self runLeakCheckerForFullGC: false.
+ coInterpreter preGCAction: GCModeIncr.
+ needGCFlag := false.
+ gcStartUsecs := self ioUTCMicrosecondsNow.
+ statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
+ self initWeakTableForIncrementalGC: true.
+ "implicitly process memory from youngStart to freeStart"
+ self markPhase: false.
+ self assert: weakRootCount <= WeakRootTableSize.
+ 1 to: weakRootCount do:
+ [:i| self finalizeReference: (weakRoots at: i)].
+ survivorCount := self sweepPhase.
+ self runLeakCheckerForFullGC: false.
+ self incrementalCompaction.
+ statIncrGCs := statIncrGCs + 1.
+ statGCEndUsecs := self ioUTCMicrosecondsNow.
+ statIGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
+ statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
+ self capturePendingFinalizationSignals.
+
+ statRootTableCount := rootTableCount.
+ statSurvivorCount := survivorCount.
+ weDidGrow := false.
+ (((survivorCount > tenuringThreshold)
+ or: [rootTableCount >= RootTableRedZone])
+ or: [forceTenureFlag == true]) ifTrue:
+ ["move up the young space boundary if
+ * there are too many survivors:
+ this limits the number of objects that must be
+ processed on future incremental GC's
+ * we're about to overflow the roots table:
+ this limits the number of full GCs that may be caused
+ by root table overflows in the near future"
+ forceTenureFlag := false.
+ statTenures := statTenures + 1.
+ self clearRootsTable.
+ ((self freeSize < growHeadroom)
+ and: [gcBiasToGrow > 0]) ifTrue:
+ [self biasToGrow.
+ weDidGrow := true].
+ youngStart := freeStart].
+ coInterpreter postGCAction: GCModeIncr.
+
+ self runLeakCheckerForFullGC: false.
+ weDidGrow ifTrue:
+ [self biasToGrowCheckGCLimit]!
Item was removed:
- ----- Method: NewObjectMemory>>incrementalGC (in category 'garbage collection') -----
- incrementalGC
- "Do a mark/sweep garbage collection of just the young object
- area of object memory (i.e., objects above youngStart), using
- the root table to identify objects containing pointers to
- young objects from the old object area."
- | survivorCount weDidGrow |
- <inline: false>
-
- rootTableOverflowed ifTrue:
- ["root table overflow; cannot do an incremental GC because some roots are missing.
- (this should be very rare)"
- statRootTableOverflows := statRootTableOverflows + 1.
- ^self fullGC].
- self runLeakCheckerForFullGC: false.
- coInterpreter preGCAction: GCModeIncr.
- needGCFlag := false.
- gcStartUsecs := self ioUTCMicrosecondsNow.
- statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
- self initWeakTableForIncrementalGC: true.
- "implicitly process memory from youngStart to freeStart"
- self markPhase: false.
- self assert: weakRootCount <= WeakRootTableSize.
- 1 to: weakRootCount do:
- [:i| self finalizeReference: (weakRoots at: i)].
- survivorCount := self sweepPhase.
- self runLeakCheckerForFullGC: false.
- self incrementalCompaction.
- statIncrGCs := statIncrGCs + 1.
- statGCEndUsecs := self ioUTCMicrosecondsNow.
- statIGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
- statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
- self capturePendingFinalizationSignals.
-
- statRootTableCount := rootTableCount.
- statSurvivorCount := survivorCount.
- weDidGrow := false.
- (((survivorCount > tenuringThreshold)
- or: [rootTableCount >= RootTableRedZone])
- or: [forceTenureFlag == true]) ifTrue:
- ["move up the young space boundary if
- * there are too many survivors:
- this limits the number of objects that must be
- processed on future incremental GC's
- * we're about to overflow the roots table:
- this limits the number of full GCs that may be caused
- by root table overflows in the near future"
- forceTenureFlag := false.
- statTenures := statTenures + 1.
- self clearRootsTable.
- ((self freeSize < growHeadroom)
- and: [gcBiasToGrow > 0]) ifTrue:
- [self biasToGrow.
- weDidGrow := true].
- youngStart := freeStart].
- coInterpreter postGCAction: GCModeIncr.
-
- self runLeakCheckerForFullGC: false.
- weDidGrow ifTrue:
- [self biasToGrowCheckGCLimit]!
Item was changed:
----- Method: NewObjectMemory>>isYoungObject: (in category 'memory access') -----
isYoungObject: obj
<api>
"Answer if obj is young. Assume obj is non-immediate."
self assert: (self isNonImmediate: obj).
^self oop: obj isGreaterThanOrEqualTo: youngStart!
Item was changed:
----- Method: NewObjectMemory>>leakCheckBecome (in category 'debug support') -----
leakCheckBecome
<api>
^(checkForLeaks bitAnd: 4) ~= 0!
Item was changed:
----- Method: NewObjectMemory>>leakCheckFullGC (in category 'debug support') -----
leakCheckFullGC
<api>
^(checkForLeaks bitAnd: 1) ~= 0!
Item was changed:
----- Method: NewObjectMemory>>leakCheckIncrementalGC (in category 'debug support') -----
leakCheckIncrementalGC
<api>
^(checkForLeaks bitAnd: 2) ~= 0!
Item was changed:
----- Method: NewObjectMemory>>leakCheckNewSpaceGC (in category 'debug support') -----
leakCheckNewSpaceGC
<api>
^(checkForLeaks bitAnd: 2) ~= 0!
Item was added:
+ ----- Method: NewObjectMemory>>noteAsRoot:headerLoc: (in category 'garbage collection') -----
+ noteAsRoot: oop headerLoc: headerLoc
+ "Record that the given oop in the old object area points to an object in the young area.
+ HeaderLoc is usually = oop, but may be an addr in a forwarding block."
+ | header |
+ <inline: true>
+ <asmLabel: false>
+ header := self longAt: headerLoc.
+ (self isYoungRootHeader: header) ifFalse:
+ "record oop as root only if not already recorded"
+ [rootTableCount < RootTableSize
+ ifTrue:
+ "record root if there is enough room in the roots table.
+ IMPORTANT: since clearRootsTable is the only thing that clears root bits
+ do *not* set the root bit unless an object is in the root table. checking
+ routines will complain about the root bit being unset instead of the table
+ being full, but that's life"
+ [rootTableCount := rootTableCount + 1.
+ rootTable at: rootTableCount put: oop.
+ self longAt: headerLoc put: (header bitOr: RootBit).
+ rootTableCount >= RootTableRedZone ifTrue:
+ "if we're now in the red zone force an IGC ASAP"
+ [self scheduleIncrementalGC]]
+ ifFalse: "note overflow; will need to do a fullGC instead of an incremental."
+ [rootTableOverflowed := true]]!
Item was removed:
- ----- Method: NewObjectMemory>>noteAsRoot:headerLoc: (in category 'garbage collection') -----
- noteAsRoot: oop headerLoc: headerLoc
- "Record that the given oop in the old object area points to an object in the young area.
- HeaderLoc is usually = oop, but may be an addr in a forwarding block."
- | header |
- <inline: true>
- <asmLabel: false>
- header := self longAt: headerLoc.
- (self isYoungRootHeader: header) ifFalse:
- "record oop as root only if not already recorded"
- [rootTableCount < RootTableSize
- ifTrue:
- "record root if there is enough room in the roots table.
- IMPORTANT: since clearRootsTable is the only thing that clears root bits
- do *not* set the root bit unless an object is in the root table. checking
- routines will complain about the root bit being unset instead of the table
- being full, but that's life"
- [rootTableCount := rootTableCount + 1.
- rootTable at: rootTableCount put: oop.
- self longAt: headerLoc put: (header bitOr: RootBit).
- rootTableCount >= RootTableRedZone ifTrue:
- "if we're now in the red zone force an IGC ASAP"
- [self scheduleIncrementalGC]]
- ifFalse: "note overflow; will need to do a fullGC instead of an incremental."
- [rootTableOverflowed := true]]!
Item was changed:
----- Method: NewObjectMemory>>numSlotsOf: (in category 'interpreter access') -----
numSlotsOf: obj
"Answer the number of oop-sized elements in the given object.
Unlike lengthOf: this does not adjust the length of a context
by the stackPointer and so can be used e.g. by cloneContext:"
<api>
| header sz |
header := self baseHeader: obj.
sz := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
ifTrue: [(self sizeHeader: obj) bitAnd: AllButTypeMask]
ifFalse: [header bitAnd: SizeMask].
^sz - BaseHeaderSize >> ShiftForWord!
Item was changed:
----- Method: NewObjectMemory>>okayOop: (in category 'debug support') -----
okayOop: signedOop
"Verify that the given oop is legitimate. Check address, header, and size but not class."
| sz type fmt unusedBit oop |
<var: #oop type: #usqInt>
oop := self cCoerce: signedOop to: #usqInt.
"address and size checks"
(self isIntegerObject: oop) ifTrue: [ ^true ].
(oop >= self startOfMemory and: [oop < freeStart])
ifFalse: [ self error: 'oop is not a valid address'. ^false ].
((oop \\ BytesPerWord) = 0)
ifFalse: [ self error: 'oop is not a word-aligned address'. ^false ].
sz := self sizeBitsOf: oop.
(oop + sz) <= freeStart
ifFalse: [ self error: 'oop size would make it extend beyond the end of memory'. ^false ].
"header type checks"
type := self headerType: oop.
type = HeaderTypeFree
ifTrue: [ self error: 'oop is a free chunk, not an object'. ^false ].
type = HeaderTypeShort ifTrue: [
(self compactClassIndexOf: oop) = 0
ifTrue: [ self error: 'cannot have zero compact class field in a short header'. ^false ].
].
type = HeaderTypeClass ifTrue: [
((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
ifFalse: [ self error: 'class header word has wrong type'. ^false ].
].
type = HeaderTypeSizeAndClass ifTrue: [
((oop >= (BytesPerWord*2)) and:
[(self headerType: oop - (BytesPerWord*2)) = type and:
[(self headerType: oop - BytesPerWord) = type]])
ifFalse: [ self error: 'class header word has wrong type'. ^false ].
].
"format check"
fmt := self formatOf: oop.
((fmt = 5) | (fmt = 7))
ifTrue: [ self error: 'oop has an unknown format type'. ^false ].
"mark and root bit checks"
unusedBit := 16r20000000.
BytesPerWord = 8
ifTrue:
[unusedBit := unusedBit << 16.
unusedBit := unusedBit << 16].
((self longAt: oop) bitAnd: unusedBit) = 0
ifFalse: [ self error: 'unused header bit 30 is set; should be zero'. ^false ].
"xxx
((self longAt: oop) bitAnd: MarkBit) = 0
ifFalse: [ self error: 'mark bit should not be set except during GC' ].
xxx"
((self isYoungRoot: oop) and: [oop >= youngStart])
ifTrue: [ self error: 'root bit is set in a young object'. ^false ].
^true
!
Item was changed:
----- Method: NewObjectMemory>>runLeakCheckerForFullGC: (in category 'debug support') -----
runLeakCheckerForFullGC: fullGCFlag
<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.
self assert: coInterpreter checkInterpreterIntegrity.
self assert: coInterpreter checkStackIntegrity.
self assert: (coInterpreter checkCodeIntegrity: fullGCFlag).
self validate "simulation only"]!
Item was changed:
----- Method: NewObjectMemory>>setCheckForLeaks: (in category 'debug support') -----
setCheckForLeaks: anInteger
"0 = do nothing.
1 = check for leaks on fullGC.
2 = check for leaks on incrementalGC.
4 = check for leaks on become
7 = check for leaks on all three."
checkForLeaks := anInteger!
Item was changed:
----- Method: NewObjectMemory>>startOfFreeSpace (in category 'memory access') -----
startOfFreeSpace
<inline: true>
^freeStart!
Item was changed:
----- Method: NewObjectMemorySimulator class>>vmProxyMajorVersion (in category 'simulation only') -----
vmProxyMajorVersion
"hack around the CoInterpreter/ObjectMemory split refactoring"
^StackInterpreter vmProxyMajorVersion!
Item was changed:
----- Method: NewObjectMemorySimulator class>>vmProxyMinorVersion (in category 'simulation only') -----
vmProxyMinorVersion
"hack around the CoInterpreter/ObjectMemory split refactoring"
^StackInterpreter vmProxyMinorVersion!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>arrayValueOf: (in category 'simulation only') -----
+ arrayValueOf: arrayOop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter arrayValueOf: arrayOop!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>arrayValueOf: (in category 'simulation only') -----
- arrayValueOf: arrayOop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter arrayValueOf: arrayOop!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>booleanValueOf: (in category 'simulation only') -----
+ booleanValueOf: obj
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter booleanValueOf: obj!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>booleanValueOf: (in category 'simulation only') -----
- booleanValueOf: obj
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter booleanValueOf: obj!
Item was changed:
----- Method: NewObjectMemorySimulator>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
^self subclassResponsibility!
Item was changed:
----- Method: NewObjectMemorySimulator>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
^self subclassResponsibility!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>byteAtPointer: (in category 'memory access') -----
+ byteAtPointer: pointer
+ "This gets implemented by Macros in C, where its types will also be checked.
+ pointer is a raw address, and byte is an 8-bit quantity."
+
+ ^ self byteAt: pointer!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>byteAtPointer: (in category 'memory access') -----
- byteAtPointer: pointer
- "This gets implemented by Macros in C, where its types will also be checked.
- pointer is a raw address, and byte is an 8-bit quantity."
-
- ^ self byteAt: pointer!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>byteAtPointer:put: (in category 'memory access') -----
+ byteAtPointer: pointer put: byteValue
+ "This gets implemented by Macros in C, where its types will also be checked.
+ pointer is a raw address, and byteValue is an 8-bit quantity."
+
+ ^ self byteAt: pointer put: byteValue!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>byteAtPointer:put: (in category 'memory access') -----
- byteAtPointer: pointer put: byteValue
- "This gets implemented by Macros in C, where its types will also be checked.
- pointer is a raw address, and byteValue is an 8-bit quantity."
-
- ^ self byteAt: pointer put: byteValue!
Item was changed:
----- Method: NewObjectMemorySimulator>>cCoerce:to: (in category 'memory access') -----
cCoerce: value to: cTypeString
"Type coercion for translation only; just return the value when running in Smalltalk."
^value == nil
ifTrue: [value]
ifFalse: [value coerceTo: cTypeString sim: self]!
Item was changed:
----- Method: NewObjectMemorySimulator>>capturePendingFinalizationSignals (in category 'simulation only') -----
capturePendingFinalizationSignals
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter capturePendingFinalizationSignals!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>checkedIntegerValueOf: (in category 'simulation only') -----
- checkedIntegerValueOf: intOop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter checkedIntegerValueOf: intOop!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>checkedIntegerValueOf: (in category 'simulation only') -----
+ checkedIntegerValueOf: intOop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter checkedIntegerValueOf: intOop!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>eek (in category 'memory access') -----
+ eek
+ self halt!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>eek (in category 'memory access') -----
- eek
- self halt!
Item was changed:
----- Method: NewObjectMemorySimulator>>failed (in category 'simulation only') -----
failed
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter failed!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>fetchInteger:ofObject: (in category 'simulation only') -----
- fetchInteger: fieldIndex ofObject: objectPointer
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter fetchInteger: fieldIndex ofObject: objectPointer!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>fetchInteger:ofObject: (in category 'simulation only') -----
+ fetchInteger: fieldIndex ofObject: objectPointer
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter fetchInteger: fieldIndex ofObject: objectPointer!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>firstIndexableField: (in category 'simulation only') -----
+ firstIndexableField: oop
+ "NOTE: overridden from ObjectMemory to add coercion to CArray, so please duplicate any changes"
+ | hdr fmt totalLength fixedFields |
+ <returnTypeC: #'void *'>
+ hdr := self baseHeader: oop.
+ fmt := self formatOfHeader: hdr.
+ fmt <= self lastPointerFormat ifTrue:
+ ["pointer; may need to delve into the class format word"
+ totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
+ ^self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)) to: 'oop *'].
+ ^self
+ cCoerce: (self pointerForOop: oop + BaseHeaderSize)
+ to: (fmt < self firstByteFormat
+ ifTrue: [fmt = self firstLongFormat
+ ifTrue: ["32 bit field objects" 'int *']
+ ifFalse: ["full word objects (bits)" 'oop *']]
+ ifFalse: ["byte objects (including CompiledMethod" 'char *'])!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>firstIndexableField: (in category 'simulation only') -----
- firstIndexableField: oop
- "NOTE: overridden from ObjectMemory to add coercion to CArray, so please duplicate any changes"
- | hdr fmt totalLength fixedFields |
- <returnTypeC: #'void *'>
- hdr := self baseHeader: oop.
- fmt := self formatOfHeader: hdr.
- fmt <= self lastPointerFormat ifTrue:
- ["pointer; may need to delve into the class format word"
- totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
- fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
- ^self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)) to: 'oop *'].
- ^self
- cCoerce: (self pointerForOop: oop + BaseHeaderSize)
- to: (fmt < self firstByteFormat
- ifTrue: [fmt = self firstLongFormat
- ifTrue: ["32 bit field objects" 'int *']
- ifFalse: ["full word objects (bits)" 'oop *']]
- ifFalse: ["byte objects (including CompiledMethod" 'char *'])!
Item was changed:
----- Method: NewObjectMemorySimulator>>floatValueOf: (in category 'simulation only') -----
floatValueOf: obj
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter floatValueOf: obj!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>fullGC (in category 'debug support') -----
+ fullGC
+ self halt.
+ coInterpreter transcript
+ cr; nextPutAll:'<Running full GC ('; print: coInterpreter byteCount; space; print: freeStart; nextPutAll: ')...'; flush.
+ super fullGC.
+ coInterpreter transcript show: ' done>'!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>fullGC (in category 'debug support') -----
- fullGC
- self halt.
- coInterpreter transcript
- cr; nextPutAll:'<Running full GC ('; print: coInterpreter byteCount; space; print: freeStart; nextPutAll: ')...'; flush.
- super fullGC.
- coInterpreter transcript show: ' done>'!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- ^self subclassResponsibility!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- ^self subclassResponsibility!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>incrementalGC (in category 'debug support') -----
- incrementalGC
- coInterpreter transcript cr; nextPutAll: 'incrementalGC ('; print: coInterpreter byteCount; space; print: freeStart; nextPut: $); flush.
- ^super incrementalGC!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>incrementalGC (in category 'debug support') -----
+ incrementalGC
+ coInterpreter transcript cr; nextPutAll: 'incrementalGC ('; print: coInterpreter byteCount; space; print: freeStart; nextPut: $); flush.
+ ^super incrementalGC!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>interpreterAllocationReserveBytes (in category 'simulation only') -----
- interpreterAllocationReserveBytes
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter interpreterAllocationReserveBytes!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>interpreterAllocationReserveBytes (in category 'simulation only') -----
+ interpreterAllocationReserveBytes
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter interpreterAllocationReserveBytes!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>ioLoadFunction:From: (in category 'simulation only') -----
- ioLoadFunction: functionString From: pluginString
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter ioLoadFunction: functionString From: pluginString!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>ioLoadFunction:From: (in category 'simulation only') -----
+ ioLoadFunction: functionString From: pluginString
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter ioLoadFunction: functionString From: pluginString!
Item was changed:
----- Method: NewObjectMemorySimulator>>ioMicroMSecs (in category 'simulation only') -----
ioMicroMSecs
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter ioMicroMSecs!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>ioUTCMicrosecondsNow (in category 'simulation only') -----
- ioUTCMicrosecondsNow
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter ioUTCMicrosecondsNow!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>ioUTCMicrosecondsNow (in category 'simulation only') -----
+ ioUTCMicrosecondsNow
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter ioUTCMicrosecondsNow!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>is:KindOf: (in category 'simulation only') -----
- is: oop KindOf: classNameString
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter is: oop KindOf: classNameString!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>is:KindOf: (in category 'simulation only') -----
+ is: oop KindOf: classNameString
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter is: oop KindOf: classNameString!
Item was changed:
----- Method: NewObjectMemorySimulator>>isFloatObject: (in category 'simulation only') -----
isFloatObject: oop
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter isFloatObject: oop!
Item was changed:
----- Method: NewObjectMemorySimulator>>literalCountOf: (in category 'simulation only') -----
literalCountOf: anObj
^coInterpreter literalCountOf: anObj!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+ "Return the 32-bit word at byteAddress which must be 0 mod 4."
+
+ ^ self longAt: byteAddress!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>long32At: (in category 'memory access') -----
- long32At: byteAddress
- "Return the 32-bit word at byteAddress which must be 0 mod 4."
-
- ^ self longAt: byteAddress!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>long32At:put: (in category 'memory access') -----
- long32At: byteAddress put: a32BitValue
- "Store the 32-bit value at byteAddress which must be 0 mod 4."
-
- ^ self longAt: byteAddress put: a32BitValue!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ "Store the 32-bit value at byteAddress which must be 0 mod 4."
+
+ ^ self longAt: byteAddress put: a32BitValue!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
- byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
- ^memory at: byteAddress // 4 + 1!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+ byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ ^memory at: byteAddress // 4 + 1!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+ byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ ^memory at: byteAddress // 4 + 1 put: a32BitValue!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a32BitValue
- "Note: Adjusted for Smalltalk's 1-based array indexing."
- byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
- ^memory at: byteAddress // 4 + 1 put: a32BitValue!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>mapInterpreterOops (in category 'simulation only') -----
- mapInterpreterOops
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter mapInterpreterOops!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>mapInterpreterOops (in category 'simulation only') -----
+ mapInterpreterOops
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter mapInterpreterOops!
Item was changed:
----- Method: NewObjectMemorySimulator>>markAndTraceAndMaybeFreeStackPages: (in category 'simulation only') -----
markAndTraceAndMaybeFreeStackPages: fullGCFlag
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter markAndTraceAndMaybeFreeStackPages: fullGCFlag!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>markAndTraceInterpreterOops: (in category 'simulation only') -----
- markAndTraceInterpreterOops: fullGCFlag
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter markAndTraceInterpreterOops: fullGCFlag!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>markAndTraceInterpreterOops: (in category 'simulation only') -----
+ markAndTraceInterpreterOops: fullGCFlag
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter markAndTraceInterpreterOops: fullGCFlag!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>markAndTraceOrFreeMachineCode: (in category 'simulation only') -----
- markAndTraceOrFreeMachineCode: fullGCFlag
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter markAndTraceOrFreeMachineCode: fullGCFlag!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>markAndTraceOrFreeMachineCode: (in category 'simulation only') -----
+ markAndTraceOrFreeMachineCode: fullGCFlag
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter markAndTraceOrFreeMachineCode: fullGCFlag!
Item was changed:
----- Method: NewObjectMemorySimulator>>memoryBaseForImageRead (in category 'image save/restore') -----
memoryBaseForImageRead
"Answer the address to read the image into."
^0!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>methodArgumentCount (in category 'simulation only') -----
+ methodArgumentCount
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter methodArgumentCount!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>methodArgumentCount (in category 'simulation only') -----
- methodArgumentCount
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter methodArgumentCount!
Item was changed:
----- Method: NewObjectMemorySimulator>>methodReturnValue: (in category 'simulation only') -----
methodReturnValue: oop
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter methodReturnValue: oop!
Item was changed:
----- Method: NewObjectMemorySimulator>>nextLongFrom:swap: (in category 'image save/restore') -----
nextLongFrom: aStream swap: swapFlag
^swapFlag
ifTrue: [self byteSwapped: (self nextLongFrom: aStream)]
ifFalse: [self nextLongFrom: aStream]!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>nextShortFrom:swap: (in category 'initialization') -----
+ nextShortFrom: aStream swap: swapFlag
+ | aShort |
+ aShort := self nextShortFrom: aStream.
+ ^swapFlag
+ ifTrue: [(aShort bitShift: -8) + ((aShort bitAnd: 16rFF) bitShift: 8)]
+ ifFalse: [aShort]!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>nextShortFrom:swap: (in category 'initialization') -----
- nextShortFrom: aStream swap: swapFlag
- | aShort |
- aShort := self nextShortFrom: aStream.
- ^swapFlag
- ifTrue: [(aShort bitShift: -8) + ((aShort bitAnd: 16rFF) bitShift: 8)]
- ifFalse: [aShort]!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>objectBefore: (in category 'testing') -----
+ objectBefore: addr
+ | oop prev |
+ oop := self firstObject.
+ [oop < freeStart] whileTrue:
+ [prev := oop. "look here if debugging prev obj overlapping this one"
+ oop := self objectAfter: oop.
+ oop >= addr ifTrue: [^ prev]].
+ ^0!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>objectBefore: (in category 'testing') -----
- objectBefore: addr
- | oop prev |
- oop := self firstObject.
- [oop < freeStart] whileTrue:
- [prev := oop. "look here if debugging prev obj overlapping this one"
- oop := self objectAfter: oop.
- oop >= addr ifTrue: [^ prev]].
- ^0!
Item was changed:
----- Method: NewObjectMemorySimulator>>pop: (in category 'simulation only') -----
pop: nItems
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter pop: nItems!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>pop:thenPush: (in category 'simulation only') -----
- pop: nItems thenPush: oop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter pop: nItems thenPush: oop!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>pop:thenPush: (in category 'simulation only') -----
+ pop: nItems thenPush: oop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter pop: nItems thenPush: oop!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>positive32BitIntegerFor: (in category 'simulation only') -----
+ positive32BitIntegerFor: integerValue
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter positive32BitIntegerFor: integerValue!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>positive32BitIntegerFor: (in category 'simulation only') -----
- positive32BitIntegerFor: integerValue
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter positive32BitIntegerFor: integerValue!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>positive32BitValueOf: (in category 'simulation only') -----
- positive32BitValueOf: oop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter positive32BitValueOf: oop!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>positive32BitValueOf: (in category 'simulation only') -----
+ positive32BitValueOf: oop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter positive32BitValueOf: oop!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>positive64BitIntegerFor: (in category 'simulation only') -----
+ positive64BitIntegerFor: integerValue
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter positive64BitIntegerFor: integerValue!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>positive64BitIntegerFor: (in category 'simulation only') -----
- positive64BitIntegerFor: integerValue
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter positive64BitIntegerFor: integerValue!
Item was changed:
----- Method: NewObjectMemorySimulator>>positive64BitValueOf: (in category 'simulation only') -----
positive64BitValueOf: oop
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter positive64BitValueOf: oop!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>postGCAction: (in category 'simulation only') -----
+ postGCAction: gcMode
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter postGCAction: gcMode!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>postGCAction: (in category 'simulation only') -----
- postGCAction: gcMode
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter postGCAction: gcMode!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>preGCAction: (in category 'simulation only') -----
- preGCAction: gcMode
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter preGCAction: gcMode!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>preGCAction: (in category 'simulation only') -----
+ preGCAction: gcMode
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter preGCAction: gcMode!
Item was changed:
----- Method: NewObjectMemorySimulator>>primitiveFail (in category 'simulation only') -----
primitiveFail
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter primitiveFail!
Item was changed:
----- Method: NewObjectMemorySimulator>>primitiveFailFor: (in category 'simulation only') -----
primitiveFailFor: reasonCode
^coInterpreter primitiveFailFor: reasonCode!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>primitiveFailureCode (in category 'simulation only') -----
- primitiveFailureCode
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter primitiveFailureCode!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>primitiveFailureCode (in category 'simulation only') -----
+ primitiveFailureCode
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter primitiveFailureCode!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>printChar: (in category 'printing') -----
+ printChar: aCharacter
+ coInterpreter printChar: aCharacter !
Item was removed:
- ----- Method: NewObjectMemorySimulator>>printChar: (in category 'printing') -----
- printChar: aCharacter
- coInterpreter printChar: aCharacter !
Item was added:
+ ----- Method: NewObjectMemorySimulator>>printHexPtr: (in category 'printing') -----
+ printHexPtr: address
+ coInterpreter printHexPtr: address!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>printHexPtr: (in category 'printing') -----
- printHexPtr: address
- coInterpreter printHexPtr: address!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>printOop: (in category 'printing') -----
+ printOop: anOop
+ coInterpreter printOop: anOop!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>printOop: (in category 'printing') -----
- printOop: anOop
- coInterpreter printOop: anOop!
Item was changed:
----- Method: NewObjectMemorySimulator>>push: (in category 'simulation only') -----
push: oop
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter push: oop!
Item was changed:
----- Method: NewObjectMemorySimulator>>pushBool: (in category 'simulation only') -----
pushBool: trueOrFalse
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter pushBool: trueOrFalse!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>pushFloat: (in category 'simulation only') -----
+ pushFloat: f
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter pushFloat: f!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>pushFloat: (in category 'simulation only') -----
- pushFloat: f
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter pushFloat: f!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>pushInteger: (in category 'simulation only') -----
- pushInteger: integerValue
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter pushInteger: integerValue!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>pushInteger: (in category 'simulation only') -----
+ pushInteger: integerValue
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter pushInteger: integerValue!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+ "Return the half-word at byteAddress which must be even."
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
- "Return the half-word at byteAddress which must be even."
- ^self subclassResponsibility!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- ^ self subclassResponsibility!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ ^ self subclassResponsibility!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>showDisplayBits:Left:Top:Right:Bottom: (in category 'simulation only') -----
+ showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter showDisplayBits: aForm Left: l Top: t Right: r Bottom: b!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>showDisplayBits:Left:Top:Right:Bottom: (in category 'simulation only') -----
- showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter showDisplayBits: aForm Left: l Top: t Right: r Bottom: b!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>signalFinalization: (in category 'simulation only') -----
+ signalFinalization: oop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter signalFinalization: oop!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>signalFinalization: (in category 'simulation only') -----
- signalFinalization: oop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter signalFinalization: oop!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>signed32BitIntegerFor: (in category 'simulation only') -----
- signed32BitIntegerFor: integerValue
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter signed32BitIntegerFor: integerValue!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>signed32BitIntegerFor: (in category 'simulation only') -----
+ signed32BitIntegerFor: integerValue
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter signed32BitIntegerFor: integerValue!
Item was changed:
----- Method: NewObjectMemorySimulator>>sqGrowMemory:By: (in category 'memory access') -----
sqGrowMemory: oldLimit By: delta
| newMemory |
coInterpreter transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr.
memory size * 4 < (oldLimit + delta) ifTrue:
[newMemory := (memory class new: oldLimit + delta + 3 // 4).
newMemory replaceFrom: 1 to: memory size with: memory startingAt: 1.
memory := newMemory].
^memory size * 4!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
+ sqMemoryExtraBytesLeft: includingSwap
+ ^0!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- ^0!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>sqShrinkMemory:By: (in category 'memory access') -----
+ sqShrinkMemory: oldLimit By: delta
+ coInterpreter transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr.
+
+ ^oldLimit!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>sqShrinkMemory:By: (in category 'memory access') -----
- sqShrinkMemory: oldLimit By: delta
- coInterpreter transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr.
-
- ^oldLimit!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>stObject:at: (in category 'simulation only') -----
- stObject: objOop at: indexOop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter stObject: objOop at: indexOop!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>stObject:at: (in category 'simulation only') -----
+ stObject: objOop at: indexOop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter stObject: objOop at: indexOop!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>stObject:at:put: (in category 'simulation only') -----
- stObject: objOop at: indexOop put: valueOop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter stObject: objOop at: indexOop put: valueOop!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>stObject:at:put: (in category 'simulation only') -----
+ stObject: objOop at: indexOop put: valueOop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter stObject: objOop at: indexOop put: valueOop!
Item was changed:
----- Method: NewObjectMemorySimulator>>stackFloatValue: (in category 'simulation only') -----
stackFloatValue: offset
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter stackFloatValue: offset!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>stackIntegerValue: (in category 'simulation only') -----
+ stackIntegerValue: offset
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter stackIntegerValue: offset!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>stackIntegerValue: (in category 'simulation only') -----
- stackIntegerValue: offset
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter stackIntegerValue: offset!
Item was changed:
----- Method: NewObjectMemorySimulator>>stackObjectValue: (in category 'simulation only') -----
stackObjectValue: offset
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter stackObjectValue: offset!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>stackValue: (in category 'simulation only') -----
- stackValue: offset
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter stackValue: offset!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>stackValue: (in category 'simulation only') -----
+ stackValue: offset
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter stackValue: offset!
Item was changed:
----- Method: NewObjectMemorySimulator>>storeInteger:ofObject:withValue: (in category 'simulation only') -----
storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue!
Item was changed:
----- Method: NewObjectMemorySimulator>>storePointer:ofObject:withValue: (in category 'interpreter access') -----
storePointer: index ofObject: oop withValue: valuePointer
"Override to ensure acess is within the heap, and within the object"
| fmt hdr |
self assert: oop >= self startOfMemory.
hdr := self baseHeader: oop.
fmt := self formatOfHeader: hdr.
self assert: ((fmt <= self lastPointerFormat or: [fmt >= self firstCompiledMethodFormat])
and: [index >= 0 and: [index < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
^super storePointer: index ofObject: oop withValue: valuePointer!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>storePointerUnchecked:ofObject:withValue: (in category 'interpreter access') -----
+ storePointerUnchecked: index ofObject: oop withValue: valuePointer
+ "Override to ensure acess is within the heap, and within the object"
+ | fmt hdr |
+ self assert: oop >= self startOfMemory.
+ hdr := self baseHeader: oop.
+ fmt := self formatOfHeader: hdr.
+ self assert: ((fmt <= self lastPointerFormat or: [fmt >= self firstCompiledMethodFormat])
+ and: [index >= 0 and: [index < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
+ ^super storePointerUnchecked: index ofObject: oop withValue: valuePointer!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>storePointerUnchecked:ofObject:withValue: (in category 'interpreter access') -----
- storePointerUnchecked: index ofObject: oop withValue: valuePointer
- "Override to ensure acess is within the heap, and within the object"
- | fmt hdr |
- self assert: oop >= self startOfMemory.
- hdr := self baseHeader: oop.
- fmt := self formatOfHeader: hdr.
- self assert: ((fmt <= self lastPointerFormat or: [fmt >= self firstCompiledMethodFormat])
- and: [index >= 0 and: [index < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
- ^super storePointerUnchecked: index ofObject: oop withValue: valuePointer!
Item was changed:
----- Method: NewObjectMemorySimulator>>stringOf: (in category 'simulation only') -----
stringOf: oop
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter stringOf: oop!
Item was changed:
----- Method: NewObjectMemorySimulator>>success: (in category 'simulation only') -----
success: boolean
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter success: boolean!
Item was changed:
----- Method: NewObjectMemorySimulator>>tenuringIncrementalGC (in category 'debug support') -----
tenuringIncrementalGC
coInterpreter transcript cr; nextPutAll: 'tenuringIncrementalGC ('; print: coInterpreter byteCount; space; print: freeStart; nextPut: $); flush.
^super tenuringIncrementalGC!
Item was changed:
----- Method: NewObjectMemorySimulator>>transcript (in category 'simulation only') -----
transcript
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter transcript!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>validOop: (in category 'testing') -----
+ validOop: oop
+ " Return true if oop appears to be valid "
+ (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
+ (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
+ oop >= freeStart ifTrue: [^ false]. "Out of range"
+ "could test if within the first large freeblock"
+ (self longAt: oop) = 4 ifTrue: [^ false].
+ (self headerType: oop) = 2 ifTrue: [^ false]. "Free object"
+ ^ true!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>validOop: (in category 'testing') -----
- validOop: oop
- " Return true if oop appears to be valid "
- (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
- (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
- oop >= freeStart ifTrue: [^ false]. "Out of range"
- "could test if within the first large freeblock"
- (self longAt: oop) = 4 ifTrue: [^ false].
- (self headerType: oop) = 2 ifTrue: [^ false]. "Free object"
- ^ true!
Item was changed:
----- Method: NewObjectMemorySimulatorLSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits long |
lowBits := byteAddress bitAnd: 3.
long := self longAt: byteAddress - lowBits.
^(lowBits caseOf: {
[0] -> [ long ].
[1] -> [ long bitShift: -8 ].
[2] -> [ long bitShift: -16 ].
[3] -> [ long bitShift: -24 ]
}) bitAnd: 16rFF
!
Item was changed:
----- Method: NewObjectMemorySimulatorLSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| lowBits long longAddress |
lowBits := byteAddress bitAnd: 3.
longAddress := byteAddress - lowBits.
long := self longAt: longAddress.
long := (lowBits caseOf: {
[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16) ].
[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24) ]
}).
self assert: longAddress < freeStart.
self longAt: longAddress put: long.
^byte!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>charsOfLong: (in category 'debug support') -----
- charsOfLong: long
- ^ (1 to: 4) collect:
- [:i | ((long digitAt: i) between: 14 and: 126)
- ifTrue: [(long digitAt: i) asCharacter]
- ifFalse: [$?]]!
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>charsOfLong: (in category 'debug support') -----
+ charsOfLong: long
+ ^ (1 to: 4) collect:
+ [:i | ((long digitAt: i) between: 14 and: 126)
+ ifTrue: [(long digitAt: i) asCharacter]
+ ifFalse: [$?]]!
Item was changed:
----- Method: NewObjectMemorySimulatorLSB>>endianness (in category 'memory access') -----
endianness
^#little!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>fetchFloatAt:into: (in category 'float primitives') -----
- fetchFloatAt: floatBitsAddress into: aFloat
- aFloat at: 2 put: (self long32At: floatBitsAddress).
- aFloat at: 1 put: (self long32At: floatBitsAddress+4)!
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>fetchFloatAt:into: (in category 'float primitives') -----
+ fetchFloatAt: floatBitsAddress into: aFloat
+ aFloat at: 2 put: (self long32At: floatBitsAddress).
+ aFloat at: 1 put: (self long32At: floatBitsAddress+4)!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitAnd: 16rFFFF!
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitAnd: 16rFFFF!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitShift: -16!
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitShift: -16!
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>nextLongFrom: (in category 'initialization') -----
+ nextLongFrom: aStream
+ "Read a 32- or 64-bit quantity from the given (binary) stream."
+
+ ^ aStream nextLittleEndianNumber: BytesPerWord!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>nextLongFrom: (in category 'initialization') -----
- nextLongFrom: aStream
- "Read a 32- or 64-bit quantity from the given (binary) stream."
-
- ^ aStream nextLittleEndianNumber: BytesPerWord!
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>nextShortFrom: (in category 'initialization') -----
+ nextShortFrom: aStream
+ "Read a 16-bit quantity from the given (binary) stream."
+ ^aStream nextLittleEndianNumber: 2!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>nextShortFrom: (in category 'initialization') -----
- nextShortFrom: aStream
- "Read a 16-bit quantity from the given (binary) stream."
- ^aStream nextLittleEndianNumber: 2!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>putLong:toFile: (in category 'image save/restore') -----
- putLong: n toFile: f
- "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
-
- | remainingValue |
-
- remainingValue := n.
- 4 timesRepeat: [
- f nextPut: (remainingValue bitAnd: 16rFF).
- remainingValue := remainingValue bitShift: -8].
-
- self success: true!
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>putLong:toFile: (in category 'image save/restore') -----
+ putLong: n toFile: f
+ "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
+
+ | remainingValue |
+
+ remainingValue := n.
+ 4 timesRepeat: [
+ f nextPut: (remainingValue bitAnd: 16rFF).
+ remainingValue := remainingValue bitShift: -8].
+
+ self success: true!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>putShort:toFile: (in category 'image save/restore') -----
- putShort: n toFile: f
- "Append the given 2-byte half-word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
-
- | remainingValue |
-
- remainingValue := n.
- 2 timesRepeat: [
- f nextPut: (remainingValue bitAnd: 16rFF).
- remainingValue := remainingValue bitShift: -8].
-
- self success: true!
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>putShort:toFile: (in category 'image save/restore') -----
+ putShort: n toFile: f
+ "Append the given 2-byte half-word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
+
+ | remainingValue |
+
+ remainingValue := n.
+ 2 timesRepeat: [
+ f nextPut: (remainingValue bitAnd: 16rFF).
+ remainingValue := remainingValue bitShift: -8].
+
+ self success: true!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
- "Return the half-word at byteAddress which must be even."
- | lowBits long |
- lowBits := byteAddress bitAnd: 2.
- long := self longAt: byteAddress - lowBits.
- ^ lowBits = 2
- ifTrue: [ long bitShift: -16 ]
- ifFalse: [ long bitAnd: 16rFFFF ].
- !
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+ "Return the half-word at byteAddress which must be even."
+ | lowBits long |
+ lowBits := byteAddress bitAnd: 2.
+ long := self longAt: byteAddress - lowBits.
+ ^ lowBits = 2
+ ifTrue: [ long bitShift: -16 ]
+ ifFalse: [ long bitAnd: 16rFFFF ].
+ !
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ "Return the half-word at byteAddress which must be even."
+ | lowBits long longAddress |
+ lowBits := byteAddress bitAnd: 2.
+ lowBits = 0
+ ifTrue:
+ [ "storing into LS word"
+ long := self longAt: byteAddress.
+ self longAt: byteAddress
+ put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)
+ ]
+ ifFalse:
+ [longAddress := byteAddress - 2.
+ long := self longAt: longAddress.
+ self longAt: longAddress
+ put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))
+ ]!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- "Return the half-word at byteAddress which must be even."
- | lowBits long longAddress |
- lowBits := byteAddress bitAnd: 2.
- lowBits = 0
- ifTrue:
- [ "storing into LS word"
- long := self longAt: byteAddress.
- self longAt: byteAddress
- put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)
- ]
- ifFalse:
- [longAddress := byteAddress - 2.
- long := self longAt: longAddress.
- self longAt: longAddress
- put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))
- ]!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>storeFloatAt:from: (in category 'float primitives') -----
- storeFloatAt: floatBitsAddress from: aFloat
-
- self long32At: floatBitsAddress put: (aFloat at: 2).
- self long32At: floatBitsAddress+4 put: (aFloat at: 1)!
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>storeFloatAt:from: (in category 'float primitives') -----
+ storeFloatAt: floatBitsAddress from: aFloat
+
+ self long32At: floatBitsAddress put: (aFloat at: 2).
+ self long32At: floatBitsAddress+4 put: (aFloat at: 1)!
Item was added:
+ ----- Method: NewObjectMemorySimulatorLSB>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ "return 0 for little endian, 1 for big endian"
+ ^0!
Item was removed:
- ----- Method: NewObjectMemorySimulatorLSB>>vmEndianness (in category 'memory access') -----
- vmEndianness
- "return 0 for little endian, 1 for big endian"
- ^0!
Item was changed:
----- Method: NewspeakInterpreter>>allAccessibleObjectsOkay (in category 'debug support') -----
allAccessibleObjectsOkay
"Ensure that all accessible objects in the heap are okay."
| oop ok |
ok := true.
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[ok := ok & (self okayFields: oop).
oop := self accessibleObjectAfter: oop].
^ok!
Item was added:
+ ----- Method: NewspeakInterpreter>>arrayValueOf: (in category 'utilities') -----
+ arrayValueOf: arrayOop
+ "Return the address of first indexable field of resulting array object, or fail if
+ the instance variable does not contain an indexable bytes or words object."
+ "Note: May be called by translated primitive code."
+
+ <returnTypeC: #'void *'>
+ ((self isNonIntegerObject: arrayOop)
+ and: [self isWordsOrBytes: arrayOop]) ifTrue:
+ [^self cCoerceSimple: (self pointerForOop: arrayOop + BaseHeaderSize) to: #'void *'].
+ self primitiveFail!
Item was removed:
- ----- Method: NewspeakInterpreter>>arrayValueOf: (in category 'utilities') -----
- arrayValueOf: arrayOop
- "Return the address of first indexable field of resulting array object, or fail if
- the instance variable does not contain an indexable bytes or words object."
- "Note: May be called by translated primitive code."
-
- <returnTypeC: #'void *'>
- ((self isNonIntegerObject: arrayOop)
- and: [self isWordsOrBytes: arrayOop]) ifTrue:
- [^self cCoerceSimple: (self pointerForOop: arrayOop + BaseHeaderSize) to: #'void *'].
- self primitiveFail!
Item was removed:
- ----- Method: NewspeakInterpreter>>booleanValueOf: (in category 'utilities') -----
- booleanValueOf: obj
- "convert true and false (Smalltalk) to true or false(C)"
- obj = trueObj ifTrue: [ ^ true ].
- obj = falseObj ifTrue: [ ^ false ].
- ^self primitiveFail!
Item was added:
+ ----- Method: NewspeakInterpreter>>booleanValueOf: (in category 'utilities') -----
+ booleanValueOf: obj
+ "convert true and false (Smalltalk) to true or false(C)"
+ obj = trueObj ifTrue: [ ^ true ].
+ obj = falseObj ifTrue: [ ^ false ].
+ ^self primitiveFail!
Item was changed:
----- Method: NewspeakInterpreter>>byteSwapByteObjects (in category 'image save/restore') -----
byteSwapByteObjects
"Byte-swap the words of all bytes objects in the image. This returns these objects to their original byte ordering after blindly byte-swapping the entire image."
self byteSwapByteObjectsFrom: self firstObject to: endOfMemory!
Item was changed:
----- Method: NewspeakInterpreter>>byteSwapByteObjectsFrom:to: (in category 'image save/restore') -----
byteSwapByteObjectsFrom: startOop to: stopAddr
"Byte-swap the words of all bytes objects in a range of the
image, including Strings, ByteArrays, and CompiledMethods.
This returns these objects to their original byte ordering
after blindly byte-swapping the entire image. For compiled
methods, byte-swap only their bytecodes part."
| oop fmt wordAddr methodHeader |
oop := startOop.
[self oop: oop isLessThan: stopAddr]
whileTrue: [(self isFreeObject: oop)
ifFalse: [fmt := self formatOf: oop.
fmt >= 8
ifTrue: ["oop contains bytes"
wordAddr := oop + BaseHeaderSize.
fmt >= 12
ifTrue: ["compiled method; start after methodHeader and literals"
methodHeader := self longAt: oop + BaseHeaderSize.
wordAddr := wordAddr + BytesPerWord + ((methodHeader >> 10 bitAnd: 255) * BytesPerWord)].
self reverseBytesFrom: wordAddr to: oop + (self sizeBitsOf: oop)].
(fmt = 6 and: [BytesPerWord = 8])
ifTrue: ["Object contains 32-bit half-words packed into 64-bit machine words."
wordAddr := oop + BaseHeaderSize.
self reverseWordsFrom: wordAddr to: oop + (self sizeBitsOf: oop)]].
oop := self objectAfter: oop]!
Item was changed:
----- Method: NewspeakInterpreter>>capturePendingFinalizationSignals (in category 'debug support') -----
capturePendingFinalizationSignals
statPendingFinalizationSignals := pendingFinalizationSignals!
Item was changed:
----- Method: NewspeakInterpreter>>checkImageVersionFrom:startingAt: (in category 'image save/restore') -----
checkImageVersionFrom: f startingAt: imageOffset
"Read and verify the image file version number and return true if the the given image file needs to be byte-swapped. As a side effect, position the file stream just after the version number of the image header. This code prints a warning and does a hard-exit if it cannot find a valid version number."
"This code is based on C code by Ian Piumarta."
| version firstVersion |
<var: #f type: 'sqImageFile '>
<var: #imageOffset type: 'squeakFileOffsetType '>
"check the version number"
self sqImageFile: f Seek: imageOffset.
version := firstVersion := self getLongFromFile: f swap: false.
(self readableFormat: version) ifTrue: [^ false].
"try with bytes reversed"
self sqImageFile: f Seek: imageOffset.
version := self getLongFromFile: f swap: true.
(self readableFormat: version) ifTrue: [^ true].
"Note: The following is only meaningful if not reading an embedded image"
imageOffset = 0 ifTrue:[
"try skipping the first 512 bytes (prepended by certain Mac file transfer utilities)"
self sqImageFile: f Seek: 512.
version := self getLongFromFile: f swap: false.
(self readableFormat: version) ifTrue: [^ false].
"try skipping the first 512 bytes with bytes reversed"
self sqImageFile: f Seek: 512.
version := self getLongFromFile: f swap: true.
(self readableFormat: version) ifTrue: [^ true]].
"hard failure; abort"
self print: 'This interpreter (vers. '.
self printNum: self imageFormatVersion.
self print: ') cannot read image file (vers. '.
self printNum: firstVersion.
self print: ').'.
self cr.
self print: 'Press CR to quit...'.
self getchar.
self ioExit.
!
Item was added:
+ ----- Method: NewspeakInterpreter>>checkedIntegerValueOf: (in category 'utilities') -----
+ checkedIntegerValueOf: intOop
+ "Note: May be called by translated primitive code."
+
+ (self isIntegerObject: intOop)
+ ifTrue: [ ^ self integerValueOf: intOop ]
+ ifFalse: [ self primitiveFail. ^ 0 ]!
Item was removed:
- ----- Method: NewspeakInterpreter>>checkedIntegerValueOf: (in category 'utilities') -----
- checkedIntegerValueOf: intOop
- "Note: May be called by translated primitive code."
-
- (self isIntegerObject: intOop)
- ifTrue: [ ^ self integerValueOf: intOop ]
- ifFalse: [ self primitiveFail. ^ 0 ]!
Item was changed:
----- Method: NewspeakInterpreter>>dumpPrimTraceLog (in category 'debug support') -----
dumpPrimTraceLog
"The prim trace log is a circular buffer of entries. If there is
an entry at primTraceLogIndex \\ PrimTraceLogSize it has entries.
If there is something at primTraceLogIndex it has wrapped."
<api>
<inline: false>
(primTraceLog at: (self safe: primTraceLogIndex - 1 mod: TraceLogSize)) = 0 ifTrue: [^self].
(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[primTraceLogIndex to: TraceLogSize - 1 do:
[:i | self safePrintStringOf: (primTraceLog at: i); cr]].
0 to: primTraceLogIndex - 1 do:
[:i | self safePrintStringOf: (primTraceLog at: i); cr]!
Item was changed:
----- Method: NewspeakInterpreter>>dumpSendTraceLog (in category 'debug support') -----
dumpSendTraceLog
"The send trace log is a circular buffer of entries. If there is
an entry at sendTraceLogIndex \\ PrimTraceLogSize it has entries.
If there is something at sendTraceLogIndex it has wrapped."
<api>
<inline: false>
(sendTraceLog at: (self safe: sendTraceLogIndex - 1 mod: TraceLogSize)) = 0 ifTrue: [^self].
(sendTraceLog at: sendTraceLogIndex) ~= 0 ifTrue:
[sendTraceLogIndex to: TraceLogSize - 1 do:
[:i | self safePrintStringOf: (sendTraceLog at: i); cr]].
0 to: sendTraceLogIndex - 1 do:
[:i | self safePrintStringOf: (sendTraceLog at: i); cr]!
Item was changed:
----- Method: NewspeakInterpreter>>fastLogPrim: (in category 'debug support') -----
fastLogPrim: aSelector
"Fast tracing of named primitives. primTraceLogIndex is a byte variable.
primTraceLog has 256 entries. In C the + 1 below is hence implicitly modulo 256."
<inline: true>
RecordPrimTrace ifTrue:
[primTraceLog at: primTraceLogIndex put: aSelector.
self primTraceLogIndex: primTraceLogIndex + 1]!
Item was changed:
----- Method: NewspeakInterpreter>>fastLogSend: (in category 'debug support') -----
fastLogSend: aSelector
"Fast tracing of sends. sendTraceLogIndex is a byte variable.
sendTraceLog has 256 entries. In C the + 1 below is hence implicitly modulo 256."
<inline: true>
RecordSendTrace ifTrue:
[sendTraceLog at: sendTraceLogIndex put: aSelector.
self sendTraceLogIndex: sendTraceLogIndex + 1]!
Item was added:
+ ----- Method: NewspeakInterpreter>>fetchInteger:ofObject: (in category 'utilities') -----
+ fetchInteger: fieldIndex ofObject: objectPointer
+ "Note: May be called by translated primitive code."
+
+ | intOop |
+ <inline: false>
+ intOop := self fetchPointer: fieldIndex ofObject: objectPointer.
+ ^self checkedIntegerValueOf: intOop!
Item was removed:
- ----- Method: NewspeakInterpreter>>fetchInteger:ofObject: (in category 'utilities') -----
- fetchInteger: fieldIndex ofObject: objectPointer
- "Note: May be called by translated primitive code."
-
- | intOop |
- <inline: false>
- intOop := self fetchPointer: fieldIndex ofObject: objectPointer.
- ^self checkedIntegerValueOf: intOop!
Item was changed:
----- Method: NewspeakInterpreter>>findClassOfMethod:forReceiver: (in category 'debug support') -----
findClassOfMethod: meth forReceiver: rcvr
| currClass classDict classDictSize methodArray i done |
currClass := self fetchClassOf: rcvr.
done := false.
[done] whileFalse: [
classDict := self fetchPointer: MessageDictionaryIndex ofObject: currClass.
classDictSize := self fetchWordLengthOf: classDict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i < (classDictSize - SelectorStart)] whileTrue: [
meth = (self fetchPointer: i ofObject: methodArray) ifTrue: [ ^currClass ].
i := i + 1.
].
currClass := self fetchPointer: SuperclassIndex ofObject: currClass.
done := currClass = nilObj.
].
^self fetchClassOf: rcvr "method not found in superclass chain"!
Item was changed:
----- Method: NewspeakInterpreter>>findSelectorOfMethod:forReceiver: (in category 'debug support') -----
findSelectorOfMethod: meth forReceiver: rcvr
| currClass done classDict classDictSize methodArray i |
currClass := self fetchClassOf: rcvr.
done := false.
[done] whileFalse: [
classDict := self fetchPointer: MessageDictionaryIndex ofObject: currClass.
classDictSize := self fetchWordLengthOf: classDict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i <= (classDictSize - SelectorStart)] whileTrue: [
meth = (self fetchPointer: i ofObject: methodArray) ifTrue: [
^(self fetchPointer: i + SelectorStart ofObject: classDict)
].
i := i + 1.
].
currClass := self fetchPointer: SuperclassIndex ofObject: currClass.
done := currClass = nilObj.
].
^ nilObj "method not found in superclass chain"!
Item was changed:
----- Method: NewspeakInterpreter>>getLongFromFile:swap: (in category 'image save/restore') -----
getLongFromFile: aFile swap: swapFlag
"Answer the next word read from aFile, byte-swapped according to the swapFlag."
| w |
<var: #aFile type: 'sqImageFile '>
w := 0.
self cCode: 'sqImageFileRead(&w, sizeof(w), 1, aFile)'.
swapFlag
ifTrue: [^ self byteSwapped: w]
ifFalse: [^ w].
!
Item was added:
+ ----- Method: NewspeakInterpreter>>getThisSessionID (in category 'plugin support') -----
+ getThisSessionID
+ "return the global session ID value"
+ <inline: false>
+ ^globalSessionID!
Item was removed:
- ----- Method: NewspeakInterpreter>>getThisSessionID (in category 'plugin support') -----
- getThisSessionID
- "return the global session ID value"
- <inline: false>
- ^globalSessionID!
Item was changed:
----- Method: NewspeakInterpreter>>ifValidWriteBackStack:Pointers:Save:To: (in category 'debug support') -----
ifValidWriteBackStack: theCFP Pointers: theCSP Save: savedFPP To: savedSPP
"This is for low-level error reporting. If either of the C stack pointers are
pointing into the stack zone then write them back to framePointer and/or
stackPointer so that the stack backtrace will be up to date. Write their
original values through savedFPP & savedSPP if non-null.
This is a noop in the Interpreter VM since the C stack pointers are always
elsewhere (e.g., in some C function running the interpreter)."
<api>
<var: #theCFP type: #'void *'>
<var: #theCSP type: #'void *'>
<var: #savedFPP type: #'char **'>
<var: #savedSPP type: #'char **'>
<returnTypeC: #void>!
Item was changed:
----- Method: NewspeakInterpreter>>imageFormatCompatibilityVersion (in category 'image save/restore') -----
imageFormatCompatibilityVersion
"This VM is backward-compatible with the immediately preceeding non-closure version."
BytesPerWord == 4
ifTrue: [^6502]
ifFalse: [^68000]!
Item was changed:
----- Method: NewspeakInterpreter>>imageFormatForwardCompatibilityVersion (in category 'image save/restore') -----
imageFormatForwardCompatibilityVersion
"This VM is forwards-compatible with the immediately following closure version, and
will write the new version number in snapshots if the closure creation bytecode is used."
BytesPerWord == 4
ifTrue: [^6504]
ifFalse: [^68002]!
Item was changed:
----- Method: NewspeakInterpreter>>imageFormatVersion (in category 'image save/restore') -----
imageFormatVersion
"Return a magic constant that changes when the image format changes. Since the image reading code uses
this to detect byte ordering, one must avoid version numbers that are invariant under byte reversal."
"See NewspeakInterpreter class>>declareCVarsIn: and NewspeakInterpreter>>pushClosureCopyCopiedValuesBytecode
for the initialization of imageFormatVersionNumber"
^imageFormatVersionNumber!
Item was added:
+ ----- Method: NewspeakInterpreter>>is:KindOf: (in category 'plugin primitive support') -----
+ is: oop KindOf: className
+ "Support for external primitives."
+ | oopClass |
+ <var: #className type:#'char *'>
+ oopClass := self fetchClassOf: oop.
+ [oopClass == nilObj] whileFalse:[
+ (self classNameOf: oopClass Is: className) ifTrue:[^true].
+ oopClass := self superclassOf: oopClass].
+ ^false!
Item was removed:
- ----- Method: NewspeakInterpreter>>is:KindOf: (in category 'plugin primitive support') -----
- is: oop KindOf: className
- "Support for external primitives."
- | oopClass |
- <var: #className type:#'char *'>
- oopClass := self fetchClassOf: oop.
- [oopClass == nilObj] whileFalse:[
- (self classNameOf: oopClass Is: className) ifTrue:[^true].
- oopClass := self superclassOf: oopClass].
- ^false!
Item was removed:
- ----- Method: NewspeakInterpreter>>mapInterpreterOops (in category 'object memory support') -----
- mapInterpreterOops
- "Map all oops in the interpreter's state to their new values
- during garbage collection or a become: operation."
- "Assume: All traced variables contain valid oops."
- stackPointer := stackPointer - activeContext. "*rel to active"
- activeContext := self remap: activeContext.
- stackPointer := stackPointer + activeContext. "*rel to active"
- theHomeContext := self remap: theHomeContext.
- instructionPointer := instructionPointer - method. "*rel to method"
- method := self remap: method.
- instructionPointer := instructionPointer + method. "*rel to method"
- receiver := self remap: receiver.
- (self isIntegerObject: messageSelector) ifFalse:
- [messageSelector := self remap: messageSelector].
- (self isIntegerObject: newMethod) ifFalse:
- [newMethod := self remap: newMethod].
- lkupClass := self remap: lkupClass.
- self mapTraceLogs!
Item was added:
+ ----- Method: NewspeakInterpreter>>mapInterpreterOops (in category 'object memory support') -----
+ mapInterpreterOops
+ "Map all oops in the interpreter's state to their new values
+ during garbage collection or a become: operation."
+ "Assume: All traced variables contain valid oops."
+ stackPointer := stackPointer - activeContext. "*rel to active"
+ activeContext := self remap: activeContext.
+ stackPointer := stackPointer + activeContext. "*rel to active"
+ theHomeContext := self remap: theHomeContext.
+ instructionPointer := instructionPointer - method. "*rel to method"
+ method := self remap: method.
+ instructionPointer := instructionPointer + method. "*rel to method"
+ receiver := self remap: receiver.
+ (self isIntegerObject: messageSelector) ifFalse:
+ [messageSelector := self remap: messageSelector].
+ (self isIntegerObject: newMethod) ifFalse:
+ [newMethod := self remap: newMethod].
+ lkupClass := self remap: lkupClass.
+ self mapTraceLogs!
Item was changed:
----- Method: NewspeakInterpreter>>mapTraceLogs (in category 'debug support') -----
mapTraceLogs
"The prim and send trace logs are circular buffers of selectors. If there is
an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
If there is something at primTraceLogIndex it has wrapped."
<inline: false>
| limit |
limit := self safe: primTraceLogIndex - 1 mod: TraceLogSize.
(primTraceLog at: limit) = 0 ifTrue: [^self].
(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[limit := TraceLogSize - 1].
0 to: limit do:
[:i| | selector |
selector := primTraceLog at: i.
(self isIntegerObject: selector) ifFalse:
[primTraceLog at: i put: (self remap: selector)]].
limit := self safe: sendTraceLogIndex - 1 mod: TraceLogSize.
(sendTraceLog at: limit) = 0 ifTrue: [^nil].
(sendTraceLog at: sendTraceLogIndex) ~= 0 ifTrue:
[limit := TraceLogSize - 1].
0 to: limit do:
[:i| | selector |
selector := sendTraceLog at: i.
(self isIntegerObject: selector) ifFalse:
[sendTraceLog at: i put: (self remap: selector)]]!
Item was changed:
----- Method: NewspeakInterpreter>>markAndTraceTraceLogs (in category 'debug support') -----
markAndTraceTraceLogs
"The prim and send trace logs are circular buffers of selectors. If there is
an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
If there is something at primTraceLogIndex it has wrapped."
<inline: false>
| limit |
RecordPrimTrace ifTrue:
[limit := self safe: primTraceLogIndex - 1 mod: TraceLogSize.
(primTraceLog at: limit) ~= 0 ifTrue:
[(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[limit := TraceLogSize - 1].
0 to: limit do:
[:i| | selector |
selector := primTraceLog at: i.
(self isIntegerObject: selector) ifFalse:
[self markAndTrace: selector]]]].
RecordSendTrace ifTrue:
[limit := self safe: sendTraceLogIndex - 1 mod: TraceLogSize.
(sendTraceLog at: limit) ~= 0 ifTrue:
[(sendTraceLog at: sendTraceLogIndex) ~= 0 ifTrue:
[limit := TraceLogSize - 1].
0 to: limit do:
[:i| | selector |
selector := sendTraceLog at: i.
(self isIntegerObject: selector) ifFalse:
[self markAndTrace: selector]]]]!
Item was removed:
- ----- Method: NewspeakInterpreter>>methodArgumentCount (in category 'plugin primitive support') -----
- methodArgumentCount
- ^argumentCount!
Item was added:
+ ----- Method: NewspeakInterpreter>>methodArgumentCount (in category 'plugin primitive support') -----
+ methodArgumentCount
+ ^argumentCount!
Item was changed:
----- Method: NewspeakInterpreter>>okayActiveProcessStack (in category 'debug support') -----
okayActiveProcessStack
| cntxt |
cntxt := activeContext.
[cntxt = nilObj] whileFalse: [
self okayFields: cntxt.
cntxt := (self fetchPointer: SenderIndex ofObject: cntxt).
].!
Item was changed:
----- Method: NewspeakInterpreter>>okayFields: (in category 'debug support') -----
okayFields: oop
"Check if the argument is an ok object.
If this is a pointers object, check that its fields are all okay oops."
| i fieldOop |
(oop = nil or: [oop = 0]) ifTrue: [ ^true ].
(self isIntegerObject: oop) ifTrue: [ ^true ].
(self okayOop: oop) ifFalse: [ ^false ].
(self oopHasOkayClass: oop) ifFalse: [ ^false ].
((self isPointers: oop) or: [self isCompiledMethod: oop]) ifFalse: [ ^true ].
(self isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart - 1]
ifFalse:
[(self isContext: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
ifFalse: [i := (self lengthOf: oop) - 1]].
[i >= 0] whileTrue: [
fieldOop := self fetchPointer: i ofObject: oop.
(self isIntegerObject: fieldOop) ifFalse: [
(self okayOop: fieldOop) ifFalse: [ ^false ].
(self oopHasOkayClass: fieldOop) ifFalse: [ ^false ].
].
i := i - 1.
].
^true!
Item was changed:
----- Method: NewspeakInterpreter>>okayInterpreterObjects (in category 'debug support') -----
okayInterpreterObjects
| oopOrZero oop |
self okayFields: nilObj.
self okayFields: falseObj.
self okayFields: trueObj.
self okayFields: specialObjectsOop.
self okayFields: activeContext.
self okayFields: method.
self okayFields: receiver.
self okayFields: theHomeContext.
self okayFields: messageSelector.
self okayFields: newMethod.
self okayFields: lkupClass.
0 to: MethodCacheEntries - 1 by: MethodCacheEntrySize do: [ :i |
oopOrZero := methodCache at: i + MethodCacheSelector.
oopOrZero = 0 ifFalse: [
self okayFields: (methodCache at: i + MethodCacheSelector).
self okayFields: (methodCache at: i + MethodCacheClass).
self okayFields: (methodCache at: i + MethodCacheMethod).
].
].
1 to: remapBufferCount do: [ :i |
oop := remapBuffer at: i.
(self isIntegerObject: oop) ifFalse: [
self okayFields: oop.
].
].
self okayActiveProcessStack.!
Item was changed:
----- Method: NewspeakInterpreter>>oopHasOkayClass: (in category 'debug support') -----
oopHasOkayClass: signedOop
"Attempt to verify that the given oop has a reasonable behavior. The class must be a valid, non-integer oop and must not be nilObj. It must be a pointers object with three or more fields. Finally, the instance specification field of the behavior must match that of the instance."
| oop oopClass formatMask behaviorFormatBits oopFormatBits |
<var: #oop type: 'usqInt'>
<var: #oopClass type: 'usqInt'>
oop := self cCoerce: signedOop to: 'usqInt'.
self okayOop: oop.
oopClass := self cCoerce: (self fetchClassOf: oop) to: 'usqInt'.
(self isIntegerObject: oopClass)
ifTrue: [ self error: 'a SmallInteger is not a valid class or behavior' ].
self okayOop: oopClass.
((self isPointers: oopClass) and: [(self lengthOf: oopClass) >= 3])
ifFalse: [ self error: 'a class (behavior) must be a pointers object of size >= 3' ].
(self isBytes: oop)
ifTrue: [ formatMask := 16rC00 ] "ignore extra bytes size bits"
ifFalse: [ formatMask := 16rF00 ].
behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
oopFormatBits := (self baseHeader: oop) bitAnd: formatMask.
behaviorFormatBits = oopFormatBits
ifFalse: [ self error: 'object and its class (behavior) formats differ' ].
^true!
Item was removed:
- ----- Method: NewspeakInterpreter>>pop:thenPush: (in category 'internal interpreter access') -----
- pop: nItems thenPush: oop
-
- | sp |
- self longAt: (sp := stackPointer - ((nItems - 1) * BytesPerWord)) put: oop.
- stackPointer := sp.
- !
Item was added:
+ ----- Method: NewspeakInterpreter>>pop:thenPush: (in category 'internal interpreter access') -----
+ pop: nItems thenPush: oop
+
+ | sp |
+ self longAt: (sp := stackPointer - ((nItems - 1) * BytesPerWord)) put: oop.
+ stackPointer := sp.
+ !
Item was removed:
- ----- Method: NewspeakInterpreter>>positive32BitIntegerFor: (in category 'primitive support') -----
- positive32BitIntegerFor: integerValue
-
- | newLargeInteger |
- "Note - integerValue is interpreted as POSITIVE, eg, as the result of
- Bitmap>at:, or integer>bitAnd:."
- integerValue >= 0
- ifTrue: [(self isIntegerValue: integerValue)
- ifTrue: [^ self integerObjectOf: integerValue]].
-
- BytesPerWord = 4
- ifTrue: ["Faster instantiateSmallClass: currently only works with integral word size."
- newLargeInteger := self instantiateSmallClass: (self splObj: ClassLargePositiveInteger)
- sizeInBytes: BaseHeaderSize + 4]
- ifFalse: ["Cant use instantiateSmallClass: due to integral word requirement."
- newLargeInteger := self instantiateClass: (self splObj: ClassLargePositiveInteger)
- indexableSize: 4].
- self storeByte: 3 ofObject: newLargeInteger withValue: ((integerValue >> 24) bitAnd: 16rFF).
- self storeByte: 2 ofObject: newLargeInteger withValue: ((integerValue >> 16) bitAnd: 16rFF).
- self storeByte: 1 ofObject: newLargeInteger withValue: ((integerValue >> 8) bitAnd: 16rFF).
- self storeByte: 0 ofObject: newLargeInteger withValue: (integerValue bitAnd: 16rFF).
- ^ newLargeInteger!
Item was added:
+ ----- Method: NewspeakInterpreter>>positive32BitIntegerFor: (in category 'primitive support') -----
+ positive32BitIntegerFor: integerValue
+
+ | newLargeInteger |
+ "Note - integerValue is interpreted as POSITIVE, eg, as the result of
+ Bitmap>at:, or integer>bitAnd:."
+ integerValue >= 0
+ ifTrue: [(self isIntegerValue: integerValue)
+ ifTrue: [^ self integerObjectOf: integerValue]].
+
+ BytesPerWord = 4
+ ifTrue: ["Faster instantiateSmallClass: currently only works with integral word size."
+ newLargeInteger := self instantiateSmallClass: (self splObj: ClassLargePositiveInteger)
+ sizeInBytes: BaseHeaderSize + 4]
+ ifFalse: ["Cant use instantiateSmallClass: due to integral word requirement."
+ newLargeInteger := self instantiateClass: (self splObj: ClassLargePositiveInteger)
+ indexableSize: 4].
+ self storeByte: 3 ofObject: newLargeInteger withValue: ((integerValue >> 24) bitAnd: 16rFF).
+ self storeByte: 2 ofObject: newLargeInteger withValue: ((integerValue >> 16) bitAnd: 16rFF).
+ self storeByte: 1 ofObject: newLargeInteger withValue: ((integerValue >> 8) bitAnd: 16rFF).
+ self storeByte: 0 ofObject: newLargeInteger withValue: (integerValue bitAnd: 16rFF).
+ ^ newLargeInteger!
Item was removed:
- ----- Method: NewspeakInterpreter>>positive32BitValueOf: (in category 'primitive support') -----
- positive32BitValueOf: oop
- "Convert the given object into an integer value.
- The object may be either a positive ST integer or a four-byte LargePositiveInteger."
-
- | sz value |
- (self isIntegerObject: oop) ifTrue: [
- value := self integerValueOf: oop.
- value < 0 ifTrue: [^ self primitiveFail].
- ^ value].
-
- self assertClassOf: oop is: (self splObj: ClassLargePositiveInteger).
- self successful ifTrue: [
- sz := self lengthOf: oop.
- sz = 4 ifFalse: [^ self primitiveFail]].
- self successful ifTrue: [
- ^ (self fetchByte: 0 ofObject: oop) +
- ((self fetchByte: 1 ofObject: oop) << 8) +
- ((self fetchByte: 2 ofObject: oop) << 16) +
- ((self fetchByte: 3 ofObject: oop) << 24) ].!
Item was added:
+ ----- Method: NewspeakInterpreter>>positive32BitValueOf: (in category 'primitive support') -----
+ positive32BitValueOf: oop
+ "Convert the given object into an integer value.
+ The object may be either a positive ST integer or a four-byte LargePositiveInteger."
+
+ | sz value |
+ (self isIntegerObject: oop) ifTrue: [
+ value := self integerValueOf: oop.
+ value < 0 ifTrue: [^ self primitiveFail].
+ ^ value].
+
+ self assertClassOf: oop is: (self splObj: ClassLargePositiveInteger).
+ self successful ifTrue: [
+ sz := self lengthOf: oop.
+ sz = 4 ifFalse: [^ self primitiveFail]].
+ self successful ifTrue: [
+ ^ (self fetchByte: 0 ofObject: oop) +
+ ((self fetchByte: 1 ofObject: oop) << 8) +
+ ((self fetchByte: 2 ofObject: oop) << 16) +
+ ((self fetchByte: 3 ofObject: oop) << 24) ].!
Item was removed:
- ----- Method: NewspeakInterpreter>>positive64BitIntegerFor: (in category 'primitive support') -----
- positive64BitIntegerFor: integerValue
-
- | newLargeInteger value check |
- "Note - integerValue is interpreted as POSITIVE, eg, as the result of
- Bitmap>at:, or integer>bitAnd:."
- <var: 'integerValue' type: 'sqLong'>
-
- (self sizeof: integerValue) = 4 ifTrue: [^self positive32BitIntegerFor: integerValue].
-
- self cCode: 'check = integerValue >> 32'. "Why not run this in sim?"
- check = 0 ifTrue: [^self positive32BitIntegerFor: integerValue].
-
- newLargeInteger :=
- self instantiateSmallClass: (self splObj: ClassLargePositiveInteger) sizeInBytes: BaseHeaderSize + 8.
- 0 to: 7 do: [:i |
- self cCode: 'value = ( integerValue >> (i * 8)) & 255'.
- self storeByte: i ofObject: newLargeInteger withValue: value].
- ^ newLargeInteger!
Item was added:
+ ----- Method: NewspeakInterpreter>>positive64BitIntegerFor: (in category 'primitive support') -----
+ positive64BitIntegerFor: integerValue
+
+ | newLargeInteger value check |
+ "Note - integerValue is interpreted as POSITIVE, eg, as the result of
+ Bitmap>at:, or integer>bitAnd:."
+ <var: 'integerValue' type: 'sqLong'>
+
+ (self sizeof: integerValue) = 4 ifTrue: [^self positive32BitIntegerFor: integerValue].
+
+ self cCode: 'check = integerValue >> 32'. "Why not run this in sim?"
+ check = 0 ifTrue: [^self positive32BitIntegerFor: integerValue].
+
+ newLargeInteger :=
+ self instantiateSmallClass: (self splObj: ClassLargePositiveInteger) sizeInBytes: BaseHeaderSize + 8.
+ 0 to: 7 do: [:i |
+ self cCode: 'value = ( integerValue >> (i * 8)) & 255'.
+ self storeByte: i ofObject: newLargeInteger withValue: value].
+ ^ newLargeInteger!
Item was removed:
- ----- Method: NewspeakInterpreter>>postGCAction: (in category 'object memory support') -----
- postGCAction: gcModeArg
- "Mark the active and home contexts as roots if old. This
- allows the interpreter to use storePointerUnchecked to
- store into them."
-
- activeContext < youngStart ifTrue:
- [self beRootIfOld: activeContext].
- theHomeContext < youngStart ifTrue:
- [self beRootIfOld: theHomeContext].
- (self sizeOfFree: freeBlock) > shrinkThreshold ifTrue:
- ["Attempt to shrink memory after successfully reclaiming lots of memory"
- self shrinkObjectMemory: (self sizeOfFree: freeBlock) - growHeadroom].
-
- self signalSemaphoreWithIndex: gcSemaphoreIndex!
Item was added:
+ ----- Method: NewspeakInterpreter>>postGCAction: (in category 'object memory support') -----
+ postGCAction: gcModeArg
+ "Mark the active and home contexts as roots if old. This
+ allows the interpreter to use storePointerUnchecked to
+ store into them."
+
+ activeContext < youngStart ifTrue:
+ [self beRootIfOld: activeContext].
+ theHomeContext < youngStart ifTrue:
+ [self beRootIfOld: theHomeContext].
+ (self sizeOfFree: freeBlock) > shrinkThreshold ifTrue:
+ ["Attempt to shrink memory after successfully reclaiming lots of memory"
+ self shrinkObjectMemory: (self sizeOfFree: freeBlock) - growHeadroom].
+
+ self signalSemaphoreWithIndex: gcSemaphoreIndex!
Item was removed:
- ----- Method: NewspeakInterpreter>>preGCAction: (in category 'object memory support') -----
- preGCAction: fullGCFlag
-
- self storeContextRegisters: activeContext!
Item was added:
+ ----- Method: NewspeakInterpreter>>preGCAction: (in category 'object memory support') -----
+ preGCAction: fullGCFlag
+
+ self storeContextRegisters: activeContext!
Item was changed:
----- Method: NewspeakInterpreter>>primTraceLogIndex: (in category 'debug support') -----
primTraceLogIndex: aValue
<cmacro: '(aValue) (GIV(primTraceLogIndex) = (aValue))'>
"N.B. primTraceLogIndex is 8-bits"
^primTraceLogIndex := aValue bitAnd: 16rFF!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveArctan (in category 'float primitives') -----
primitiveArctan
| rcvr |
<var: #rcvr type: 'double '>
rcvr := self popFloat.
self successful
ifTrue: [self pushFloat: (self cCode: 'atan(rcvr)' inSmalltalk: [rcvr arcTan])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveAsFloat (in category 'float primitives') -----
primitiveAsFloat
| arg |
arg := self popInteger.
self successful
ifTrue: [ self pushFloat: (self cCode: '((double) arg)' inSmalltalk: [arg asFloat]) ]
ifFalse: [ self unPop: 1 ].!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveExp (in category '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: 'exp(rcvr)' inSmalltalk: [rcvr exp])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveExponent (in category 'float primitives') -----
primitiveExponent
"Exponent part of this float."
| rcvr frac pwr |
<var: #rcvr type: 'double '>
<var: #frac type: 'double '>
<var: #pwr type: 'int '>
rcvr := self popFloat.
self successful
ifTrue: [ "rcvr = frac * 2^pwr, where frac is in [0.5..1.0)"
self cCode: 'frac = frexp(rcvr, &pwr)'
inSmalltalk: [pwr := rcvr exponent].
self pushInteger: pwr - 1]
ifFalse: [self unPop: 1].!
Item was added:
+ ----- Method: NewspeakInterpreter>>primitiveFailureCode (in category 'primitive support') -----
+ primitiveFailureCode
+ <api>
+ ^primFailCode!
Item was removed:
- ----- Method: NewspeakInterpreter>>primitiveFailureCode (in category 'primitive support') -----
- primitiveFailureCode
- <api>
- ^primFailCode!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFloatAdd (in category 'float primitives') -----
primitiveFloatAdd
^ self primitiveFloatAdd: (self stackValue: 1) toArg: self stackTop!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFloatDivide (in category 'float primitives') -----
primitiveFloatDivide
^ self primitiveFloatDivide: (self stackValue: 1) byArg: self stackTop!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFloatEqual (in category 'float primitives') -----
primitiveFloatEqual
| aBool |
aBool := self primitiveFloatEqual: (self stackValue: 1) toArg: self stackTop.
self successful ifTrue: [self pop: 2. self pushBool: aBool].
!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFloatGreaterOrEqual (in category 'float primitives') -----
primitiveFloatGreaterOrEqual
| aBool |
aBool := self primitiveFloatGreaterOrEqual: (self stackValue: 1) toArg: self stackTop.
self successful ifTrue: [self pop: 2 thenPushBool: aBool]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFloatGreaterThan (in category 'float primitives') -----
primitiveFloatGreaterThan
| aBool |
aBool := self primitiveFloatGreater: (self stackValue: 1) thanArg: self stackTop.
self successful ifTrue:
[self pop: 2 thenPushBool: aBool]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFloatLessOrEqual (in category 'float primitives') -----
primitiveFloatLessOrEqual
| aBool |
aBool := self primitiveFloatLessOrEqual: (self stackValue: 1) toArg: self stackTop.
self successful ifTrue: [self pop: 2 thenPushBool: aBool]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFloatLessThan (in category 'float primitives') -----
primitiveFloatLessThan
| aBool |
aBool := self primitiveFloatLess: (self stackValue: 1) thanArg: self stackTop.
self successful ifTrue: [self pop: 2. self pushBool: aBool].
!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFloatMultiply (in category 'float primitives') -----
primitiveFloatMultiply
^ self primitiveFloatMultiply: (self stackValue: 1) byArg: self stackTop!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFloatNotEqual (in category 'float primitives') -----
primitiveFloatNotEqual
| aBool |
aBool := self primitiveFloatEqual: (self stackValue: 1) toArg: self stackTop.
self successful ifTrue: [self pop: 2. self pushBool: aBool not].
!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFloatSubtract (in category 'float primitives') -----
primitiveFloatSubtract
^ self primitiveFloatSubtract: (self stackValue: 1) fromArg: self stackTop!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFractionalPart (in category 'float primitives') -----
primitiveFractionalPart
| rcvr frac trunc |
<var: #rcvr type: 'double '>
<var: #frac type: 'double '>
<var: #trunc type: 'double '>
rcvr := self popFloat.
self successful
ifTrue: [self cCode: 'frac = modf(rcvr, &trunc)' inSmalltalk: [frac := rcvr fractionPart].
self pushFloat: frac]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveLogN (in category 'float primitives') -----
primitiveLogN
"Natural log."
| rcvr |
<var: #rcvr type: 'double '>
rcvr := self popFloat.
self successful
ifTrue: [self pushFloat: (self cCode: 'log(rcvr)' inSmalltalk: [rcvr ln])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveSine (in category 'float primitives') -----
primitiveSine
| rcvr |
<var: #rcvr type: 'double '>
rcvr := self popFloat.
self successful
ifTrue: [self pushFloat: (self cCode: 'sin(rcvr)' inSmalltalk: [rcvr sin])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveSquareRoot (in category 'float primitives') -----
primitiveSquareRoot
| rcvr |
<var: #rcvr type: 'double '>
rcvr := self popFloat.
self success: rcvr >= 0.0.
self successful
ifTrue: [self pushFloat: (self cCode: 'sqrt(rcvr)' inSmalltalk: [rcvr sqrt])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveTimesTwoPower (in category 'float primitives') -----
primitiveTimesTwoPower
| rcvr arg |
<var: #rcvr type: 'double '>
arg := self popInteger.
rcvr := self popFloat.
self successful
ifTrue: [ self pushFloat: (self cCode: 'ldexp(rcvr, arg)' inSmalltalk: [rcvr timesTwoPower: arg]) ]
ifFalse: [ self unPop: 2 ].!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveTruncated (in category 'float primitives') -----
primitiveTruncated
| rcvr frac trunc |
<var: #rcvr type: 'double '>
<var: #frac type: 'double '>
<var: #trunc type: 'double '>
rcvr := self popFloat.
self successful ifTrue:
[self cCode: 'frac = modf(rcvr, &trunc)'
inSmalltalk: [trunc := rcvr truncated].
self flag: #Dan. "The ranges are INCORRECT if SmallIntegers are wider than 31 bits."
self cCode: 'success((-1073741824.0 <= trunc) && (trunc <= 1073741823.0))'
inSmalltalk: [self success: (trunc between: SmallInteger minVal and: SmallInteger maxVal)]].
self successful
ifTrue: [self cCode: 'pushInteger((sqInt) trunc)' inSmalltalk: [self pushInteger: trunc]]
ifFalse: [self unPop: 1]!
Item was added:
+ ----- Method: NewspeakInterpreter>>printChar: (in category 'debug printing') -----
+ printChar: aByte
+ <api>
+ "For testing in Smalltalk, this method should be overridden in a subclass."
+ self putchar: aByte.!
Item was removed:
- ----- Method: NewspeakInterpreter>>printChar: (in category 'debug printing') -----
- printChar: aByte
- <api>
- "For testing in Smalltalk, this method should be overridden in a subclass."
- self putchar: aByte.!
Item was removed:
- ----- Method: NewspeakInterpreter>>printHexPtr: (in category 'debug printing') -----
- printHexPtr: p
- "Print n in hex, passed to 10 characters in the form ' 0x1234'"
- <inline: true>
- <var: #p type: #'void *'>
- self printHex: (self oopForPointer: p)!
Item was added:
+ ----- Method: NewspeakInterpreter>>printHexPtr: (in category 'debug printing') -----
+ printHexPtr: p
+ "Print n in hex, passed to 10 characters in the form ' 0x1234'"
+ <inline: true>
+ <var: #p type: #'void *'>
+ self printHex: (self oopForPointer: p)!
Item was removed:
- ----- Method: NewspeakInterpreter>>printOop: (in category 'debug printing') -----
- printOop: oop
- | cls fmt lastIndex startIP bytecodesPerLine |
- <inline: false>
- self printHex: oop.
- (self isIntegerObject: oop) ifTrue:
- [^self
- cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
- inSmalltalk: [self print: (self shortPrint: oop); cr]].
- (oop between: self startOfMemory and: freeBlock) ifFalse:
- [self printHex: oop; print: ' is not on the heap'; cr.
- ^nil].
- (oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
- [self printHex: oop; print: ' is misaligned'; cr.
- ^nil].
- (self isFreeObject: oop) ifTrue:
- [self print: ' free chunk of size '; printNum: (self sizeOfFree: oop); cr.
- ^nil].
- self print: ': a(n) '.
- self printNameOfClass: (cls := self fetchClassOfNonImm: oop) count: 5.
- cls = (self splObj: ClassFloat) ifTrue:
- [self cr; printFloat: (self dbgFloatValueOf: oop); cr.
- ^nil].
- fmt := self formatOf: oop.
- fmt > 4 ifTrue:
- [self print: ' nbytes '; printNum: (self byteSizeOf: oop)].
- self cr.
- (fmt > 4 and: [fmt < 12]) ifTrue:
- [(self isWords: oop) ifTrue:
- [lastIndex := 64 min: ((self byteSizeOf: oop) / BytesPerWord).
- lastIndex > 0 ifTrue:
- [1 to: lastIndex do:
- [:index|
- self space; printHex: (self fetchLong32: index - 1 ofObject: oop).
- (index \\ self elementsPerPrintOopLine) = 0 ifTrue:
- [self cr]].
- (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
- [self cr]].
- ^nil].
- ^self printStringOf: oop; cr].
- lastIndex := 64 min: (startIP := (self lastPointerOf: oop) / BytesPerWord).
- lastIndex > 0 ifTrue:
- [1 to: lastIndex do:
- [:index|
- self cCode: 'printHex(fetchPointerofObject(index - 1, oop)); putchar('' '')'
- inSmalltalk: [self space; printHex: (self fetchPointer: index - 1 ofObject: oop); space.
- self print: (self shortPrint: (self fetchPointer: index - 1 ofObject: oop))].
- (index \\ self elementsPerPrintOopLine) = 0 ifTrue:
- [self cr]].
- (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
- [self cr]].
- (self isCompiledMethod: oop)
- ifFalse:
- [startIP > 64 ifTrue: [self print: '...'; cr]]
- ifTrue:
- [startIP := startIP * BytesPerWord + 1.
- lastIndex := self lengthOf: oop.
- lastIndex - startIP > 100 ifTrue:
- [lastIndex := startIP + 100].
- bytecodesPerLine := 10.
- startIP to: lastIndex do:
- [:index| | byte |
- byte := self fetchByte: index - 1 ofObject: oop.
- self cCode: 'printf(" %02x/%-3d", byte,byte)'
- inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
- ((index - startIP + 1) \\ bytecodesPerLine) = 0 ifTrue:
- [self cr]].
- ((lastIndex - startIP + 1) \\ bytecodesPerLine) = 0 ifFalse:
- [self cr]]!
Item was added:
+ ----- Method: NewspeakInterpreter>>printOop: (in category 'debug printing') -----
+ printOop: oop
+ | cls fmt lastIndex startIP bytecodesPerLine |
+ <inline: false>
+ self printHex: oop.
+ (self isIntegerObject: oop) ifTrue:
+ [^self
+ cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
+ inSmalltalk: [self print: (self shortPrint: oop); cr]].
+ (oop between: self startOfMemory and: freeBlock) ifFalse:
+ [self printHex: oop; print: ' is not on the heap'; cr.
+ ^nil].
+ (oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
+ [self printHex: oop; print: ' is misaligned'; cr.
+ ^nil].
+ (self isFreeObject: oop) ifTrue:
+ [self print: ' free chunk of size '; printNum: (self sizeOfFree: oop); cr.
+ ^nil].
+ self print: ': a(n) '.
+ self printNameOfClass: (cls := self fetchClassOfNonImm: oop) count: 5.
+ cls = (self splObj: ClassFloat) ifTrue:
+ [self cr; printFloat: (self dbgFloatValueOf: oop); cr.
+ ^nil].
+ fmt := self formatOf: oop.
+ fmt > 4 ifTrue:
+ [self print: ' nbytes '; printNum: (self byteSizeOf: oop)].
+ self cr.
+ (fmt > 4 and: [fmt < 12]) ifTrue:
+ [(self isWords: oop) ifTrue:
+ [lastIndex := 64 min: ((self byteSizeOf: oop) / BytesPerWord).
+ lastIndex > 0 ifTrue:
+ [1 to: lastIndex do:
+ [:index|
+ self space; printHex: (self fetchLong32: index - 1 ofObject: oop).
+ (index \\ self elementsPerPrintOopLine) = 0 ifTrue:
+ [self cr]].
+ (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
+ [self cr]].
+ ^nil].
+ ^self printStringOf: oop; cr].
+ lastIndex := 64 min: (startIP := (self lastPointerOf: oop) / BytesPerWord).
+ lastIndex > 0 ifTrue:
+ [1 to: lastIndex do:
+ [:index|
+ self cCode: 'printHex(fetchPointerofObject(index - 1, oop)); putchar('' '')'
+ inSmalltalk: [self space; printHex: (self fetchPointer: index - 1 ofObject: oop); space.
+ self print: (self shortPrint: (self fetchPointer: index - 1 ofObject: oop))].
+ (index \\ self elementsPerPrintOopLine) = 0 ifTrue:
+ [self cr]].
+ (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
+ [self cr]].
+ (self isCompiledMethod: oop)
+ ifFalse:
+ [startIP > 64 ifTrue: [self print: '...'; cr]]
+ ifTrue:
+ [startIP := startIP * BytesPerWord + 1.
+ lastIndex := self lengthOf: oop.
+ lastIndex - startIP > 100 ifTrue:
+ [lastIndex := startIP + 100].
+ bytecodesPerLine := 10.
+ startIP to: lastIndex do:
+ [:index| | byte |
+ byte := self fetchByte: index - 1 ofObject: oop.
+ self cCode: 'printf(" %02x/%-3d", byte,byte)'
+ inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
+ ((index - startIP + 1) \\ bytecodesPerLine) = 0 ifTrue:
+ [self cr]].
+ ((lastIndex - startIP + 1) \\ bytecodesPerLine) = 0 ifFalse:
+ [self cr]]!
Item was added:
+ ----- Method: NewspeakInterpreter>>pushFloat: (in category 'stack bytecodes') -----
+ pushFloat: f
+
+ <var: #f type: 'double '>
+ self push: (self floatObjectOf: f).!
Item was removed:
- ----- Method: NewspeakInterpreter>>pushFloat: (in category 'stack bytecodes') -----
- pushFloat: f
-
- <var: #f type: 'double '>
- self push: (self floatObjectOf: f).!
Item was removed:
- ----- Method: NewspeakInterpreter>>pushInteger: (in category 'internal interpreter access') -----
- pushInteger: integerValue
- self push: (self integerObjectOf: integerValue).!
Item was added:
+ ----- Method: NewspeakInterpreter>>pushInteger: (in category 'internal interpreter access') -----
+ pushInteger: integerValue
+ self push: (self integerObjectOf: integerValue).!
Item was added:
+ ----- Method: NewspeakInterpreter>>putLong:toFile: (in category 'image save/restore') -----
+ putLong: aWord toFile: aFile
+ "Append aWord to aFile in this platforms 'natural' byte order. (Bytes will be swapped, if
+ necessary, when the image is read on a different platform.) Set successFlag to false if
+ the write fails."
+
+ | objectsWritten |
+ <var: #aFile type: 'sqImageFile '>
+
+ objectsWritten := self cCode: 'sqImageFileWrite(&aWord, sizeof(aWord), 1, aFile)'.
+ self success: objectsWritten = 1.
+ !
Item was removed:
- ----- Method: NewspeakInterpreter>>putLong:toFile: (in category 'image save/restore') -----
- putLong: aWord toFile: aFile
- "Append aWord to aFile in this platforms 'natural' byte order. (Bytes will be swapped, if
- necessary, when the image is read on a different platform.) Set successFlag to false if
- the write fails."
-
- | objectsWritten |
- <var: #aFile type: 'sqImageFile '>
-
- objectsWritten := self cCode: 'sqImageFileWrite(&aWord, sizeof(aWord), 1, aFile)'.
- self success: objectsWritten = 1.
- !
Item was changed:
----- Method: NewspeakInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize |
<var: #f type: 'sqImageFile '>
<var: #memStart type: 'usqInt'>
<var: #desiredHeapSize type: 'usqInt'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #dataSize type: 'size_t '>
<var: #imageOffset type: 'squeakFileOffsetType '>
metaclassSizeBits := 7 * BytesPerWord. "guess (Metaclass instSize+1 * 4)"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
specialObjectsOop := self getLongFromFile: f swap: swapBytes.
lastHash := self getLongFromFile: f swap: swapBytes.
savedWindowSize := self getLongFromFile: f swap: swapBytes.
fullScreenFlag := self getLongFromFile: f swap: swapBytes.
extraVMMemory := self getLongFromFile: f swap: swapBytes.
lastHash = 0 ifTrue: [
"lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
lastHash := 999].
"decrease Squeak object heap to leave extra memory for the VM"
heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
"compare memory requirements with availability".
minimumMemory := dataSize + 100000. "need at least 100K of breathing room"
heapSize < minimumMemory ifTrue: [
self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap"
memory := self
allocateMemory: heapSize
minimum: minimumMemory
imageFile: f
headerSize: headerSize.
memory = nil ifTrue: [self insufficientMemoryAvailableError].
memStart := self startOfMemory.
memoryLimit := (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety"
endOfMemory := memStart + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
bytesRead := self cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
swapBytes ifTrue: [self reverseBytesInImage].
"compute difference between old and new memory base addresses"
bytesToShift := memStart - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
^dataSize!
Item was changed:
----- Method: NewspeakInterpreter>>readableFormat: (in category 'image save/restore') -----
readableFormat: imageVersion
"Anwer true if images of the given format are readable by this interpreter. Allows a virtual machine to accept selected older image formats. In our case we can select a newer (closure) image format as well as the existing format."
^ imageVersion = self imageFormatVersion
or: [imageVersion = self imageFormatForwardCompatibilityVersion]
"
Example of multiple formats:
^ (imageVersion = self imageFormatVersion) or: [imageVersion = 6504]
"!
Item was changed:
----- Method: NewspeakInterpreter>>reverseBytesInImage (in category 'image save/restore') -----
reverseBytesInImage
"Byte-swap all words in memory after reading in the entire image file with bulk read. Contributed by Tim Rowledge."
"First, byte-swap every word in the image. This fixes objects headers."
self reverseBytesFrom: self startOfMemory to: endOfMemory.
"Second, return the bytes of bytes-type objects to their orginal order."
self byteSwapByteObjects.!
Item was changed:
----- Method: NewspeakInterpreter>>sendTraceLogIndex: (in category 'debug support') -----
sendTraceLogIndex: aValue
<cmacro: '(aValue) (GIV(sendTraceLogIndex) = (aValue))'>
"N.B. sendTraceLogIndex is 8-bits"
^sendTraceLogIndex := aValue bitAnd: 16rFF!
Item was changed:
----- Method: NewspeakInterpreter>>setBreakSelector: (in category 'debug support') -----
setBreakSelector: aString
<api>
<var: #aString type: #'char *'>
aString isNil
ifTrue: [breakSelectorLength := -1. "nil's effective length is zero" breakSelector := nil]
ifFalse: [breakSelectorLength := self strlen: aString. breakSelector := aString]!
Item was added:
+ ----- Method: NewspeakInterpreter>>showDisplayBits:Left:Top:Right:Bottom: (in category 'I/O primitive support') -----
+ showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
+ "Repaint the portion of the Smalltalk screen bounded by the affected rectangle. Used to synchronize the screen after a Bitblt to the Smalltalk Display object."
+ deferDisplayUpdates ifTrue: [^ nil].
+ self displayBitsOf: aForm Left: l Top: t Right: r Bottom: b!
Item was removed:
- ----- Method: NewspeakInterpreter>>showDisplayBits:Left:Top:Right:Bottom: (in category 'I/O primitive support') -----
- showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
- "Repaint the portion of the Smalltalk screen bounded by the affected rectangle. Used to synchronize the screen after a Bitblt to the Smalltalk Display object."
- deferDisplayUpdates ifTrue: [^ nil].
- self displayBitsOf: aForm Left: l Top: t Right: r Bottom: b!
Item was removed:
- ----- Method: NewspeakInterpreter>>signalFinalization: (in category 'process primitive support') -----
- signalFinalization: weakReferenceOop
- "If it is not there already, record the given semaphore index in the list of semaphores to be signaled at the next convenient moment. Force a real interrupt check as soon as possible."
-
- self forceInterruptCheck.
- pendingFinalizationSignals := pendingFinalizationSignals + 1.!
Item was added:
+ ----- Method: NewspeakInterpreter>>signalFinalization: (in category 'process primitive support') -----
+ signalFinalization: weakReferenceOop
+ "If it is not there already, record the given semaphore index in the list of semaphores to be signaled at the next convenient moment. Force a real interrupt check as soon as possible."
+
+ self forceInterruptCheck.
+ pendingFinalizationSignals := pendingFinalizationSignals + 1.!
Item was removed:
- ----- Method: NewspeakInterpreter>>signed32BitIntegerFor: (in category 'primitive support') -----
- signed32BitIntegerFor: integerValue
- "Return a full 32 bit integer object for the given integer value"
- | newLargeInteger value largeClass |
- <inline: false>
- (self isIntegerValue: integerValue)
- ifTrue: [^ self integerObjectOf: integerValue].
- integerValue < 0
- ifTrue:[ largeClass := self classLargeNegativeInteger.
- value := 0 - integerValue]
- ifFalse:[ largeClass := self classLargePositiveInteger.
- value := integerValue].
- newLargeInteger := self instantiateClass: largeClass indexableSize: 4.
- self storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF).
- self storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF).
- self storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF).
- self storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF).
- ^ newLargeInteger!
Item was added:
+ ----- Method: NewspeakInterpreter>>signed32BitIntegerFor: (in category 'primitive support') -----
+ signed32BitIntegerFor: integerValue
+ "Return a full 32 bit integer object for the given integer value"
+ | newLargeInteger value largeClass |
+ <inline: false>
+ (self isIntegerValue: integerValue)
+ ifTrue: [^ self integerObjectOf: integerValue].
+ integerValue < 0
+ ifTrue:[ largeClass := self classLargeNegativeInteger.
+ value := 0 - integerValue]
+ ifFalse:[ largeClass := self classLargePositiveInteger.
+ value := integerValue].
+ newLargeInteger := self instantiateClass: largeClass indexableSize: 4.
+ self storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF).
+ self storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF).
+ self storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF).
+ self storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF).
+ ^ newLargeInteger!
Item was removed:
- ----- Method: NewspeakInterpreter>>signed32BitValueOf: (in category 'primitive support') -----
- signed32BitValueOf: oop
- "Convert the given object into an integer value.
- The object may be either a positive ST integer or a four-byte LargeInteger."
- | sz value largeClass negative |
- <inline: false>
- <returnTypeC: 'int'>
- <var: 'value' type: 'int'>
- (self isIntegerObject: oop) ifTrue: [^self integerValueOf: oop].
- (self lengthOf: oop) > 4 ifTrue: [^ self primitiveFail].
- largeClass := self fetchClassOf: oop.
- largeClass = self classLargePositiveInteger
- ifTrue:[negative := false]
- ifFalse:[largeClass = self classLargeNegativeInteger
- ifTrue:[negative := true]
- ifFalse:[^self primitiveFail]].
- sz := self lengthOf: oop.
- sz = 4 ifFalse: [^ self primitiveFail].
- value := (self fetchByte: 0 ofObject: oop) +
- ((self fetchByte: 1 ofObject: oop) << 8) +
- ((self fetchByte: 2 ofObject: oop) << 16) +
- ((self fetchByte: 3 ofObject: oop) << 24).
- "Fail if value exceeds range of a 32-bit two's-complement signed integer."
- value < 0 ifTrue:
- [self assert: (self sizeof: value) == 4.
- "Don't fail for -16r80000000/-2147483648
- Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
- overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
- (negative and: [0 = (self cCode: [value << 1]
- inSmalltalk: [value << 1 bitAnd: (1 << 32) - 1])]) ifTrue:
- [^value].
- ^self primitiveFail].
- ^negative
- ifTrue: [0 - value]
- ifFalse: [value]!
Item was added:
+ ----- Method: NewspeakInterpreter>>signed32BitValueOf: (in category 'primitive support') -----
+ signed32BitValueOf: oop
+ "Convert the given object into an integer value.
+ The object may be either a positive ST integer or a four-byte LargeInteger."
+ | sz value largeClass negative |
+ <inline: false>
+ <returnTypeC: 'int'>
+ <var: 'value' type: 'int'>
+ (self isIntegerObject: oop) ifTrue: [^self integerValueOf: oop].
+ (self lengthOf: oop) > 4 ifTrue: [^ self primitiveFail].
+ largeClass := self fetchClassOf: oop.
+ largeClass = self classLargePositiveInteger
+ ifTrue:[negative := false]
+ ifFalse:[largeClass = self classLargeNegativeInteger
+ ifTrue:[negative := true]
+ ifFalse:[^self primitiveFail]].
+ sz := self lengthOf: oop.
+ sz = 4 ifFalse: [^ self primitiveFail].
+ value := (self fetchByte: 0 ofObject: oop) +
+ ((self fetchByte: 1 ofObject: oop) << 8) +
+ ((self fetchByte: 2 ofObject: oop) << 16) +
+ ((self fetchByte: 3 ofObject: oop) << 24).
+ "Fail if value exceeds range of a 32-bit two's-complement signed integer."
+ value < 0 ifTrue:
+ [self assert: (self sizeof: value) == 4.
+ "Don't fail for -16r80000000/-2147483648
+ Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
+ overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
+ (negative and: [0 = (self cCode: [value << 1]
+ inSmalltalk: [value << 1 bitAnd: (1 << 32) - 1])]) ifTrue:
+ [^value].
+ ^self primitiveFail].
+ ^negative
+ ifTrue: [0 - value]
+ ifFalse: [value]!
Item was changed:
----- Method: NewspeakInterpreter>>snapshot: (in category 'image save/restore') -----
snapshot: embedded
"update state of active context"
| activeProc dataSize rcvr setMacType |
<var: #setMacType type: 'void *'>
self storeContextRegisters: activeContext.
"update state of active process"
activeProc := self activeProcess.
self
storePointer: SuspendedContextIndex
ofObject: activeProc
withValue: activeContext.
"compact memory and compute the size of the memory actually in use"
self incrementalGC.
"maximimize space for forwarding table"
self fullGC.
self snapshotCleanUp.
dataSize := freeBlock - self startOfMemory. "Assume all objects are below the start of the free block"
self successful ifTrue:
[rcvr := self popStack.
"pop rcvr"
self push: trueObj.
self writeImageFile: dataSize.
embedded ifFalse:
["set Mac file type and creator; this is a noop on other platforms"
setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'.
setMacType = 0 ifFalse:
[self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']].
self pop: 1].
"activeContext was unmarked in #snapshotCleanUp, mark it old "
self beRootIfOld: activeContext.
self successful
ifTrue: [self push: falseObj]
ifFalse: [self push: rcvr]!
Item was changed:
----- Method: NewspeakInterpreter>>snapshotCleanUp (in category 'image save/restore') -----
snapshotCleanUp
"Clean up right before saving an image, sweeping memory and:
* nilling out all fields of contexts above the stack pointer.
* flushing external primitives
* clearing the root bit of any object in the root table "
| oop header fmt sz |
oop := self firstObject.
[oop < endOfMemory]
whileTrue: [(self isFreeObject: oop)
ifFalse: [header := self longAt: oop.
fmt := header >> 8 bitAnd: 15.
"Clean out context"
(fmt = 3 and: [self isContextHeader: header])
ifTrue: [sz := self sizeBitsOf: oop.
(self lastPointerOf: oop) + BytesPerWord
to: sz - BaseHeaderSize by: BytesPerWord
do: [:i | self longAt: oop + i put: nilObj]].
"Clean out external functions"
fmt >= 12
ifTrue: ["This is a compiled method"
(self primitiveIndexOf: oop) = PrimitiveExternalCallIndex
ifTrue: ["It's primitiveExternalCall"
self flushExternalPrimitiveOf: oop]]].
oop := self objectAfter: oop].
self clearRootsTable!
Item was added:
+ ----- Method: NewspeakInterpreter>>stObject:at: (in category 'indexing primitive support') -----
+ stObject: array at: index
+ "Return what ST would return for <obj> at: index."
+
+ | hdr fmt totalLength fixedFields stSize |
+ <inline: false>
+ hdr := self baseHeader: array.
+ fmt := self formatOfHeader: hdr.
+ totalLength := self lengthOf: array baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
+ (fmt = 3 and: [self isContextHeader: hdr])
+ ifTrue: [stSize := self fetchStackPointerOf: array]
+ ifFalse: [stSize := totalLength - fixedFields].
+ ((self oop: index isGreaterThanOrEqualTo: 1)
+ and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
+ [^self subscript: array with: (index + fixedFields) format: fmt].
+ self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex]).
+ ^0!
Item was removed:
- ----- Method: NewspeakInterpreter>>stObject:at: (in category 'indexing primitive support') -----
- stObject: array at: index
- "Return what ST would return for <obj> at: index."
-
- | hdr fmt totalLength fixedFields stSize |
- <inline: false>
- hdr := self baseHeader: array.
- fmt := self formatOfHeader: hdr.
- totalLength := self lengthOf: array baseHeader: hdr format: fmt.
- fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
- (fmt = 3 and: [self isContextHeader: hdr])
- ifTrue: [stSize := self fetchStackPointerOf: array]
- ifFalse: [stSize := totalLength - fixedFields].
- ((self oop: index isGreaterThanOrEqualTo: 1)
- and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
- [^self subscript: array with: (index + fixedFields) format: fmt].
- self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex]).
- ^0!
Item was removed:
- ----- Method: NewspeakInterpreter>>stObject:at:put: (in category 'indexing primitive support') -----
- stObject: array at: index put: value
- "Do what ST would return for <obj> at: index put: value."
- | hdr fmt totalLength fixedFields stSize |
- <inline: false>
- hdr := self baseHeader: array.
- fmt := self formatOfHeader: hdr.
- totalLength := self lengthOf: array baseHeader: hdr format: fmt.
- fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
- (fmt = 3 and: [self isContextHeader: hdr])
- ifTrue: [stSize := self fetchStackPointerOf: array]
- ifFalse: [stSize := totalLength - fixedFields].
- ((self oop: index isGreaterThanOrEqualTo: 1)
- and: [self oop: index isLessThanOrEqualTo: stSize])
- ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
- ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])].
- ^value!
Item was added:
+ ----- Method: NewspeakInterpreter>>stObject:at:put: (in category 'indexing primitive support') -----
+ stObject: array at: index put: value
+ "Do what ST would return for <obj> at: index put: value."
+ | hdr fmt totalLength fixedFields stSize |
+ <inline: false>
+ hdr := self baseHeader: array.
+ fmt := self formatOfHeader: hdr.
+ totalLength := self lengthOf: array baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
+ (fmt = 3 and: [self isContextHeader: hdr])
+ ifTrue: [stSize := self fetchStackPointerOf: array]
+ ifFalse: [stSize := totalLength - fixedFields].
+ ((self oop: index isGreaterThanOrEqualTo: 1)
+ and: [self oop: index isLessThanOrEqualTo: stSize])
+ ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
+ ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])].
+ ^value!
Item was added:
+ ----- Method: NewspeakInterpreter>>stackIntegerValue: (in category 'internal interpreter access') -----
+ stackIntegerValue: offset
+ | integerPointer |
+ integerPointer := self longAt: stackPointer - (offset*BytesPerWord).
+ ^self checkedIntegerValueOf: integerPointer!
Item was removed:
- ----- Method: NewspeakInterpreter>>stackIntegerValue: (in category 'internal interpreter access') -----
- stackIntegerValue: offset
- | integerPointer |
- integerPointer := self longAt: stackPointer - (offset*BytesPerWord).
- ^self checkedIntegerValueOf: integerPointer!
Item was added:
+ ----- Method: NewspeakInterpreter>>stackValue: (in category 'internal interpreter access') -----
+ stackValue: offset
+ ^ self longAt: stackPointer - (offset*BytesPerWord)!
Item was removed:
- ----- Method: NewspeakInterpreter>>stackValue: (in category 'internal interpreter access') -----
- stackValue: offset
- ^ self longAt: stackPointer - (offset*BytesPerWord)!
Item was changed:
----- Method: NewspeakInterpreter>>symbolicMethod: (in category 'debug support') -----
symbolicMethod: aMethod
<doNotGenerate>
| ts prim |
(ts := self transcript) ensureCr.
(prim := self primitiveIndexOf: aMethod) > 0 ifTrue:
[ts nextPutAll: '<primitive: '; print: prim; nextPut: $>.
(self isQuickPrimitiveIndex: prim) ifTrue:
[ts nextPutAll: ' quick method'; cr; flush.
^self].
ts cr].
(InstructionPrinter
on: (VMCompiledMethodProxy new
for: method
coInterpreter: self
objectMemory: self))
indent: 0;
printInstructionsOn: ts.
ts flush!
Item was changed:
----- Method: NewspeakInterpreter>>validInstructionPointer:inMethod: (in category 'debug support') -----
validInstructionPointer: anInstrPointer inMethod: aMethod
^anInstrPointer >= (aMethod + (self lastPointerOf: aMethod) + 1)
and: [anInstrPointer < (aMethod + (self byteLengthOf: aMethod))]!
Item was changed:
----- Method: NewspeakInterpreter>>wordSwapped: (in category 'image save/restore') -----
wordSwapped: w
"Return the given 64-bit integer with its halves in the reverse order."
BytesPerWord = 8 ifFalse: [self error: 'This cannot happen.'].
^ ((w bitShift: Byte4ShiftNegated) bitAnd: Bytes3to0Mask)
+ ((w bitShift: Byte4Shift ) bitAnd: Bytes7to4Mask)
!
Item was changed:
----- Method: NewspeakInterpreter>>writeImageFile: (in category 'image save/restore') -----
writeImageFile: imageBytes
| fn |
<var: #fn type: 'void *'>
self writeImageFileIO: imageBytes.
"set Mac file type and creator; this is a noop on other platforms"
fn := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'.
fn = 0 ifFalse:[
self cCode:'((sqInt (*)(char*, char*, char*))fn)(imageName, "STim", "FAST")'.
].
!
Item was changed:
----- Method: NewspeakInterpreter>>writeImageFileIO: (in category 'image save/restore') -----
writeImageFileIO: imageBytes
| headerStart headerSize f bytesWritten sCWIfn okToWrite |
<var: #f type: 'sqImageFile'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #sCWIfn type: 'void *'>
"If the security plugin can be loaded, use it to check for write permission.
If not, assume it's ok"
sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
sCWIfn ~= 0 ifTrue:[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
okToWrite ifFalse:[^self primitiveFail]].
"local constants"
headerStart := 0.
headerSize := 64. "header size in bytes; do not change!!"
f := self cCode: 'sqImageFileOpen(imageName, "wb")'.
f = nil ifTrue: [
"could not open the image file for writing"
self success: false.
^ nil].
headerStart := self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+imageBytes)'.
self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
"position file to start of header"
self sqImageFile: f Seek: headerStart.
self putLong: (self imageFormatVersion) toFile: f.
self putLong: headerSize toFile: f.
self putLong: imageBytes toFile: f.
self putLong: (self startOfMemory) toFile: f.
self putLong: specialObjectsOop toFile: f.
self putLong: lastHash toFile: f.
self putLong: (self ioScreenSize) toFile: f.
self putLong: fullScreenFlag toFile: f.
self putLong: extraVMMemory toFile: f.
1 to: 7 do: [:i | self putLong: 0 toFile: f]. "fill remaining header words with zeros"
self successful ifFalse: [
"file write or seek failure"
self cCode: 'sqImageFileClose(f)'.
^ nil].
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"write the image data"
bytesWritten := self cCode: 'sqImageFileWrite(pointerForOop(memory), sizeof(unsigned char), imageBytes, f)'.
self success: bytesWritten = imageBytes.
self cCode: 'sqImageFileClose(f)'.
!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>allObjectsSelect: (in category 'debug support') -----
allObjectsSelect: objBlock
"self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]"
| oop selected |
oop := self firstObject.
selected := OrderedCollection new.
[oop < endOfMemory] whileTrue:
[(self isFreeObject: oop)
ifFalse: [(objBlock value: oop) ifTrue: [selected addLast: oop]].
oop := self objectAfter: oop].
^ selected!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>allocate:headerSize:h1:h2:h3:doFill:format: (in category 'debugging traps') -----
allocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOop h3: extendedSize doFill: doFill format: format
| newObj |
newObj := super allocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOop h3: extendedSize doFill: doFill format: format.
"byteCount < 600000 ifTrue: [^ newObj]."
"(self baseHeader: newObj) = 16r0FCC0600 ifTrue: [self halt]."
^ newObj!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
^self subclassResponsibility!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
^self subclassResponsibility!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>byteAtPointer: (in category 'memory access') -----
- byteAtPointer: pointer
- "This gets implemented by Macros in C, where its types will also be checked.
- pointer is a raw address, and byte is an 8-bit quantity."
-
- ^ self byteAt: pointer!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>byteAtPointer: (in category 'memory access') -----
+ byteAtPointer: pointer
+ "This gets implemented by Macros in C, where its types will also be checked.
+ pointer is a raw address, and byte is an 8-bit quantity."
+
+ ^ self byteAt: pointer!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>byteAtPointer:put: (in category 'memory access') -----
- byteAtPointer: pointer put: byteValue
- "This gets implemented by Macros in C, where its types will also be checked.
- pointer is a raw address, and byteValue is an 8-bit quantity."
-
- ^ self byteAt: pointer put: byteValue!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>byteAtPointer:put: (in category 'memory access') -----
+ byteAtPointer: pointer put: byteValue
+ "This gets implemented by Macros in C, where its types will also be checked.
+ pointer is a raw address, and byteValue is an 8-bit quantity."
+
+ ^ self byteAt: pointer put: byteValue!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>byteCount (in category 'debug support') -----
byteCount
"So you can call this from temp debug statements in, eg, Interpreter, such as
self byteCount = 12661 ifTrue: [self halt].
"
^ byteCount!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>cCoerce:to: (in category 'memory access') -----
cCoerce: value to: cTypeString
"Type coercion for translation only; just return the value when running in Smalltalk."
^value == nil
ifTrue: [value]
ifFalse: [value coerceTo: cTypeString sim: self]!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>charsOfLong: (in category 'debug support') -----
+ charsOfLong: long
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>charsOfLong: (in category 'debug support') -----
- charsOfLong: long
- ^self subclassResponsibility!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>checkForInterrupts (in category 'debug support') -----
checkForInterrupts
"Prevent interrupts so that traces are consistent during detailed debugging"
"self halt."
true ifTrue:
[interruptCheckCounter := 1000.
^self].
^ super checkForInterrupts!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>classAndSelectorOfMethod:forReceiver: (in category 'debug support') -----
classAndSelectorOfMethod: meth forReceiver: rcvr
| mClass dict length methodArray |
mClass := self fetchClassOf: rcvr.
[dict := self fetchPointer: MethodDictionaryIndex ofObject: mClass.
length := self fetchWordLengthOf: dict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: dict.
0 to: length-SelectorStart-1 do:
[:index |
meth = (self fetchPointer: index ofObject: methodArray)
ifTrue: [^ Array
with: mClass
with: (self fetchPointer: index + SelectorStart ofObject: dict)]].
mClass := self fetchPointer: SuperclassIndex ofObject: mClass.
mClass = nilObj]
whileFalse: [].
^ Array
with: (self fetchClassOf: rcvr)
with: (self splObj: SelectorDoesNotUnderstand)!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>commonSend (in category 'debugging traps') -----
commonSend
printSends ifTrue:
[self print: byteCount; space; printStringOf: messageSelector; cr].
^super commonSend!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>dumpHeader: (in category 'debug support') -----
dumpHeader: hdr
| cc |
^ String streamContents: [:strm |
cc := (hdr bitAnd: CompactClassMask) >> 12.
strm nextPutAll: '<cc=', cc hex.
cc > 0 ifTrue:
[strm nextPutAll: ':' , (self nameOfClass: (self compactClassAt: cc))].
strm nextPutAll: '>'.
strm nextPutAll: '<ft=', ((hdr bitShift: -8) bitAnd: 16rF) hex , '>'.
strm nextPutAll: '<sz=', (hdr bitAnd: SizeMask) hex , '>'.
strm nextPutAll: '<hdr=', (#(big class gcMark short) at: (hdr bitAnd: 3) +1) , '>']
!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>dumpMethodHeader: (in category 'debug support') -----
dumpMethodHeader: hdr
^ String streamContents:
[:strm |
strm nextPutAll: '<nArgs=', ((hdr >> 25) bitAnd: 16r1F) printString , '>'.
strm nextPutAll: '<nTemps=', ((hdr >> 19) bitAnd: 16r3F) printString , '>'.
strm nextPutAll: '<lgCtxt=', ((hdr >> 18) bitAnd: 16r1) printString , '>'.
strm nextPutAll: '<nLits=', ((hdr >> 10) bitAnd: 16rFF) printString , '>'.
strm nextPutAll: '<prim=', ((hdr >> 1) bitAnd: 16r1FF) printString , '>'.
]!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>fetchFloatAt:into: (in category 'float primitives') -----
+ fetchFloatAt: floatBitsAddress into: aFloat
+
+ aFloat at: 1 put: (self long32At: floatBitsAddress).
+ aFloat at: 2 put: (self long32At: floatBitsAddress+4).
+ !
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>fetchFloatAt:into: (in category 'float primitives') -----
- fetchFloatAt: floatBitsAddress into: aFloat
-
- aFloat at: 1 put: (self long32At: floatBitsAddress).
- aFloat at: 2 put: (self long32At: floatBitsAddress+4).
- !
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>firstIndexableField: (in category 'memory access') -----
+ firstIndexableField: oop
+ "NOTE: overridden from ObjectMemory to add coercion to CArray, so please duplicate any changes"
+ | hdr fmt totalLength fixedFields |
+ <returnTypeC: #'void *'>
+ hdr := self baseHeader: oop.
+ fmt := self formatOfHeader: hdr.
+ fmt <= 4 ifTrue: "<= 4 pointer"
+ ["pointer; may need to delve into the class format word"
+ totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
+ ^self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)) to: 'oop *'].
+ ^self
+ cCoerce: (self pointerForOop: oop + BaseHeaderSize)
+ to: (fmt < 8
+ ifTrue: [fmt = 6
+ ifTrue: ["32 bit field objects" 'int *']
+ ifFalse: ["full word objects (bits)" 'oop *']]
+ ifFalse: ["byte objects (including CompiledMethod" 'char *'])!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>firstIndexableField: (in category 'memory access') -----
- firstIndexableField: oop
- "NOTE: overridden from ObjectMemory to add coercion to CArray, so please duplicate any changes"
- | hdr fmt totalLength fixedFields |
- <returnTypeC: #'void *'>
- hdr := self baseHeader: oop.
- fmt := self formatOfHeader: hdr.
- fmt <= 4 ifTrue: "<= 4 pointer"
- ["pointer; may need to delve into the class format word"
- totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
- fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
- ^self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)) to: 'oop *'].
- ^self
- cCoerce: (self pointerForOop: oop + BaseHeaderSize)
- to: (fmt < 8
- ifTrue: [fmt = 6
- ifTrue: ["32 bit field objects" 'int *']
- ifFalse: ["full word objects (bits)" 'oop *']]
- ifFalse: ["byte objects (including CompiledMethod" 'char *'])!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>fullDisplayUpdate (in category 'debug support') -----
fullDisplayUpdate
"Preserve successFlag when call asynchronously from Simulator"
| s |
s := primFailCode.
primFailCode := true.
super fullDisplayUpdate.
primFailCode := s!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>fullGC (in category 'debug support') -----
- fullGC
- transcript cr; show:'<Running full GC ...'.
- super fullGC.
- transcript show: ' done>'.!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>fullGC (in category 'debug support') -----
+ fullGC
+ transcript cr; show:'<Running full GC ...'.
+ super fullGC.
+ transcript show: ' done>'.!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- ^self subclassResponsibility!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- ^self subclassResponsibility!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ ^self subclassResponsibility!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>headerStart: (in category 'debug support') -----
headerStart: oop
^ (self extraHeaderBytes: oop) negated!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>hexDump100: (in category 'debug support') -----
hexDump100: oop
| byteSize val |
^ String streamContents:
[:strm |
byteSize := 256.
(self headerStart: oop) to: byteSize by: 4 do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: (oop+a) hex8; space; space;
nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space; nextPutAll: val hex8;
space; space.
strm nextPutAll: (self charsOfLong: val).
strm space; space; nextPutAll: (oop+a) printString]]!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>hexDump: (in category 'debug support') -----
hexDump: oop
| byteSize val |
(self isIntegerObject: oop) ifTrue: [^ self shortPrint: oop].
^ String streamContents:
[:strm |
byteSize := 256 min: (self sizeBitsOf: oop)-4.
(self headerStart: oop) to: byteSize by: 4 do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space; nextPutAll: val hex8;
space; space.
a=0
ifTrue: [strm nextPutAll: (self dumpHeader: val)]
ifFalse: [strm nextPutAll: (self charsOfLong: val)]]]!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>incrementalGC (in category 'debug support') -----
- incrementalGC
- transcript cr; nextPutAll: 'incrementalGC ('; print: byteCount; nextPut: $); flush.
- ^super incrementalGC!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>incrementalGC (in category 'debug support') -----
+ incrementalGC
+ transcript cr; nextPutAll: 'incrementalGC ('; print: byteCount; nextPut: $); flush.
+ ^super incrementalGC!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>integerAt: (in category 'memory access') -----
integerAt: byteAddress
"Note: Adjusted for Smalltalk's 1-based array indexing."
^memory integerAt: (byteAddress // 4) + 1!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>integerAt:put: (in category 'memory access') -----
integerAt: byteAddress put: a32BitValue
"Note: Adjusted for Smalltalk's 1-based array indexing."
^memory integerAt: (byteAddress // 4) + 1 put: a32BitValue!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
- ioLoadFunction: functionString From: pluginString
- "Load and return the requested function from a module"
- | plugin fnSymbol |
- fnSymbol := functionString asSymbol.
- transcript cr; show:'Looking for ', functionString, ' in '.
- pluginString isEmpty
- ifTrue:[transcript show: 'vm']
- ifFalse:[transcript show: pluginString].
- plugin := pluginList
- detect:[:any| any key = pluginString asString]
- ifNone:[self loadNewPlugin: pluginString].
- plugin ifNil:[
- "Transcript cr; show:'Failed ... no plugin found'." ^ 0].
- plugin := plugin value.
- mappedPluginEntries doWithIndex:[:pluginAndName :index|
- ((pluginAndName at: 1) == plugin
- and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:[
- "Transcript show:' ... okay'." ^ index]].
- (plugin respondsTo: fnSymbol) ifFalse:[
- "Transcript cr; show:'Failed ... primitive not in plugin'." ^ 0].
- mappedPluginEntries := mappedPluginEntries copyWith: (Array with: plugin with: fnSymbol).
- "Transcript show:' ... okay'."
- ^ mappedPluginEntries size!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
+ ioLoadFunction: functionString From: pluginString
+ "Load and return the requested function from a module"
+ | plugin fnSymbol |
+ fnSymbol := functionString asSymbol.
+ transcript cr; show:'Looking for ', functionString, ' in '.
+ pluginString isEmpty
+ ifTrue:[transcript show: 'vm']
+ ifFalse:[transcript show: pluginString].
+ plugin := pluginList
+ detect:[:any| any key = pluginString asString]
+ ifNone:[self loadNewPlugin: pluginString].
+ plugin ifNil:[
+ "Transcript cr; show:'Failed ... no plugin found'." ^ 0].
+ plugin := plugin value.
+ mappedPluginEntries doWithIndex:[:pluginAndName :index|
+ ((pluginAndName at: 1) == plugin
+ and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:[
+ "Transcript show:' ... okay'." ^ index]].
+ (plugin respondsTo: fnSymbol) ifFalse:[
+ "Transcript cr; show:'Failed ... primitive not in plugin'." ^ 0].
+ mappedPluginEntries := mappedPluginEntries copyWith: (Array with: plugin with: fnSymbol).
+ "Transcript show:' ... okay'."
+ ^ mappedPluginEntries size!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>long32At: (in category 'memory access') -----
- long32At: byteAddress
- "Return the 32-bit word at byteAddress which must be 0 mod 4."
-
- ^ self longAt: byteAddress!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+ "Return the 32-bit word at byteAddress which must be 0 mod 4."
+
+ ^ self longAt: byteAddress!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ "Store the 32-bit value at byteAddress which must be 0 mod 4."
+
+ ^ self longAt: byteAddress put: a32BitValue!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>long32At:put: (in category 'memory access') -----
- long32At: byteAddress put: a32BitValue
- "Store the 32-bit value at byteAddress which must be 0 mod 4."
-
- ^ self longAt: byteAddress put: a32BitValue!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+
+ ^memory at: (byteAddress // 4) + 1!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- ^memory at: (byteAddress // 4) + 1!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+
+ ^memory at: (byteAddress // 4) + 1 put: a32BitValue!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a32BitValue
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- ^memory at: (byteAddress // 4) + 1 put: a32BitValue!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>longPrint: (in category 'debug support') -----
longPrint: oop
| lastPtr val lastLong hdrType prevVal |
(self isIntegerObject: oop) ifTrue: [^ self shortPrint: oop].
^ String streamContents:
[:strm |
lastPtr := 64*BytesPerWord min: (self lastPointerOf: oop).
hdrType := self headerType: oop.
hdrType = 2 ifTrue: [lastPtr := 0].
prevVal := 0.
(self headerStart: oop) to: lastPtr by: BytesPerWord do:
[:a | val := self longAt: oop+a.
(a > 0 and: [(val = prevVal) & (a ~= lastPtr)])
ifTrue:
[prevVal = (self longAt: oop+a-(BytesPerWord*2)) ifFalse: [strm cr; nextPutAll: ' ...etc...']]
ifFalse:
[strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space; nextPutAll: val hex8; space; space.
a = (BytesPerWord*2) negated ifTrue:
[strm nextPutAll: 'size = ' , (val - hdrType) hex].
a = BytesPerWord negated ifTrue:
[strm nextPutAll: '<' , (self nameOfClass: (val - hdrType)) , '>'].
a = 0 ifTrue: [strm cr; tab; nextPutAll: (self dumpHeader: val)].
a > 0 ifTrue: [strm nextPutAll: (self shortPrint: val)].
a = BytesPerWord ifTrue:
[(self isCompiledMethod: oop) ifTrue:
[strm cr; tab; nextPutAll: (self dumpMethodHeader: val)]]].
prevVal := val].
lastLong := 256 min: (self sizeBitsOf: oop) - BaseHeaderSize.
hdrType = 2
ifTrue:
["free" strm cr; nextPutAll: (oop+(self longAt: oop)-2) hex;
space; space; nextPutAll: (oop+(self longAt: oop)-2) printString]
ifFalse:
[(self formatOf: oop) = 3
ifTrue:
[strm cr; tab; nextPutAll: '/ next 3 fields are above SP... /'.
lastPtr+BytesPerWord to: lastPtr+(3*BytesPerWord) by: BytesPerWord do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: a hex;
space; space; space; nextPutAll: val hex8; space; space.
(self validOop: val) ifTrue: [strm nextPutAll: (self shortPrint: val)]]]
ifFalse:
[lastPtr+BytesPerWord to: lastLong by: BytesPerWord do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space.
strm nextPutAll: val hex8; space; space;
nextPutAll: (self charsOfLong: val)]]].
]!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>nameOfClass: (in category 'debug support') -----
nameOfClass: classOop
(self sizeBitsOf: classOop) = (Metaclass instSize +1*BytesPerWord) ifTrue:
[^ (self nameOfClass:
(self fetchPointer: 5 "thisClass" ofObject: classOop)) , ' class'].
^ self stringOf: (self fetchPointer: 6 "name" ofObject: classOop)!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>nextLongFrom: (in category 'initialization') -----
- nextLongFrom: aStream
- "Read a 32-bit quantity from the given (binary) stream."
- ^self subclassResponsibility!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>nextLongFrom: (in category 'initialization') -----
+ nextLongFrom: aStream
+ "Read a 32-bit quantity from the given (binary) stream."
+ ^self subclassResponsibility!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>primitiveResume (in category 'debugging traps') -----
primitiveResume
"Catch errors before we start the whole morphic error process"
byteCount > 1000000 ifTrue: [self halt]. "Ignore early process activity"
^ super primitiveResume!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>primitiveSuspend (in category 'debugging traps') -----
primitiveSuspend
"Catch errors before we start the whole morphic error process"
byteCount > 1000000 ifTrue: [self halt]. "Ignore early process activity"
^ super primitiveSuspend!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>printChar: (in category 'debug printing') -----
- printChar: aByte
-
- traceOn ifTrue: [ transcript nextPut: aByte asCharacter ].!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>printChar: (in category 'debug printing') -----
+ printChar: aByte
+
+ traceOn ifTrue: [ transcript nextPut: aByte asCharacter ].!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>printStack (in category 'debug support') -----
printStack
^ self printStack: false!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>printStack: (in category 'debug support') -----
printStack: includeTemps
| ctxt |
ctxt := activeContext.
^ String streamContents:
[:strm |
[self printStackFrame: ctxt onStream: strm.
includeTemps ifTrue: [self printStackTemps: ctxt onStream: strm].
(ctxt := (self fetchPointer: SenderIndex ofObject: ctxt)) = nilObj]
whileFalse: [].
]!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>printStackFrame:onStream: (in category 'debug support') -----
printStackFrame: ctxt onStream: strm
| classAndSel home |
home := (self fetchClassOf: ctxt) = (self splObj: ClassBlockContext)
ifTrue: [self fetchPointer: HomeIndex ofObject: ctxt]
ifFalse: [ctxt].
classAndSel := self
classAndSelectorOfMethod: (self fetchPointer: MethodIndex ofObject: home)
forReceiver: (self fetchPointer: ReceiverIndex ofObject: home).
strm cr; nextPutAll: ctxt hex8.
ctxt = home ifFalse: [strm nextPutAll: ' [] in'].
strm space; nextPutAll: (self nameOfClass: classAndSel first).
strm nextPutAll: '>>'; nextPutAll: (self shortPrint: classAndSel last).
!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>printStackTemps:onStream: (in category 'debug support') -----
printStackTemps: ctxt onStream: strm
| home cMethod nArgs nTemps oop |
home := (self fetchClassOf: ctxt) = (self splObj: ClassBlockContext)
ifTrue: [self fetchPointer: HomeIndex ofObject: ctxt]
ifFalse: [ctxt].
cMethod := self fetchPointer: MethodIndex ofObject: home.
nArgs := nTemps := 0.
home = ctxt ifTrue:
[strm cr; tab; nextPutAll: 'args: '.
nArgs := self argumentCountOf: cMethod.
1 to: nArgs do:
[:i | oop := self fetchPointer: TempFrameStart + i-1 ofObject: ctxt.
strm nextPutAll: oop hex; space].
strm cr; tab; nextPutAll: 'temps: '.
nTemps := self tempCountOf: cMethod.
nArgs+1 to: nTemps do:
[:i | oop := self fetchPointer: TempFrameStart + i-1 ofObject: ctxt.
strm nextPutAll: oop hex; space]].
strm cr; tab; nextPutAll: 'stack: '.
nTemps + 1 to: (self lastPointerOf: ctxt)//BytesPerWord - TempFrameStart do:
[:i | oop := self fetchPointer: TempFrameStart + i-1 ofObject: ctxt.
strm nextPutAll: oop hex; space].
!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>printStackWithTemps (in category 'debug support') -----
printStackWithTemps
^ self printStack: true!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>printTop: (in category 'debug support') -----
printTop: n
"Print important fields of the top n contexts"
| ctxt classAndSel home top ip sp |
ctxt := activeContext.
^ String streamContents:
[:strm | 1 to: n do:
[:i |
home := (self fetchClassOf: ctxt) = (self splObj: ClassBlockContext)
ifTrue: [self fetchPointer: HomeIndex ofObject: ctxt]
ifFalse: [ctxt].
classAndSel := self
classAndSelectorOfMethod: (self fetchPointer: MethodIndex ofObject: home)
forReceiver: (self fetchPointer: ReceiverIndex ofObject: home).
strm cr; nextPutAll: ctxt hex8.
ctxt = home ifFalse: [strm nextPutAll: ' [] in'].
strm space; nextPutAll: (self nameOfClass: classAndSel first).
strm nextPutAll: '>>'; nextPutAll: (self shortPrint: classAndSel last).
ctxt = activeContext
ifTrue: [ip := instructionPointer - method - (BaseHeaderSize - 2).
sp := self stackPointerIndex - TempFrameStart + 1.
top := self stackTop]
ifFalse: [ip := self integerValueOf:
(self fetchPointer: InstructionPointerIndex ofObject: ctxt).
sp := self integerValueOf:
(self fetchPointer: StackPointerIndex ofObject: ctxt).
top := self longAt: ctxt + (self lastPointerOf: ctxt)].
strm cr; tab; nextPutAll: 'ip = '; print: ip.
strm cr; tab; nextPutAll: 'sp = '; print: sp.
strm cr; tab; nextPutAll: 'top = '; nextPutAll: (self shortPrint: top).
(ctxt := (self fetchPointer: SenderIndex ofObject: ctxt)) = nilObj
ifTrue: [^strm contents].
].
]!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>sendBreak:point:receiver: (in category 'debugging traps') -----
sendBreak: selectorString point: selectorLength receiver: receiverOrNil
"self shortPrintFrameAndCallers: localFP"
| i |
breakSelectorLength = selectorLength ifTrue:
[i := breakSelectorLength.
[i > 0] whileTrue:
[(self byteAt: selectorString + i - 1) = (breakSelector at: i) asInteger
ifTrue: [(i := i - 1) = 0 ifTrue:
[self halt: 'Send of '
, breakSelector,
(receiverOrNil
ifNotNil: [' to ', (self shortPrint: receiverOrNil)]
ifNil: [''])]]
ifFalse: [i := 0]]]!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+ "Return the half-word at byteAddress which must be even."
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
- "Return the half-word at byteAddress which must be even."
- ^self subclassResponsibility!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ ^ self subclassResponsibility!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- ^ self subclassResponsibility!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>shortPrint: (in category 'debug support') -----
shortPrint: oop
| name classOop |
(self isIntegerObject: oop) ifTrue: [^ '=' , (self integerValueOf: oop) printString ,
' (' , (self integerValueOf: oop) hex , ')'].
classOop := self fetchClassOf: oop.
(self sizeBitsOf: classOop) = (Metaclass instSize +1*BytesPerWord) ifTrue: [
^ 'class ' , (self nameOfClass: oop)].
name := self nameOfClass: classOop.
name size = 0 ifTrue: [name := '??'].
name = 'String' ifTrue: [^ (self stringOf: oop) printString].
name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'Character' ifTrue: [^ '=' , (Character value: (self integerValueOf:
(self fetchPointer: 0 ofObject: oop))) printString].
name = 'UndefinedObject' ifTrue: [^ 'nil'].
name = 'False' ifTrue: [^ 'false'].
name = 'True' ifTrue: [^ 'true'].
name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
name = 'Association' ifTrue: [^ '(' ,
(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
' -> ' ,
(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
^('AEIOU' includes: name first)
ifTrue: ['an ' , name]
ifFalse: ['a ' , name]!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>sqGrowMemory:By: (in category 'memory access') -----
sqGrowMemory: oldLimit By: delta
transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr.
memory := memory , (memory class new: delta // 4).
^ memory size * 4!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- ^0!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
+ sqMemoryExtraBytesLeft: includingSwap
+ ^0!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>sqShrinkMemory:By: (in category 'memory access') -----
- sqShrinkMemory: oldLimit By: delta
- transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr.
-
- ^ oldLimit!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>sqShrinkMemory:By: (in category 'memory access') -----
+ sqShrinkMemory: oldLimit By: delta
+ transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr.
+
+ ^ oldLimit!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>storeFloatAt:from: (in category 'float primitives') -----
+ storeFloatAt: floatBitsAddress from: aFloat
+
+ self long32At: floatBitsAddress put: (aFloat at: 1).
+ self long32At: floatBitsAddress+4 put: (aFloat at: 2).
+ !
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>storeFloatAt:from: (in category 'float primitives') -----
- storeFloatAt: floatBitsAddress from: aFloat
-
- self long32At: floatBitsAddress put: (aFloat at: 1).
- self long32At: floatBitsAddress+4 put: (aFloat at: 2).
- !
Item was changed:
----- Method: NewspeakInterpreterSimulator>>stringOf: (in category 'debug support') -----
stringOf: oop
| size long nLongs chars |
^ String streamContents:
[:strm |
size := 100 min: (self stSizeOf: oop).
nLongs := size-1//BytesPerWord+1.
1 to: nLongs do:
[:i | long := self longAt: oop + BaseHeaderSize + (i-1*BytesPerWord).
chars := self charsOfLong: long.
strm nextPutAll: (i=nLongs
ifTrue: [chars copyFrom: 1 to: size-1\\BytesPerWord+1]
ifFalse: [chars])]]!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>tenuringIncrementalGC (in category 'debug support') -----
tenuringIncrementalGC
transcript cr; nextPutAll: 'tenuringIncrementalGC ('; print: byteCount; nextPut: $); flush.
^super tenuringIncrementalGC!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>validOop: (in category 'testing') -----
+ validOop: oop
+ " Return true if oop appears to be valid "
+ (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
+ (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
+ oop >= endOfMemory ifTrue: [^ false]. "Out of range"
+ "could test if within the first large freeblock"
+ (self longAt: oop) = 4 ifTrue: [^ false].
+ (self headerType: oop) = 2 ifTrue: [^ false]. "Free object"
+ ^ true!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>validOop: (in category 'testing') -----
- validOop: oop
- " Return true if oop appears to be valid "
- (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
- (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
- oop >= endOfMemory ifTrue: [^ false]. "Out of range"
- "could test if within the first large freeblock"
- (self longAt: oop) = 4 ifTrue: [^ false].
- (self headerType: oop) = 2 ifTrue: [^ false]. "Free object"
- ^ true!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>warning: (in category 'debug support') -----
warning: aString
Transcript cr; nextPutAll: aString; flush!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>writeImageFileIO: (in category 'image save/restore') -----
writeImageFileIO: numberOfBytesToWrite
"Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
| headerSize file |
BytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
headerSize := 64.
[
file := FileStream fileNamed: imageName.
file == nil ifTrue:
[self primitiveFail.
^nil].
file binary.
{
self imageFormatVersion.
headerSize.
numberOfBytesToWrite.
self startOfMemory.
specialObjectsOop.
lastHash.
self ioScreenSize.
fullScreenFlag.
extraVMMemory
}
do: [:long | self putLong: long toFile: file].
"Pad the rest of the header."
7 timesRepeat: [self putLong: 0 toFile: file].
"Position the file after the header."
file position: headerSize.
"Write the object memory."
1
to: numberOfBytesToWrite // 4
do: [:index |
self
putLong: (memory at: index)
toFile: file].
self success: true
]
ensure: [file ifNotNil: [file close]]!
Item was changed:
----- Method: NewspeakInterpreterSimulatorLSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits long |
lowBits := byteAddress bitAnd: 3.
long := self longAt: byteAddress - lowBits.
^(lowBits caseOf: {
[0] -> [ long ].
[1] -> [ long bitShift: -8 ].
[2] -> [ long bitShift: -16 ].
[3] -> [ long bitShift: -24 ]
}) bitAnd: 16rFF
!
Item was changed:
----- Method: NewspeakInterpreterSimulatorLSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| lowBits long longAddress |
lowBits := byteAddress bitAnd: 3.
longAddress := byteAddress - lowBits.
long := self longAt: longAddress.
long := (lowBits caseOf: {
[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16) ].
[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24) ]
}).
self longAt: longAddress put: long.
^byte!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorLSB>>charsOfLong: (in category 'debug support') -----
+ charsOfLong: long
+ ^ (1 to: 4) collect:
+ [:i | ((long digitAt: i) between: 14 and: 126)
+ ifTrue: [(long digitAt: i) asCharacter]
+ ifFalse: [$?]]!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorLSB>>charsOfLong: (in category 'debug support') -----
- charsOfLong: long
- ^ (1 to: 4) collect:
- [:i | ((long digitAt: i) between: 14 and: 126)
- ifTrue: [(long digitAt: i) asCharacter]
- ifFalse: [$?]]!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorLSB>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitAnd: 16rFFFF!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorLSB>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitAnd: 16rFFFF!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorLSB>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitShift: -16!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorLSB>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitShift: -16!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorLSB>>nextLongFrom: (in category 'initialization') -----
+ nextLongFrom: aStream
+ "Read a 32- or 64-bit quantity from the given (binary) stream."
+
+ ^ aStream nextLittleEndianNumber: BytesPerWord!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorLSB>>nextLongFrom: (in category 'initialization') -----
- nextLongFrom: aStream
- "Read a 32- or 64-bit quantity from the given (binary) stream."
-
- ^ aStream nextLittleEndianNumber: BytesPerWord!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorLSB>>putLong:toFile: (in category 'image save/restore') -----
- putLong: n toFile: f
- "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
-
- | remainingValue |
-
- remainingValue := n.
- 4 timesRepeat: [
- f nextPut: (remainingValue bitAnd: 16rFF).
- remainingValue := remainingValue bitShift: -8].
-
- self success: true!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorLSB>>putLong:toFile: (in category 'image save/restore') -----
+ putLong: n toFile: f
+ "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
+
+ | remainingValue |
+
+ remainingValue := n.
+ 4 timesRepeat: [
+ f nextPut: (remainingValue bitAnd: 16rFF).
+ remainingValue := remainingValue bitShift: -8].
+
+ self success: true!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorLSB>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+ "Return the half-word at byteAddress which must be even."
+ | lowBits long |
+ lowBits := byteAddress bitAnd: 2.
+ long := self longAt: byteAddress - lowBits.
+ ^ lowBits = 2
+ ifTrue: [ long bitShift: -16 ]
+ ifFalse: [ long bitAnd: 16rFFFF ].
+ !
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorLSB>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
- "Return the half-word at byteAddress which must be even."
- | lowBits long |
- lowBits := byteAddress bitAnd: 2.
- long := self longAt: byteAddress - lowBits.
- ^ lowBits = 2
- ifTrue: [ long bitShift: -16 ]
- ifFalse: [ long bitAnd: 16rFFFF ].
- !
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorLSB>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ "Return the half-word at byteAddress which must be even."
+ | lowBits long longAddress |
+ lowBits := byteAddress bitAnd: 2.
+ lowBits = 0
+ ifTrue:
+ [ "storing into LS word"
+ long := self longAt: byteAddress.
+ self longAt: byteAddress
+ put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)
+ ]
+ ifFalse:
+ [longAddress := byteAddress - 2.
+ long := self longAt: longAddress.
+ self longAt: longAddress
+ put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))
+ ]!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorLSB>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- "Return the half-word at byteAddress which must be even."
- | lowBits long longAddress |
- lowBits := byteAddress bitAnd: 2.
- lowBits = 0
- ifTrue:
- [ "storing into LS word"
- long := self longAt: byteAddress.
- self longAt: byteAddress
- put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)
- ]
- ifFalse:
- [longAddress := byteAddress - 2.
- long := self longAt: longAddress.
- self longAt: longAddress
- put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))
- ]!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorLSB>>vmEndianness (in category 'memory access') -----
- vmEndianness
- "return 0 for little endian, 1 for big endian"
- ^0!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorLSB>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ "return 0 for little endian, 1 for big endian"
+ ^0!
Item was changed:
----- Method: NewspeakInterpreterSimulatorMSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits bpwMinus1 |
bpwMinus1 := BytesPerWord-1.
lowBits := byteAddress bitAnd: bpwMinus1.
^ ((self longAt: byteAddress - lowBits)
bitShift: (lowBits - bpwMinus1) * 8)
bitAnd: 16rFF!
Item was changed:
----- Method: NewspeakInterpreterSimulatorMSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| longWord shift lowBits bpwMinus1 longAddress |
bpwMinus1 := BytesPerWord-1.
lowBits := byteAddress bitAnd: bpwMinus1.
longAddress := byteAddress - lowBits.
longWord := self longAt: longAddress.
shift := (bpwMinus1 - lowBits) * 8.
longWord := longWord
- (longWord bitAnd: (16rFF bitShift: shift))
+ (byte bitShift: shift).
self longAt: longAddress put: longWord.
^byte!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorMSB>>charsOfLong: (in category 'debug support') -----
+ charsOfLong: long
+ ^ (BytesPerWord to: 1 by: -1) collect:
+ [:i | ((long digitAt: i) between: 14 and: 126)
+ ifTrue: [(long digitAt: i) asCharacter]
+ ifFalse: [$?]]!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorMSB>>charsOfLong: (in category 'debug support') -----
- charsOfLong: long
- ^ (BytesPerWord to: 1 by: -1) collect:
- [:i | ((long digitAt: i) between: 14 and: 126)
- ifTrue: [(long digitAt: i) asCharacter]
- ifFalse: [$?]]!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorMSB>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitShift: -16!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorMSB>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitShift: -16!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorMSB>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- "Used by Balloon"
-
- ^ long32 bitAnd: 16rFFFF!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorMSB>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ "Used by Balloon"
+
+ ^ long32 bitAnd: 16rFFFF!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorMSB>>nextLongFrom: (in category 'initialization') -----
- nextLongFrom: aStream
- "Read a 32- or 64-bit quantity from the given (binary) stream."
-
- ^ aStream nextNumber: BytesPerWord!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorMSB>>nextLongFrom: (in category 'initialization') -----
+ nextLongFrom: aStream
+ "Read a 32- or 64-bit quantity from the given (binary) stream."
+
+ ^ aStream nextNumber: BytesPerWord!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorMSB>>putLong:toFile: (in category 'image save/restore') -----
- putLong: n toFile: f
- "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
-
- f
- nextPut: (n bitShift: -24);
- nextPut: ((n bitShift: -16) bitAnd: 16rFF);
- nextPut: ((n bitShift: -8) bitAnd: 16rFF);
- nextPut: (n bitAnd: 16rFF).
-
- self success: true!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorMSB>>putLong:toFile: (in category 'image save/restore') -----
+ putLong: n toFile: f
+ "Append the given 4-byte long word to the given file in my byte order. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails."
+
+ f
+ nextPut: (n bitShift: -24);
+ nextPut: ((n bitShift: -16) bitAnd: 16rFF);
+ nextPut: ((n bitShift: -8) bitAnd: 16rFF);
+ nextPut: (n bitAnd: 16rFF).
+
+ self success: true!
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorMSB>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
- "Return the half-word at byteAddress which must be even."
- | lowBits bpwMinus2 |
- bpwMinus2 := BytesPerWord-2.
- lowBits := byteAddress bitAnd: bpwMinus2.
- ^ ((self longAt: byteAddress - lowBits)
- bitShift: (lowBits - bpwMinus2) * 8)
- bitAnd: 16rFFFF
- !
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorMSB>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+ "Return the half-word at byteAddress which must be even."
+ | lowBits bpwMinus2 |
+ bpwMinus2 := BytesPerWord-2.
+ lowBits := byteAddress bitAnd: bpwMinus2.
+ ^ ((self longAt: byteAddress - lowBits)
+ bitShift: (lowBits - bpwMinus2) * 8)
+ bitAnd: 16rFFFF
+ !
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorMSB>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- "Return the half-word at byteAddress which must be even."
- | longWord shift lowBits bpwMinus2 longAddress |
- bpwMinus2 := BytesPerWord-2.
- lowBits := byteAddress bitAnd: bpwMinus2.
- longAddress := byteAddress - lowBits.
- longWord := self longAt: longAddress.
- shift := (bpwMinus2 - lowBits) * 8.
- longWord := longWord
- - (longWord bitAnd: (16rFFFF bitShift: shift))
- + (a16BitValue bitShift: shift).
- self longAt: longAddress put: longWord
- !
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorMSB>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ "Return the half-word at byteAddress which must be even."
+ | longWord shift lowBits bpwMinus2 longAddress |
+ bpwMinus2 := BytesPerWord-2.
+ lowBits := byteAddress bitAnd: bpwMinus2.
+ longAddress := byteAddress - lowBits.
+ longWord := self longAt: longAddress.
+ shift := (bpwMinus2 - lowBits) * 8.
+ longWord := longWord
+ - (longWord bitAnd: (16rFFFF bitShift: shift))
+ + (a16BitValue bitShift: shift).
+ self longAt: longAddress put: longWord
+ !
Item was removed:
- ----- Method: NewspeakInterpreterSimulatorMSB>>vmEndianness (in category 'memory access') -----
- vmEndianness
- "return 0 for little endian, 1 for big endian"
- ^1!
Item was added:
+ ----- Method: NewspeakInterpreterSimulatorMSB>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ "return 0 for little endian, 1 for big endian"
+ ^1!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin class>>simulatorClass (in category 'simulation only') -----
simulatorClass
^NewspeakVM ifTrue: [NewsqueakIA32ABIPluginSimulator]!
Item was removed:
- ----- Method: NewsqueakIA32ABIPluginSimulator>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- ^interpreterProxy longAt: byteAddress!
Item was added:
+ ----- Method: NewsqueakIA32ABIPluginSimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ ^interpreterProxy longAt: byteAddress!
Item was removed:
- ----- Method: NewsqueakIA32ABIPluginSimulator>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a32BitValue
- ^interpreterProxy longAt: byteAddress put: a32BitValue!
Item was added:
+ ----- Method: NewsqueakIA32ABIPluginSimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ ^interpreterProxy longAt: byteAddress put: a32BitValue!
Item was changed:
----- Method: ObjectMemory class>>characterObjectOf: (in category 'simulation only') -----
characterObjectOf: characterCode
^(characterCode between: 0 and: 255) ifTrue:
[characterCode asCharacter]!
Item was changed:
----- Method: ObjectMemory class>>isImmediate: (in category 'simulation only') -----
isImmediate: anObject
^anObject class == SmallInteger!
Item was changed:
----- Method: ObjectMemory>>addressCouldBeObj: (in category 'debug support') -----
addressCouldBeObj: address
<api>
"Answer if address appears to be that of an object, which implies it is
safe to fetch the class and size. For code disassembly and assertions."
^(address bitAnd: 3) = 0
and: [address asUnsignedInteger >= self startOfMemory
and: [address asUnsignedInteger < freeBlock
and: [(self headerType: address) ~= HeaderTypeGC]]]!
Item was changed:
----- Method: ObjectMemory>>addressCouldBeObjWhileForwarding: (in category 'debug support') -----
addressCouldBeObjWhileForwarding: address
"Answer if address appears to be that of an object, which implies it is
safe to fetch the class and size. For code disassembly and assertions."
^(address bitAnd: 3) = 0
and: [address asUnsignedInteger >= self startOfMemory
and: [address asUnsignedInteger < freeBlock]]!
Item was changed:
----- Method: ObjectMemory>>addressCouldBeOop: (in category 'debug support') -----
addressCouldBeOop: address
<api>
"Answer if address appears to be that of either a SmallInteger or an object.
For code disassembly and assertions."
^(self isIntegerObject: address)
or: [self addressCouldBeObj: address]!
Item was added:
+ ----- Method: ObjectMemory>>allInstancesOf: (in category 'primitive support') -----
+ allInstancesOf: aClass
+ "Attempt to answer an array of all objects, excluding those that may
+ be garbage collected as a side effect of allocating the result array.
+ If no memory is available answer the number of instances as a SmallInteger.
+ Since objects are at least 16 bytes big, and the largest SmallInteger covers
+ 1/4 of the address space, the count can never overflow."
+ | count theClass resultArray newCount |
+ "Count the currently accessible objects"
+ count := 0.
+ self allObjectsDo:
+ [:obj|
+ (self fetchClassOfNonImm: obj) = aClass ifTrue:
+ [count := count + 1]].
+ "Allocate result array, may cause GC"
+ self pushRemappableOop: aClass.
+ resultArray := self instantiateClass: self classArray indexableSize: count.
+ theClass := self popRemappableOop.
+ newCount := 0.
+ self allObjectsDo:
+ [:obj|
+ (self fetchClassOfNonImm: obj) = theClass ifTrue:
+ [newCount := newCount + 1.
+ resultArray == nil ifFalse:
+ [self storePointerUnchecked: newCount ofObject: resultArray withValue: obj]]].
+ resultArray == nil ifTrue:
+ [^self integerObjectOf: newCount].
+ "If GC occurred during result array allocation, truncate unused portion of result array"
+ newCount < count ifTrue:
+ [self shorten: resultArray toIndexableSize: newCount].
+ ^resultArray!
Item was changed:
----- Method: ObjectMemory>>allObjects (in category 'primitive support') -----
allObjects
"Attempt to answer an array of all objects, excluding those that may
be garbage collected as a side effect of allocating the result array.
+ If no memory is available answer the number of objects as a SmallInteger.
+ Since objects are at least 4 bytes big, and the largest SmallInteger covers
+ 1/4 of the address space, the count can never overflow."
- If no memory is available answer 0."
| count obj resultArray newCount |
"Count the currently accessible objects"
count := 0.
self allObjectsDo:
[:ign| count := count + 1].
"Allocate result array, may cause GC"
resultArray := self instantiateClass: self classArray indexableSize: count.
- resultArray = nil ifTrue:
- [^0].
"Store all objects in result array, excluding any reference to the result array itself,
as may happen if garbage collection occurred during allocation of the array. No store
check is necessary; the result array will be the last object in memory and hence new."
newCount := 0.
obj := self firstObject.
[obj < resultArray] whileTrue:
[(self isFreeObject: obj) ifFalse:
[newCount := newCount + 1.
+ resultArray == nil ifFalse:
+ [self storePointerUnchecked: newCount ofObject: resultArray withValue: obj]].
- self storePointerUnchecked: newCount ofObject: resultArray withValue: obj].
obj := self objectAfter: obj].
+ resultArray == nil ifTrue:
+ [^self integerObjectOf: count].
"If GC occurred during result array allocation, truncate unused portion of result array"
newCount < count ifTrue:
[self shorten: resultArray toIndexableSize: newCount].
^resultArray!
Item was changed:
----- Method: ObjectMemory>>baseHeaderSize (in category 'interpreter access') -----
baseHeaderSize
^BaseHeaderSize!
Item was changed:
----- Method: ObjectMemory>>booleanObjectOf: (in category 'interpreter access') -----
booleanObjectOf: bool
<inline: true>
^bool ifTrue: [trueObj] ifFalse: [falseObj]!
Item was changed:
----- Method: ObjectMemory>>byteSwapped: (in category 'image save/restore') -----
byteSwapped: w
"Answer the given integer with its bytes in the reverse order."
<api>
<returnTypeC: #sqInt>
self cppIf: BytesPerWord = 4
ifTrue:
[^ ((w bitShift: Byte3ShiftNegated) bitAnd: Byte0Mask)
+ ((w bitShift: Byte1ShiftNegated) bitAnd: Byte1Mask)
+ ((w bitShift: Byte1Shift ) bitAnd: Byte2Mask)
+ ((w bitShift: Byte3Shift ) bitAnd: Byte3Mask)]
ifFalse:
[^ ((w bitShift: Byte7ShiftNegated) bitAnd: Byte0Mask)
+ ((w bitShift: Byte5ShiftNegated) bitAnd: Byte1Mask)
+ ((w bitShift: Byte3ShiftNegated) bitAnd: Byte2Mask)
+ ((w bitShift: Byte1ShiftNegated) bitAnd: Byte3Mask)
+ ((w bitShift: Byte1Shift ) bitAnd: Byte4Mask)
+ ((w bitShift: Byte3Shift ) bitAnd: Byte5Mask)
+ ((w bitShift: Byte5Shift ) bitAnd: Byte6Mask)
+ ((w bitShift: Byte7Shift ) bitAnd: Byte7Mask)]!
Item was changed:
----- Method: ObjectMemory>>changeClassOf:to: (in category 'interpreter access') -----
changeClassOf: rcvr to: argClass
"Attempt to change the class of the receiver to the argument given that the
format of the receiver matches the format of the argument. If successful,
answer 0, otherwise answer an error code indicating the reason for failure.
Fail if the receiver is an instance of a compact class and the argument isn't,
or if the format of the receiver is incompatible with the format of the argument,
or if the argument is a fixed class and the receiver's size differs from the size
that an instance of the argument should have."
| classHdr sizeHiBits argClassInstByteSize argFormat rcvrFormat rcvrHdr ccIndex |
"Check what the format of the class says"
classHdr := self formatOfClass: argClass. "Low 2 bits are 0"
"Compute the size of instances of the class (used for fixed field classes only)"
sizeHiBits := (classHdr bitAnd: 16r60000) >> 9.
classHdr := classHdr bitAnd: 16r1FFFF.
argClassInstByteSize := (classHdr bitAnd: SizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
"Check the receiver's format against that of the class"
argFormat := self formatOfHeader: classHdr.
rcvrHdr := self baseHeader: rcvr.
rcvrFormat := self formatOfHeader: rcvrHdr.
"If the receiver is a byte object we need to clear the number of odd bytes from the format."
rcvrFormat > self firstByteFormat ifTrue:
[rcvrFormat := rcvrFormat bitAnd: 16rC].
argFormat = rcvrFormat ifFalse:
[^PrimErrInappropriate]. "no way"
"For fixed field classes, the sizes must match.
Note: argClassInstByteSize-4 because base header is included in class size."
argFormat < self arrayFormat
ifTrue:
[(argClassInstByteSize - BaseHeaderSize) ~= (self byteLengthOf: rcvr) ifTrue:
[^PrimErrBadReceiver]]
ifFalse:
[argFormat = self indexablePointersFormat ifTrue: "For indexable plus fixed fields the receiver must be at least big enough."
[(argClassInstByteSize - BaseHeaderSize) > (self byteLengthOf: rcvr) ifTrue:
[^PrimErrBadReceiver]]].
(self headerTypeOfHeader: rcvrHdr) = HeaderTypeShort
ifTrue: "Compact classes. Check if the arg's class is compact and exchange ccIndex"
[ccIndex := classHdr bitAnd: CompactClassMask.
ccIndex = 0 ifTrue:
[^PrimErrInappropriate]. "class is not compact"
self cppIf: IMMUTABILITY
ifTrue: [(rcvrHdr bitAnd: ImmutabilityBit) ~= 0 ifTrue:
[^PrimErrNoModification]].
self baseHeader: rcvr put: ((rcvrHdr bitClear: CompactClassMask) bitOr: ccIndex)]
ifFalse: "Exchange the class pointer, which could make rcvr a root for argClass"
[self cppIf: IMMUTABILITY
ifTrue: [(rcvrHdr bitAnd: ImmutabilityBit) ~= 0 ifTrue:
[^PrimErrNoModification]].
"N.B. the recursive scan-mark algorithm uses the header word's size and compact class
fields to determine the header type when it reuses the header type bits for the mark
state. So it is alas an invariant that non-compact headers have a 0 compact class field."
(self compactClassIndexOfHeader: rcvrHdr) ~= 0 ifTrue:
[self baseHeader: rcvr put: (rcvrHdr bitClear: CompactClassMask)].
self longAt: rcvr - BaseHeaderSize put: (argClass bitOr: (self headerTypeOfHeader: rcvrHdr)).
(self oop: rcvr isLessThan: youngStart) ifTrue:
[self possibleRootStoreInto: rcvr value: argClass]].
"ok"
^0!
Item was changed:
----- Method: ObjectMemory>>checkAddress: (in category 'memory access') -----
checkAddress: byteAddress
"Keep this method around for debugging the C code."
(self oop: byteAddress isLessThan: self startOfMemory)
ifTrue: [self error: 'bad address: negative'].
(self oop: byteAddress isGreaterThanOrEqualTo: memoryLimit)
ifTrue: [self error: 'bad address: past end of heap']!
Item was changed:
----- Method: ObjectMemory>>checkHeapIntegrity (in category 'memory access') -----
checkHeapIntegrity
"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 obj sz hdr fmt fi fieldOop numRootsInHeap |
<inline: false>
ok := true.
numRootsInHeap := 0.
obj := self firstObject.
[self oop: obj isLessThan: self startOfFreeSpace] whileTrue:
[(self isFreeObject: obj)
ifTrue:
[sz := self sizeOfFree: obj]
ifFalse:
[hdr := self baseHeader: obj.
(self isYoungRootHeader: hdr) ifTrue:
[numRootsInHeap := numRootsInHeap + 1].
(self compactClassIndexOfHeader: hdr) = 0 ifTrue:
[fieldOop := (self classHeader: obj) bitAnd: AllButTypeMask.
((self isIntegerObject: fieldOop)
or: [(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
[self print: 'object leak in '; printHex: obj; print: ' class = '; printHex: fieldOop; cr.
ok := false]].
fmt := self formatOfHeader: hdr.
(fmt <= self lastPointerFormat or: [fmt >= self firstCompiledMethodFormat]) ifTrue:
[fmt >= self firstCompiledMethodFormat
ifTrue: [fi := (self literalCountOf: obj) + LiteralStart]
ifFalse: [(fmt = self indexablePointersFormat and: [self isContextHeader: hdr])
ifTrue: [fi := CtxtTempFrameStart + (self fetchStackPointerOf: obj)]
ifFalse: [fi := self lengthOf: obj]].
[(fi := fi - 1) >= 0] whileTrue:
[fieldOop := self fetchPointer: fi ofObject: obj.
(self isNonIntegerObject: fieldOop) ifTrue:
[(fieldOop bitAnd: BytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
ok := false]
ifFalse:
[(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
[self print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
ok := false]]]]].
sz := self sizeBitsOf: obj].
obj := self oopFromChunk: obj + sz].
numRootsInHeap ~= rootTableCount ifTrue:
[self print: 'root count mismatch. #heap roots '; printNum: numRootsInHeap; print: '; #roots '; printNum: rootTableCount; cr.
"But the system copes with overflow..."
ok := rootTableOverflowed and: [allocationCount > allocationsBetweenGCs]].
1 to: rootTableCount do:
[:ri|
obj := rootTable at: ri.
(obj bitAnd: BytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned oop in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
ok := false]
ifFalse:
[(self heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[self print: 'object leak in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
ok := false]
ifFalse:
[hdr := self baseHeader: obj.
(self isYoungRootHeader: hdr) ifFalse:
[self print: 'non-root in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
ok := false]]]].
1 to: remapBufferCount do:
[:ri|
obj := remapBuffer at: ri.
(obj bitAnd: BytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
ok := false]
ifFalse:
[(self heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[self print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
ok := false]]].
1 to: extraRootCount do:
[:ri|
obj := (extraRoots at: ri) at: 0.
(obj bitAnd: BytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
ok := false]
ifFalse:
[(self heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[self print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
ok := false]]].
^ok!
Item was changed:
----- Method: ObjectMemory>>checkOkayOop: (in category 'debug support') -----
checkOkayOop: oop
"Verify that the given oop is legitimate. Check address, header, and size but not class.
Answer true if OK. Otherwise print reason and answer false."
<api>
<var: #oop type: #usqInt>
| sz type fmt unusedBit |
"address and size checks"
(self isIntegerObject: oop) ifTrue: [ ^true ].
(oop >= self startOfMemory and: [oop < endOfMemory])
ifFalse: [ self print: 'oop is not a valid address'; cr. ^false ].
((oop \\ BytesPerWord) = 0)
ifFalse: [ self print: 'oop is not a word-aligned address'; cr. ^false ].
sz := self sizeBitsOf: oop.
(oop + sz) < endOfMemory
ifFalse: [ self print: 'oop size would make it extend beyond the end of memory'; cr. ^false ].
"header type checks"
type := self headerType: oop.
type = HeaderTypeFree
ifTrue: [ self print: 'oop is a free chunk, not an object'; cr. ^false ].
type = HeaderTypeShort ifTrue: [
(self compactClassIndexOf: oop) = 0
ifTrue: [ self print: 'cannot have zero compact class field in a short header'; cr. ^false ].
].
type = HeaderTypeClass ifTrue: [
((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
].
type = HeaderTypeSizeAndClass ifTrue: [
((oop >= (BytesPerWord*2)) and:
[(self headerType: oop - (BytesPerWord*2)) = type and:
[(self headerType: oop - BytesPerWord) = type]])
ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
].
"format check"
fmt := self formatOf: oop.
((fmt = 5) | (fmt = 7))
ifTrue: [ self print: 'oop has an unknown format type'; cr. ^false ].
"mark and root bit checks"
unusedBit := 16r20000000.
BytesPerWord = 8
ifTrue:
[unusedBit := unusedBit << 16.
unusedBit := unusedBit << 16].
((self longAt: oop) bitAnd: unusedBit) = 0
ifFalse: [ self print: 'unused header bit 30 is set; should be zero'; cr. ^false ].
"xxx
((self longAt: oop) bitAnd: MarkBit) = 0
ifFalse: [ self print: 'mark bit should not be set except during GC' ].
xxx"
((self isYoungRoot: oop) and: [oop >= youngStart])
ifTrue: [ self print: 'root bit is set in a young object'; cr. ^false ].
^true
!
Item was changed:
----- Method: ObjectMemory>>checkOkayYoungReferrer: (in category 'debug support') -----
checkOkayYoungReferrer: obj
"Verify that the given obj is a valid youngReferrer. Check RootBit is set and
is in rootTable. Answer true if OK. Otherwise print reason and answer false.
Assumes the object contains young references."
(self oop: obj isGreaterThanOrEqualTo: youngStart) ifTrue:
[^true].
(self isYoungRoot: obj) ifFalse:
[ self print: 'root bit is not set in '; printHex: obj; cr. ^false ].
1 to: rootTableCount do:
[:i| obj = (rootTable at: i) ifTrue: [^true]].
self printHex: obj; print: ' has root bit set but is not in rootTable'; cr.
^false
!
Item was changed:
----- Method: ObjectMemory>>checkOopHasOkayClass: (in category 'debug support') -----
checkOopHasOkayClass: obj
"Attempt to verify that the given obj has a reasonable behavior. The class must be a
valid, non-integer oop and must not be nilObj. It must be a pointers object with three
or more fields. Finally, the instance specification field of the behavior must match that
of the instance. If OK answer true. If not, print reason and answer false."
<api>
<var: #obj type: #usqInt>
| objClass formatMask behaviorFormatBits objFormatBits |
<var: #objClass type: #usqInt>
(self checkOkayOop: obj) ifFalse:
[^false].
objClass := self cCoerce: (self fetchClassOfNonImm: obj) to: #usqInt.
(self isIntegerObject: objClass) ifTrue:
[self print: 'obj '; printHex: obj; print: ' a SmallInteger is not a valid class or behavior'; cr. ^false].
(self okayOop: objClass) ifFalse:
[self print: 'obj '; printHex: obj; print: ' class obj is not ok'; cr. ^false].
((self isPointersNonImm: objClass) and: [(self lengthOf: objClass) >= 3]) ifFalse:
[self print: 'obj '; printHex: obj; print: ' a class (behavior) must be a pointers object of size >= 3'; cr. ^false].
formatMask := (self isBytes: obj)
ifTrue: [16rC00] "ignore extra bytes size bits"
ifFalse: [16rF00].
behaviorFormatBits := (self formatOfClass: objClass) bitAnd: formatMask.
objFormatBits := (self baseHeader: obj) bitAnd: formatMask.
behaviorFormatBits = objFormatBits ifFalse:
[self print: 'obj '; printHex: obj; print: ' and its class (behavior) formats differ'; cr. ^false].
^true!
Item was changed:
----- Method: ObjectMemory>>checkOopIntegrity:named: (in category 'debug support') -----
checkOopIntegrity: obj named: name
<inline: false>
<var: #name type: #'char *'>
(self heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
[^true].
self print: name; print: ' leak '; printHex: obj; cr.
^false!
Item was changed:
----- Method: ObjectMemory>>checkOopIntegrity:named:index: (in category 'debug support') -----
checkOopIntegrity: obj named: name index: i
<inline: false>
<var: #name type: #'char *'>
(self heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
[^true].
self print: name; print: ' leak @ '; printNum: i; print: ' = '; printHex: obj; cr.
^false!
Item was changed:
----- Method: ObjectMemory>>checkedByteAt: (in category 'memory access') -----
checkedByteAt: byteAddress
"Assumes zero-based array indexing."
self checkAddress: byteAddress.
^ self byteAt: byteAddress!
Item was changed:
----- Method: ObjectMemory>>checkedByteAt:put: (in category 'memory access') -----
checkedByteAt: byteAddress put: byte
"Assumes zero-based array indexing."
self checkAddress: byteAddress.
self byteAt: byteAddress put: byte.!
Item was changed:
----- Method: ObjectMemory>>checkedLongAt: (in category 'memory access') -----
checkedLongAt: byteAddress
"Assumes zero-based array indexing. For testing in Smalltalk, this method should be overridden in a subclass."
<api>
self checkAddress: byteAddress.
self checkAddress: byteAddress + 3.
^ self longAt: byteAddress!
Item was changed:
----- Method: ObjectMemory>>checkedLongAt:put: (in category 'memory access') -----
checkedLongAt: byteAddress put: a32BitInteger
"Assumes zero-based array indexing. For testing in Smalltalk, this method should be overridden in a subclass."
self checkAddress: byteAddress.
self checkAddress: byteAddress + 3.
self longAt: byteAddress put: a32BitInteger.!
Item was changed:
----- Method: ObjectMemory>>clearLeakMapAndMapAccessibleObjects (in category 'debug support') -----
clearLeakMapAndMapAccessibleObjects
"Perform an integrity/leak check using the heapMap. Set a bit at each object's header."
| oop |
<inline: false>
self clearHeapMap.
oop := self firstObject.
[oop = nil] whileFalse:
[self heapMapAtWord: (self pointerForOop: oop) Put: 1.
oop := self accessibleObjectAfter: oop]!
Item was changed:
----- Method: ObjectMemory>>compactClassAt: (in category 'interpreter access') -----
compactClassAt: ccIndex
"Index must be between 1 and compactClassArray size. A zero compact class
index in the base header indicates that the class is in the class header word."
<api>
<inline: true>
^self fetchPointer: ccIndex - 1 ofObject: (self splObj: CompactClasses)!
Item was changed:
----- Method: ObjectMemory>>fetchByte:ofObject: (in category 'interpreter access') -----
fetchByte: byteIndex ofObject: oop
<api>
^self byteAt: oop + BaseHeaderSize + byteIndex!
Item was changed:
----- Method: ObjectMemory>>fetchClassOf: (in category 'interpreter access') -----
fetchClassOf: oop
| ccIndex |
<inline: true>
<asmLabel: false>
^(self isIntegerObject: oop)
ifTrue: [self splObj: ClassInteger]
ifFalse:
[(ccIndex := (self compactClassIndexOf: oop)) = 0
ifTrue: [(self classHeader: oop) bitAnd: AllButTypeMask]
ifFalse: [self compactClassAt: ccIndex]]!
Item was changed:
----- Method: ObjectMemory>>fetchClassOfNonImm: (in category 'interpreter access') -----
fetchClassOfNonImm: oop
| ccIndex |
<inline: true>
<asmLabel: false>
^(ccIndex := (self compactClassIndexOf: oop)) = 0
ifTrue: [(self classHeader: oop) bitAnd: AllButTypeMask]
ifFalse: [self compactClassAt: ccIndex]!
Item was changed:
----- Method: ObjectMemory>>fetchLong32:ofObject: (in category 'interpreter access') -----
fetchLong32: fieldIndex ofObject: oop
" index by 32-bit units, and return a 32-bit value. Intended to replace fetchWord:ofObject:"
^ self long32At: oop + BaseHeaderSize + (fieldIndex << 2)!
Item was changed:
----- Method: ObjectMemory>>fetchLong32LengthOf: (in category 'interpreter access') -----
fetchLong32LengthOf: objectPointer
"Gives size appropriate for, eg, fetchLong32"
| sz |
sz := self sizeBitsOf: objectPointer.
^ (sz - BaseHeaderSize) >> 2!
Item was added:
+ ----- Method: ObjectMemory>>fetchPointer:ofObject: (in category 'interpreter access') -----
+ fetchPointer: fieldIndex ofObject: oop
+ "index by word size, and return a pointer as long as the word size"
+ <api>
+ ^self longAt: oop + BaseHeaderSize + (fieldIndex << ShiftForWord)!
Item was removed:
- ----- Method: ObjectMemory>>fetchPointer:ofObject: (in category 'interpreter access') -----
- fetchPointer: fieldIndex ofObject: oop
- "index by word size, and return a pointer as long as the word size"
- <api>
- ^self longAt: oop + BaseHeaderSize + (fieldIndex << ShiftForWord)!
Item was changed:
----- Method: ObjectMemory>>fetchWordLengthOf: (in category 'interpreter access') -----
fetchWordLengthOf: objectPointer
"NOTE: this gives size appropriate for fetchPointer: n, but not in general for, eg, fetchLong32, etc."
| sz |
sz := self sizeBitsOf: objectPointer.
^ (sz - BaseHeaderSize) >> ShiftForWord!
Item was changed:
----- Method: ObjectMemory>>firstFixedFieldOfMaybeImmediate: (in category 'debug support') -----
firstFixedFieldOfMaybeImmediate: oop
"for the message send breakpoint; selectors can be immediates."
<inline: false>
^(self isImmediate: oop)
ifTrue: [oop asVoidPointer]
ifFalse: [self firstFixedField: oop]!
Item was added:
+ ----- Method: ObjectMemory>>firstIndexableField: (in category 'object format') -----
+ firstIndexableField: oop
+ "NOTE: overridden in various simulator subclasses to add coercion to CArray, so please duplicate any changes"
+ | hdr fmt totalLength fixedFields |
+ <returnTypeC: #'void *'>
+ hdr := self baseHeader: oop.
+ fmt := self formatOfHeader: hdr.
+ fmt <= self lastPointerFormat ifTrue:
+ ["pointer; may need to delve into the class format word"
+ totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
+ ^self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)].
+ ^self pointerForOop: oop + BaseHeaderSize!
Item was removed:
- ----- Method: ObjectMemory>>firstIndexableField: (in category 'object format') -----
- firstIndexableField: oop
- "NOTE: overridden in various simulator subclasses to add coercion to CArray, so please duplicate any changes"
- | hdr fmt totalLength fixedFields |
- <returnTypeC: #'void *'>
- hdr := self baseHeader: oop.
- fmt := self formatOfHeader: hdr.
- fmt <= self lastPointerFormat ifTrue:
- ["pointer; may need to delve into the class format word"
- totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
- fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
- ^self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)].
- ^self pointerForOop: oop + BaseHeaderSize!
Item was changed:
----- Method: ObjectMemory>>firstSegmentSize: (in category 'image save/restore') -----
firstSegmentSize: firstSegSize
"Ignored; this is for Spur's segmented image"!
Item was removed:
- ----- Method: ObjectMemory>>fullGC (in category 'garbage collection') -----
- fullGC
- "Do a mark/sweep garbage collection of the entire object memory. Free inaccessible objects but do not move them."
-
- <inline: false>
- DoAssertionChecks ifTrue:
- [self reverseDisplayFrom: 0 to: 7.
- self clearLeakMapAndMapAccessibleObjects.
- self checkHeapIntegrity].
- self preGCAction: GCModeFull.
- gcStartUsecs := self ioUTCMicrosecondsNow.
- statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
- self clearRootsTable.
- self initWeakTableForIncrementalGC: false.
- youngStart := self startOfMemory. "process all of memory"
- self markPhase.
- "Sweep phase returns the number of survivors.
- Use the up-to-date version instead the one from startup."
- totalObjectCount := self sweepPhase.
- self fullCompaction.
- allocationCount := 0.
- statFullGCs := statFullGCs + 1.
- statGCEndTime := self ioMicroMSecs.
- statFullGCUsecs := statFullGCUsecs + (self ioUTCMicrosecondsNow - gcStartUsecs).
- self capturePendingFinalizationSignals.
-
- youngStart := freeBlock. "reset the young object boundary"
- self postGCAction: GCModeFull.
- DoAssertionChecks ifTrue:
- [self clearLeakMapAndMapAccessibleObjects.
- self checkHeapIntegrity.
- self reverseDisplayFrom: 0 to: 7]!
Item was added:
+ ----- Method: ObjectMemory>>fullGC (in category 'garbage collection') -----
+ fullGC
+ "Do a mark/sweep garbage collection of the entire object memory. Free inaccessible objects but do not move them."
+
+ <inline: false>
+ DoAssertionChecks ifTrue:
+ [self reverseDisplayFrom: 0 to: 7.
+ self clearLeakMapAndMapAccessibleObjects.
+ self checkHeapIntegrity].
+ self preGCAction: GCModeFull.
+ gcStartUsecs := self ioUTCMicrosecondsNow.
+ statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
+ self clearRootsTable.
+ self initWeakTableForIncrementalGC: false.
+ youngStart := self startOfMemory. "process all of memory"
+ self markPhase.
+ "Sweep phase returns the number of survivors.
+ Use the up-to-date version instead the one from startup."
+ totalObjectCount := self sweepPhase.
+ self fullCompaction.
+ allocationCount := 0.
+ statFullGCs := statFullGCs + 1.
+ statGCEndTime := self ioMicroMSecs.
+ statFullGCUsecs := statFullGCUsecs + (self ioUTCMicrosecondsNow - gcStartUsecs).
+ self capturePendingFinalizationSignals.
+
+ youngStart := freeBlock. "reset the young object boundary"
+ self postGCAction: GCModeFull.
+ DoAssertionChecks ifTrue:
+ [self clearLeakMapAndMapAccessibleObjects.
+ self checkHeapIntegrity.
+ self reverseDisplayFrom: 0 to: 7]!
Item was changed:
----- Method: ObjectMemory>>garbageCollectForSnapshot (in category 'image save/restore') -----
garbageCollectForSnapshot
self incrementalGC. "maximimize space for forwarding table"
self fullGC.
self clearRootsTable!
Item was added:
+ ----- Method: ObjectMemory>>growToAccomodateContainerWithNumSlots: (in category 'allocation') -----
+ growToAccomodateContainerWithNumSlots: numSlots
+ "Grow memory to accomodate a container (an Array) with numSlots.
+ Grow by at least the growHeadroom. Supports allInstancesOf: and allObjects."
+ | delta |
+ delta := (headerTypeBytes at: HeaderTypeSizeAndClass) / BytesPerWord
+ + 1
+ + numSlots
+ * BytesPerOop.
+ self growObjectMemory: (growHeadroom max: delta)!
Item was removed:
- ----- Method: ObjectMemory>>incrementalGC (in category 'garbage collection') -----
- incrementalGC
- "Do a mark/sweep garbage collection of just the young object
- area of object memory (i.e., objects above youngStart), using
- the root table to identify objects containing pointers to
- young objects from the old object area."
- | survivorCount weDidGrow |
- <inline: false>
- rootTableOverflowed ifTrue:
- ["root table overflow; cannot do an incremental GC because some roots are missing.
- (this should be very rare)"
- statRootTableOverflows := statRootTableOverflows + 1.
- ^self fullGC].
-
- DoAssertionChecks ifTrue:
- [self reverseDisplayFrom: 8 to: 15.
- self checkHeapIntegrity.
- self checkInterpreterIntegrity.
- self validate].
-
- self preGCAction: GCModeIncr.
- "incremental GC and compaction"
-
- gcStartUsecs := self ioUTCMicrosecondsNow.
- statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
- self initWeakTableForIncrementalGC: true.
- self markPhase.
- self assert: weakRootCount <= WeakRootTableSize.
- 1 to: weakRootCount do:[:i| self finalizeReference: (weakRoots at: i)].
- survivorCount := self sweepPhase.
- self incrementalCompaction.
- statAllocationCount := allocationCount.
- allocationCount := 0.
- statIncrGCs := statIncrGCs + 1.
- statGCEndTime := self ioMicroMSecs.
- statIGCDeltaUsecs := self ioUTCMicrosecondsNow - gcStartUsecs.
- statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
- self capturePendingFinalizationSignals.
-
- self forceInterruptCheck. "Force an an interrupt check ASAP.We could choose to be clever here and only do this under certain time conditions. Keep it simple for now"
-
- statRootTableCount := rootTableCount.
- statSurvivorCount := survivorCount.
- weDidGrow := false.
- (((survivorCount > tenuringThreshold)
- or: [rootTableCount >= RootTableRedZone])
- or: [forceTenureFlag == true])
- ifTrue: ["move up the young space boundary if
- * there are too many survivors:
- this limits the number of objects that must be
- processed on future incremental GC's
- * we're about to overflow the roots table
- this limits the number of full GCs that may be caused
- by root table overflows in the near future"
- forceTenureFlag := false.
- statTenures := statTenures + 1.
- self clearRootsTable.
- (((self sizeOfFree: freeBlock) < growHeadroom) and:
- [gcBiasToGrow > 0])
- ifTrue: [self biasToGrow.
- weDidGrow := true].
- youngStart := freeBlock].
- self postGCAction: GCModeIncr.
- DoAssertionChecks ifTrue:
- [self validate.
- self checkHeapIntegrity.
- self checkInterpreterIntegrity.
- self reverseDisplayFrom: 8 to: 15].
- weDidGrow ifTrue: [self biasToGrowCheckGCLimit]!
Item was added:
+ ----- Method: ObjectMemory>>incrementalGC (in category 'garbage collection') -----
+ incrementalGC
+ "Do a mark/sweep garbage collection of just the young object
+ area of object memory (i.e., objects above youngStart), using
+ the root table to identify objects containing pointers to
+ young objects from the old object area."
+ | survivorCount weDidGrow |
+ <inline: false>
+ rootTableOverflowed ifTrue:
+ ["root table overflow; cannot do an incremental GC because some roots are missing.
+ (this should be very rare)"
+ statRootTableOverflows := statRootTableOverflows + 1.
+ ^self fullGC].
+
+ DoAssertionChecks ifTrue:
+ [self reverseDisplayFrom: 8 to: 15.
+ self checkHeapIntegrity.
+ self checkInterpreterIntegrity.
+ self validate].
+
+ self preGCAction: GCModeIncr.
+ "incremental GC and compaction"
+
+ gcStartUsecs := self ioUTCMicrosecondsNow.
+ statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
+ self initWeakTableForIncrementalGC: true.
+ self markPhase.
+ self assert: weakRootCount <= WeakRootTableSize.
+ 1 to: weakRootCount do:[:i| self finalizeReference: (weakRoots at: i)].
+ survivorCount := self sweepPhase.
+ self incrementalCompaction.
+ statAllocationCount := allocationCount.
+ allocationCount := 0.
+ statIncrGCs := statIncrGCs + 1.
+ statGCEndTime := self ioMicroMSecs.
+ statIGCDeltaUsecs := self ioUTCMicrosecondsNow - gcStartUsecs.
+ statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
+ self capturePendingFinalizationSignals.
+
+ self forceInterruptCheck. "Force an an interrupt check ASAP.We could choose to be clever here and only do this under certain time conditions. Keep it simple for now"
+
+ statRootTableCount := rootTableCount.
+ statSurvivorCount := survivorCount.
+ weDidGrow := false.
+ (((survivorCount > tenuringThreshold)
+ or: [rootTableCount >= RootTableRedZone])
+ or: [forceTenureFlag == true])
+ ifTrue: ["move up the young space boundary if
+ * there are too many survivors:
+ this limits the number of objects that must be
+ processed on future incremental GC's
+ * we're about to overflow the roots table
+ this limits the number of full GCs that may be caused
+ by root table overflows in the near future"
+ forceTenureFlag := false.
+ statTenures := statTenures + 1.
+ self clearRootsTable.
+ (((self sizeOfFree: freeBlock) < growHeadroom) and:
+ [gcBiasToGrow > 0])
+ ifTrue: [self biasToGrow.
+ weDidGrow := true].
+ youngStart := freeBlock].
+ self postGCAction: GCModeIncr.
+ DoAssertionChecks ifTrue:
+ [self validate.
+ self checkHeapIntegrity.
+ self checkInterpreterIntegrity.
+ self reverseDisplayFrom: 8 to: 15].
+ weDidGrow ifTrue: [self biasToGrowCheckGCLimit]!
Item was changed:
----- Method: ObjectMemory>>instanceSizeOf: (in category 'interpreter access') -----
instanceSizeOf: classObj
<api>
"Answer the number of slots in a class. For example the instanceSizeOf:
ClassPoint is 2, for the x & y slots. The instance size of non-pointer classes is 0."
| classHdr sizeHiBits byteSize |
self assert: (self addressCouldBeObj: classObj).
classHdr := self formatOfClass: classObj. "Low 2 bits are 0"
"Compute the size of instances of the class (used for fixed field classes only)"
sizeHiBits := classHdr >> 9 bitAnd: 16r300.
byteSize := (classHdr bitAnd: SizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
^byteSize - BaseHeaderSize / BytesPerWord!
Item was changed:
----- Method: ObjectMemory>>instantiateClass:indexableSize: (in category 'interpreter access') -----
instantiateClass: classPointer indexableSize: size
"NOTE: This method supports the backward-compatible split instSize field of the
class format word. The sizeHiBits will go away and other shifts change by 2
when the split fields get merged in an (incompatible) image change."
<api>
| hash header1 header2 cClass byteSize format binc header3 hdrSize sizeHiBits bm1 classFormat |
<inline: false>
self assert: size >= 0. "'cannot have a negative indexable field count"
hash := self newObjectHash.
classFormat := self formatOfClass: classPointer.
"Low 2 bits are 0"
header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
header2 := classPointer.
sizeHiBits := (classFormat bitAnd: 16r60000) >> 9.
cClass := header1 bitAnd: CompactClassMask. "compact class field from format word"
byteSize := (classFormat bitAnd: SizeMask + Size4Bit) + sizeHiBits.
"size in bytes -- low 2 bits are 0"
"Note this byteSize comes from the format word of the class which is pre-shifted
to 4 bytes per field. Need another shift for 8 bytes per word..."
byteSize := byteSize << (ShiftForWord-2).
format := self formatOfHeader: classFormat.
self flag: #sizeLowBits.
format < self firstByteFormat
ifTrue:
[format = self firstLongFormat
ifTrue: "long32 bitmaps"
[bm1 := BytesPerWord-1.
byteSize := byteSize + (size * 4) + bm1 bitAnd: LongSizeMask. "round up"
binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes"
"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
header1 := header1 bitOr: (binc bitAnd: 4)]
ifFalse: "Arrays and 64-bit bitmaps"
[byteSize := byteSize + (size * BytesPerWord)]]
ifFalse:
["Strings and Methods"
bm1 := BytesPerWord-1.
byteSize := byteSize + size + bm1 bitAnd: LongSizeMask. "round up"
binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes"
"low bits of byte size go in format field"
header1 := header1 bitOr: (binc bitAnd: 3) << self instFormatFieldLSB.
"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
header1 := header1 bitOr: (binc bitAnd: 4)].
byteSize > 255 "requires size header word/full header"
ifTrue: [header3 := byteSize. hdrSize := 3]
ifFalse: [header1 := header1 bitOr: byteSize. hdrSize := cClass = 0 ifTrue: [2] ifFalse: [1]].
^self allocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3 doFill: true format: format!
Item was changed:
----- Method: ObjectMemory>>instantiateContext:sizeInBytes: (in category 'interpreter access') -----
instantiateContext: classPointer sizeInBytes: sizeInBytes
"This version of instantiateClass assumes that the total object
size is under 256 bytes, the limit for objects with only one or
two header words. Note that the size is specified in bytes
and should include four bytes for the base header word."
| hash header1 header2 hdrSize |
hash := self newObjectHash.
header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: (self formatOfClass: classPointer).
header2 := classPointer.
(header1 bitAnd: CompactClassMask) > 0 "are contexts compact?"
ifTrue: [hdrSize := 1]
ifFalse: [hdrSize := 2].
sizeInBytes <= SizeMask
ifTrue: ["OR size into header1. Must not do this if size > SizeMask"
header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask))]
ifFalse: [hdrSize := 3.
"Zero the size field of header1 if large"
header1 := header1 - (header1 bitAnd: SizeMask)].
self flag: #Dan. "Check details of context sizes"
^ self allocate: sizeInBytes headerSize: hdrSize h1: header1 h2: header2 h3: LargeContextSize doFill: false format: 0!
Item was changed:
----- Method: ObjectMemory>>instantiateSmallClass:sizeInBytes: (in category 'interpreter access') -----
instantiateSmallClass: classPointer sizeInBytes: sizeInBytes
"This version of instantiateClass assumes that the total object
size is under 256 bytes, the limit for objects with only one or
two header words. Note that the size is specified in bytes
and should include 4 or 8 bytes for the base header word.
NOTE this code will only work for sizes that are an integral number of words
(like not a 32-bit LargeInteger in a 64-bit system).
May cause a GC.
Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak. Since this call is used in routines that do jsut that we are safe. Break this rule and die."
| hash header1 header2 hdrSize |
(sizeInBytes bitAnd: (BytesPerWord-1)) = 0 ifFalse:
[self error: 'size must be integral number of words'].
hash := self newObjectHash.
header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: (self formatOfClass: classPointer).
header2 := classPointer.
hdrSize := (header1 bitAnd: CompactClassMask) > 0 "is this a compact class"
ifTrue: [1]
ifFalse: [2].
header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask+Size4Bit)).
^ self allocate: sizeInBytes headerSize: hdrSize h1: header1 h2: header2 h3: 0 doFill: false format: 0!
Item was changed:
----- Method: ObjectMemory>>integerObjectOf: (in category 'interpreter access') -----
integerObjectOf: value
"Convert the integer value, assumed to be in SmallInteger range, into a tagged SmallInteger object.
In C, use a shift and an add to set the tag bit.
In Smalltalk we have to work harder because the simulator works with strictly positive bit patterns."
<returnTypeC: #sqInt>
^self
cCode: [(value << 1) + 1]
inSmalltalk: [value >= 0
ifTrue: [(value << 1) + 1]
ifFalse: [((16r80000000 + value) << 1) + 1]]!
Item was changed:
----- Method: ObjectMemory>>integerValueOf: (in category 'interpreter access') -----
integerValueOf: objectPointer
"Translator produces 'objectPointer >> 1'"
((objectPointer bitAnd: 16r80000000) ~= 0)
ifTrue: ["negative"
^ ((objectPointer bitAnd: 16r7FFFFFFF) >> 1)
- 16r3FFFFFFF - 1 "Faster than -16r40000000 (a LgInt)"]
ifFalse: ["positive"
^ objectPointer >> 1]!
Item was changed:
----- Method: ObjectMemory>>isCharacterObject: (in category 'interpreter access') -----
isCharacterObject: oop
<inline: true>
"N.B. Because Slang always inlines is:instanceOf:compactClassIndex:
(because is:instanceOf:compactClassIndex: has an inline: pragma) the
phrase (self splObj: ClassCharacter) is expanded in-place
and is _not_ evaluated if oop has a non-zero CompactClassIndex."
^self
is: oop
instanceOf: (self splObj: ClassCharacter)
compactClassIndex: 0!
Item was changed:
----- Method: ObjectMemory>>isCompiledMethod: (in category 'interpreter access') -----
isCompiledMethod: oop
"Answer whether the argument object is of compiled method format"
<api>
^(self formatOf: oop) >= self firstCompiledMethodFormat!
Item was changed:
----- Method: ObjectMemory>>isCompiledMethodHeader: (in category 'interpreter access') -----
isCompiledMethodHeader: objHeader
"Answer whether the argument header has compiled method format"
^(self formatOfHeader: objHeader) >= self firstCompiledMethodFormat!
Item was changed:
----- Method: ObjectMemory>>isForwarded: (in category 'interpreter access') -----
isForwarded: oop
"Compatibility wth SpurMemoryManager. In ObjectMemory, no forwarding pointers
are visible to the VM."
<api>
<cmacro: '(oop) false'>
<inline: true>
^false!
Item was changed:
----- Method: ObjectMemory>>isForwardedClassTag: (in category 'interpreter access') -----
isForwardedClassTag: classTag
"Compatibility wth SpurMemoryManager. In ObjectMemory, no forwarding pointers
are visible to the VM."
<inline: true>
^false!
Item was changed:
----- Method: ObjectMemory>>isImmediate: (in category 'interpreter access') -----
isImmediate: anOop
<api>
^self isIntegerObject: anOop!
Item was changed:
----- Method: ObjectMemory>>isImmediateCharacter: (in category 'interpreter access') -----
isImmediateCharacter: objectPointer
^false!
Item was changed:
----- Method: ObjectMemory>>isInRangeCharacterCode: (in category 'interpreter access') -----
isInRangeCharacterCode: characterCode
^characterCode >= 0 and: [characterCode <= 255]!
Item was changed:
----- Method: ObjectMemory>>isIntegerObject: (in category 'interpreter access') -----
isIntegerObject: objectPointer
^ (objectPointer bitAnd: 1) > 0!
Item was changed:
----- Method: ObjectMemory>>isIntegerValue: (in category 'interpreter access') -----
isIntegerValue: intValue
"Answer if the given value can be represented as a Smalltalk integer value.
In C, use a shift and XOR to set the sign bit if and only if the top two bits of the given
value are the same, then test the sign bit. Note that the top two bits are equal for
exactly those integers in the range that can be represented in 31-bits or 63-bits."
<api>
^self
cCode: [(intValue bitXor: (intValue << 1)) >= 0]
inSmalltalk: [intValue >= 16r-40000000 and: [intValue <= 16r3FFFFFFF]]!
Item was changed:
----- Method: ObjectMemory>>isNonImmediate: (in category 'interpreter access') -----
isNonImmediate: anOop
^self isNonIntegerObject: anOop!
Item was changed:
----- Method: ObjectMemory>>isNonIntegerObject: (in category 'interpreter access') -----
isNonIntegerObject: objectPointer
<api>
^(objectPointer bitAnd: 1) = 0!
Item was changed:
----- Method: ObjectMemory>>isOopCompiledMethod: (in category 'interpreter access') -----
isOopCompiledMethod: oop
"Answer whether the oop is an object of compiled method format"
<api>
^(self isNonIntegerObject: oop)
and: [(self formatOf: oop) >= self firstCompiledMethodFormat]!
Item was changed:
----- Method: ObjectMemory>>isOopForwarded: (in category 'interpreter access') -----
isOopForwarded: oop
"Compatibility wth SpurMemoryManager. In ObjectMemory, no forwarding pointers
are visible to the VM."
<inline: true>
^false!
Item was changed:
----- Method: ObjectMemory>>isYoung: (in category 'interpreter access') -----
isYoung: oop
<api>
^(self isNonIntegerObject: oop)
and: [self oop: oop isGreaterThanOrEqualTo: youngStart]!
Item was changed:
----- Method: ObjectMemory>>lengthOfMaybeImmediate: (in category 'debug support') -----
lengthOfMaybeImmediate: oop
"for the message send breakpoint; selectors can be immediates."
<inline: false>
(self isImmediate: oop) ifTrue: [^0].
^self lengthOf: oop!
Item was changed:
----- Method: ObjectMemory>>maybeSplObj: (in category 'interpreter access') -----
maybeSplObj: index
<api>
"Answer one of the objects in the SpecialObjectsArray, if in range, otherwise answer nil."
^index < (self lengthOf: specialObjectsOop) ifTrue:
[self fetchPointer: index ofObject: specialObjectsOop]!
Item was changed:
----- Method: ObjectMemory>>memoryBaseForImageRead (in category 'image save/restore') -----
memoryBaseForImageRead
"Answer the address to read the image into."
^memory!
Item was changed:
----- Method: ObjectMemory>>nilObject (in category 'interpreter access') -----
nilObject
<api>
"For access from BitBlt module & Cogit"
^ nilObj!
Item was added:
+ ----- Method: ObjectMemory>>noteAsRoot:headerLoc: (in category 'garbage collection') -----
+ noteAsRoot: oop headerLoc: headerLoc
+ "Record that the given oop in the old object area points to an object in the young area.
+ HeaderLoc is usually = oop, but may be an addr in a forwarding block."
+ | header |
+ <inline: true>
+ <asmLabel: false>
+ header := self longAt: headerLoc.
+ (self isYoungRootHeader: header) ifFalse:
+ "record oop as root only if not already recorded"
+ [rootTableCount < RootTableSize
+ ifTrue:
+ "record root if there is enough room in the roots table.
+ IMPORTANT: since clearRootsTable is the only thing that clears root bits
+ do *not* set the root bit unless an object is in the root table. checking
+ routines will complain about the root bit being unset instead of the table
+ being full, but that's life"
+ [rootTableCount := rootTableCount + 1.
+ rootTable at: rootTableCount put: oop.
+ self longAt: headerLoc put: (header bitOr: RootBit).
+ rootTableCount >= RootTableRedZone ifTrue:
+ "if we're now in the red zone force an IGC ASAP"
+ [allocationCount := allocationsBetweenGCs + 1]]
+ ifFalse: "note overflow; will need to do a fullGC instead of an incremental."
+ [rootTableOverflowed := true]]!
Item was removed:
- ----- Method: ObjectMemory>>noteAsRoot:headerLoc: (in category 'garbage collection') -----
- noteAsRoot: oop headerLoc: headerLoc
- "Record that the given oop in the old object area points to an object in the young area.
- HeaderLoc is usually = oop, but may be an addr in a forwarding block."
- | header |
- <inline: true>
- <asmLabel: false>
- header := self longAt: headerLoc.
- (self isYoungRootHeader: header) ifFalse:
- "record oop as root only if not already recorded"
- [rootTableCount < RootTableSize
- ifTrue:
- "record root if there is enough room in the roots table.
- IMPORTANT: since clearRootsTable is the only thing that clears root bits
- do *not* set the root bit unless an object is in the root table. checking
- routines will complain about the root bit being unset instead of the table
- being full, but that's life"
- [rootTableCount := rootTableCount + 1.
- rootTable at: rootTableCount put: oop.
- self longAt: headerLoc put: (header bitOr: RootBit).
- rootTableCount >= RootTableRedZone ifTrue:
- "if we're now in the red zone force an IGC ASAP"
- [allocationCount := allocationsBetweenGCs + 1]]
- ifFalse: "note overflow; will need to do a fullGC instead of an incremental."
- [rootTableOverflowed := true]]!
Item was added:
+ ----- Method: ObjectMemory>>objectBefore: (in category 'object enumeration') -----
+ objectBefore: address
+ "Return the object or start of free space immediately preceeding the given
+ address, object or free chunk in memory. If none, return 0. This is for debugging only."
+ | obj nextObj sz |
+ <api>
+ obj := self oopFromChunk: ((self oop: address isGreaterThan: youngStart)
+ ifTrue: [youngStart]
+ ifFalse: [self startOfMemory]).
+ [self oop: obj isLessThan: address] whileTrue:
+ [(self isFreeObject: obj)
+ ifTrue: [sz := self sizeOfFree: obj]
+ ifFalse: [sz := self sizeBitsOf: obj].
+ nextObj := self oopFromChunk: obj + sz.
+ (self oop: nextObj isGreaterThanOrEqualTo: address) ifTrue:
+ [^obj].
+ obj := nextObj].
+ ^0!
Item was removed:
- ----- Method: ObjectMemory>>objectBefore: (in category 'object enumeration') -----
- objectBefore: address
- "Return the object or start of free space immediately preceeding the given
- address, object or free chunk in memory. If none, return 0. This is for debugging only."
- | obj nextObj sz |
- <api>
- obj := self oopFromChunk: ((self oop: address isGreaterThan: youngStart)
- ifTrue: [youngStart]
- ifFalse: [self startOfMemory]).
- [self oop: obj isLessThan: address] whileTrue:
- [(self isFreeObject: obj)
- ifTrue: [sz := self sizeOfFree: obj]
- ifFalse: [sz := self sizeBitsOf: obj].
- nextObj := self oopFromChunk: obj + sz.
- (self oop: nextObj isGreaterThanOrEqualTo: address) ifTrue:
- [^obj].
- obj := nextObj].
- ^0!
Item was changed:
----- Method: ObjectMemory>>obsoleteDontUseThisFetchWord:ofObject: (in category 'interpreter access') -----
obsoleteDontUseThisFetchWord: fieldIndex ofObject: oop
"This message is deprecated but supported for a while via a tweak to sqVirtualMachine.[ch] Use fetchLong32, fetchLong64 or fetchPointer instead for new code"
^self fetchLong32: fieldIndex ofObject: oop!
Item was changed:
----- Method: ObjectMemory>>okayOop: (in category 'debug support') -----
okayOop: signedOop
"Verify that the given oop is legitimate. Check address, header, and size but not class."
| sz type fmt unusedBit oop |
<var: #oop type: #usqInt>
oop := self cCoerce: signedOop to: #usqInt.
"address and size checks"
(self isIntegerObject: oop) ifTrue: [ ^true ].
(oop >= self startOfMemory and: [oop < endOfMemory])
ifFalse: [ self error: 'oop is not a valid address'. ^false ].
((oop \\ BytesPerWord) = 0)
ifFalse: [ self error: 'oop is not a word-aligned address'. ^false ].
sz := self sizeBitsOf: oop.
(oop + sz) < endOfMemory
ifFalse: [ self error: 'oop size would make it extend beyond the end of memory'. ^false ].
"header type checks"
type := self headerType: oop.
type = HeaderTypeFree
ifTrue: [ self error: 'oop is a free chunk, not an object'. ^false ].
type = HeaderTypeShort ifTrue: [
(self compactClassIndexOf: oop) = 0
ifTrue: [ self error: 'cannot have zero compact class field in a short header'. ^false ].
].
type = HeaderTypeClass ifTrue: [
((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
ifFalse: [ self error: 'class header word has wrong type'. ^false ].
].
type = HeaderTypeSizeAndClass ifTrue: [
((oop >= (BytesPerWord*2)) and:
[(self headerType: oop - (BytesPerWord*2)) = type and:
[(self headerType: oop - BytesPerWord) = type]])
ifFalse: [ self error: 'class header word has wrong type'. ^false ].
].
"format check"
fmt := self formatOf: oop.
((fmt = 5) | (fmt = 7))
ifTrue: [ self error: 'oop has an unknown format type'. ^false ].
"mark and root bit checks"
unusedBit := 16r20000000.
BytesPerWord = 8
ifTrue:
[unusedBit := unusedBit << 16.
unusedBit := unusedBit << 16].
((self longAt: oop) bitAnd: unusedBit) = 0
ifFalse: [ self error: 'unused header bit 30 is set; should be zero'. ^false ].
"xxx
((self longAt: oop) bitAnd: MarkBit) = 0
ifFalse: [ self error: 'mark bit should not be set except during GC' ].
xxx"
((self isYoungRoot: oop) and: [oop >= youngStart])
ifTrue: [ self error: 'root bit is set in a young object'. ^false ].
^true
!
Item was changed:
----- Method: ObjectMemory>>oopHasOkayClass: (in category 'debug support') -----
oopHasOkayClass: signedOop
"Attempt to verify that the given oop has a reasonable behavior. The class must be a valid, non-integer oop and must not be nilObj. It must be a pointers object with three or more fields. Finally, the instance specification field of the behavior must match that of the instance."
| oop oopClass formatMask behaviorFormatBits oopFormatBits |
<var: #oop type: #usqInt>
<var: #oopClass type: #usqInt>
oop := self cCoerce: signedOop to: #usqInt.
self okayOop: oop.
oopClass := self cCoerce: (self fetchClassOf: oop) to: #usqInt.
(self isIntegerObject: oopClass)
ifTrue: [ self error: 'a SmallInteger is not a valid class or behavior'. ^false ].
(self okayOop: oopClass)
ifFalse: [ self error: 'class oop is not ok'. ^false ].
((self isPointersNonImm: oopClass) and: [(self lengthOf: oopClass) >= 3])
ifFalse: [ self error: 'a class (behavior) must be a pointers object of size >= 3'. ^false ].
(self isBytes: oop)
ifTrue: [ formatMask := 16rC00 ] "ignore extra bytes size bits"
ifFalse: [ formatMask := 16rF00 ].
behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
oopFormatBits := (self baseHeader: oop) bitAnd: formatMask.
behaviorFormatBits = oopFormatBits
ifFalse: [ self error: 'object and its class (behavior) formats differ'. ^false ].
^true!
Item was changed:
----- Method: ObjectMemory>>popRemappableOop (in category 'interpreter access') -----
popRemappableOop
"Pop and return the possibly remapped object from the remap buffer."
<api>
| oop |
oop := remapBuffer at: remapBufferCount.
remapBufferCount := remapBufferCount - 1.
^ oop!
Item was changed:
----- Method: ObjectMemory>>postSnapshot (in category 'image save/restore') -----
postSnapshot
"No op for Spur compatibility."!
Item was changed:
----- Method: ObjectMemory>>primitiveErrorTable (in category 'interpreter access') -----
primitiveErrorTable
<api>
^self splObj: PrimErrTableIndex!
Item was changed:
----- Method: ObjectMemory>>pushRemappableOop: (in category 'interpreter access') -----
pushRemappableOop: oop
"Record the given object in a the remap buffer. Objects in this buffer are remapped when a compaction occurs. This facility is used by the interpreter to ensure that objects in temporary variables are properly remapped."
<api>
self assert: (self addressCouldBeOop: oop).
remapBuffer at: (remapBufferCount := remapBufferCount + 1) put: oop.
remapBufferCount <= RemapBufferSize ifFalse:
[self error: 'remapBuffer overflow'].!
Item was changed:
----- Method: ObjectMemory>>readHeapFromImageFile:dataBytes: (in category 'image save/restore') -----
readHeapFromImageFile: f dataBytes: numBytes
"Read numBytes of image data from f into memory at memoryBaseForImageRead.
Answer the number of bytes written."
<var: #f type: #sqImageFile>
^self cCode:
[self
sq: (self pointerForOop: self memoryBaseForImageRead)
Image: (self sizeof: #char)
File: numBytes
Read: f]
inSmalltalk:
[(f readInto: memory
startingAt: self memoryBaseForImageRead // 4 + 1
count: numBytes // 4)
* 4]!
Item was changed:
----- Method: ObjectMemory>>reverseBytesFrom:to: (in category 'image save/restore') -----
reverseBytesFrom: startAddr to: stopAddr
"Byte-swap the given range of memory (not inclusive of stopAddr!!)."
| addr |
addr := startAddr.
[self oop: addr isLessThan: stopAddr] whileTrue:
[self longAt: addr put: (self byteSwapped: (self longAt: addr)).
addr := addr + BytesPerWord].!
Item was changed:
----- Method: ObjectMemory>>reverseWordsFrom:to: (in category 'image save/restore') -----
reverseWordsFrom: startAddr to: stopAddr
"Word-swap the given range of memory, excluding stopAddr."
| addr |
addr := startAddr.
[self oop: addr isLessThan: stopAddr] whileTrue:
[self longAt: addr put: (self wordSwapped: (self longAt: addr)).
addr := addr + BytesPerWord].!
Item was changed:
----- Method: ObjectMemory>>splObj: (in category 'interpreter access') -----
splObj: index
<api>
<inline: true>
"Return one of the objects in the SpecialObjectsArray"
^self fetchPointer: index ofObject: specialObjectsOop!
Item was changed:
----- Method: ObjectMemory>>splObj:put: (in category 'interpreter access') -----
splObj: index put: anObject
"Set one of the objects in the SpecialObjectsArray"
self storePointer: index ofObject: specialObjectsOop withValue: anObject!
Item was changed:
----- Method: ObjectMemory>>startOfFreeSpace (in category 'memory access') -----
startOfFreeSpace
<inline: true>
^freeBlock!
Item was changed:
----- Method: ObjectMemory>>storeByte:ofObject:withValue: (in category 'interpreter access') -----
storeByte: byteIndex ofObject: oop withValue: valueByte
^ self byteAt: oop + BaseHeaderSize + byteIndex
put: valueByte!
Item was changed:
----- Method: ObjectMemory>>storeLong32:ofObject:withValue: (in category 'interpreter access') -----
storeLong32: fieldIndex ofObject: oop withValue: valueWord
^ self long32At: oop + BaseHeaderSize + (fieldIndex << 2)
put: valueWord!
Item was changed:
----- Method: ObjectMemory>>storePointer:ofObject:withValue: (in category 'interpreter access') -----
storePointer: fieldIndex ofObject: oop withValue: valuePointer
"Note must check here for stores of young objects into old ones."
(self oop: oop isLessThan: youngStart) ifTrue: [
self possibleRootStoreInto: oop value: valuePointer.
].
^ self longAt: oop + BaseHeaderSize + (fieldIndex << ShiftForWord)
put: valuePointer!
Item was removed:
- ----- Method: ObjectMemory>>storePointerUnchecked:ofObject:withValue: (in category 'interpreter access') -----
- storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
- "Like storePointer:ofObject:withValue:, but the caller guarantees that the
- object being stored into is a young object or is already marked as a root."
- <api>
- <inline: true>
- ^self
- longAt: oop + BaseHeaderSize + (fieldIndex << ShiftForWord)
- put: valuePointer!
Item was added:
+ ----- Method: ObjectMemory>>storePointerUnchecked:ofObject:withValue: (in category 'interpreter access') -----
+ storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
+ "Like storePointer:ofObject:withValue:, but the caller guarantees that the
+ object being stored into is a young object or is already marked as a root."
+ <api>
+ <inline: true>
+ ^self
+ longAt: oop + BaseHeaderSize + (fieldIndex << ShiftForWord)
+ put: valuePointer!
Item was changed:
----- Method: ObjectMemory>>storeWord:ofObject:withValue: (in category 'interpreter access') -----
storeWord: fieldIndex ofObject: oop withValue: valueWord
"This message is deprecated. Use storeLong32, storeLong64 or storePointer"
self abort!
Item was changed:
----- Method: ObjectMemory>>topRemappableOop (in category 'interpreter access') -----
topRemappableOop
<api>
"Returns the top of the remappable oop. Useful when writing loops."
^remapBuffer at: remapBufferCount!
Item was removed:
- ----- Method: ObjectMemory>>vmEndianness (in category 'memory access') -----
- vmEndianness
- "return 0 for little endian, 1 for big endian"
- "?!!*#$%!! _Terrible_ name. Call it what it is.
- VMBIGENDIAN or VMLITTLEENDIAN. Dont leave us guessing!!!!!!!!
- Alas this has to remain for backward compatibility."
-
- ^VMBIGENDIAN ifTrue: [1] ifFalse: [0]!
Item was added:
+ ----- Method: ObjectMemory>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ "return 0 for little endian, 1 for big endian"
+ "?!!*#$%!! _Terrible_ name. Call it what it is.
+ VMBIGENDIAN or VMLITTLEENDIAN. Dont leave us guessing!!!!!!!!
+ Alas this has to remain for backward compatibility."
+
+ ^VMBIGENDIAN ifTrue: [1] ifFalse: [0]!
Item was changed:
----- Method: SimpleStackBasedCogit>>bytecodeFixupClass (in category 'simulation only') -----
bytecodeFixupClass
<doNotGenerate>
^CogBytecodeFixup!
Item was changed:
----- Method: SimpleStackBasedCogit>>ceShortCutTraceBlockActivation: (in category 'simulation only') -----
ceShortCutTraceBlockActivation: aProcessorSimulationTrap
self shortcutTrampoline: aProcessorSimulationTrap
to: [coInterpreter ceTraceBlockActivation]!
Item was changed:
----- Method: SimpleStackBasedCogit>>ceShortCutTraceLinkedSend: (in category 'simulation only') -----
ceShortCutTraceLinkedSend: aProcessorSimulationTrap
self shortcutTrampoline: aProcessorSimulationTrap
to: [coInterpreter ceTraceLinkedSend: (processor registerAt: (backEnd concreteRegister: ReceiverResultReg))]!
Item was changed:
----- Method: SimpleStackBasedCogit>>ceShortCutTraceStore: (in category 'simulation only') -----
ceShortCutTraceStore: aProcessorSimulationTrap
<doNotGenerate>
self shortcutTrampoline: aProcessorSimulationTrap
to: [coInterpreter
ceTraceStoreOf: (processor registerAt: (backEnd concreteRegister: ClassReg))
into: (processor registerAt: (backEnd concreteRegister: ReceiverResultReg))]!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>fillInCounters:atEndAddress: (in category 'generate machine code') -----
fillInCounters: nCounters atEndAddress: endAddress
endAddress - (nCounters * CounterBytes)
to: endAddress - CounterBytes
by: CounterBytes
do: [:address|
objectMemory
long32At: address
put: (initialCounterValue << 16 + initialCounterValue)]!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>fillInMethodHeader:size:selector: (in category 'generate machine code') -----
fillInMethodHeader: method size: size selector: selector
super fillInMethodHeader: method size: size selector: selector.
method numCounters: counterIndex.
^method!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>fillInOPICHeader:size:numArgs:selector: (in category 'generate machine code') -----
fillInOPICHeader: pic size: size numArgs: numArgs selector: selector
pic numCounters: 0.
^super fillInOPICHeader: pic size: size numArgs: numArgs selector: selector!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>generateCogMethod: (in category 'generate machine code') -----
generateCogMethod: selector
"We handle jump sizing simply. First we make a pass that asks each
instruction to compute its maximum size. Then we make a pass that
sizes jumps based on the maxmimum sizes. Then we make a pass
that fixes up jumps. When fixing up a jump the jump is not allowed to
choose a smaller offset but must stick to the size set in the second pass.
Override to add counters"
<returnTypeC: #'CogMethod *'>
| codeSize headerSize mapSize countersSize totalSize startAddress result method |
<var: #method type: #'CogMethod *'>
headerSize := self sizeof: CogMethod.
methodLabel address: headerSize negated.
self computeMaximumSizes.
methodLabel concretizeAt: (methodZone allocate: 0).
codeSize := self generateInstructionsAt: methodLabel address + headerSize.
mapSize := self generateMapAt: 0 start: methodLabel address + cmNoCheckEntryOffset.
countersSize := counterIndex * CounterBytes.
totalSize := methodZone roundUpLength: headerSize + codeSize + mapSize + countersSize.
totalSize > MaxMethodSize ifTrue:
[^self cCoerceSimple: MethodTooBig to: #'CogMethod *'].
startAddress := methodZone allocate: totalSize.
startAddress = 0 ifTrue:
[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
self assert: startAddress + cmEntryOffset = entry address.
self assert: startAddress + cmNoCheckEntryOffset = noCheckEntry address.
self regenerateCounterReferences: startAddress + totalSize.
result := self outputInstructionsAt: startAddress + headerSize.
self assert: startAddress + headerSize + codeSize = result.
backEnd nopsFrom: result to: startAddress + totalSize - mapSize.
self generateMapAt: startAddress + totalSize - countersSize - 1 start: startAddress + cmNoCheckEntryOffset.
self fillInBlockHeadersAt: startAddress.
self fillInCounters: counterIndex atEndAddress: startAddress + totalSize.
method := self fillInMethodHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
size: totalSize
selector: selector.
postCompileHook notNil ifTrue:
[self perform: postCompileHook with: method with: primInvokeLabel.
postCompileHook := nil].
processor flushICacheFrom: startAddress to: startAddress + headerSize + codeSize.
^method!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>handleWriteSimulationTrap: (in category 'simulation only') -----
handleWriteSimulationTrap: aProcessorSimulationTrap
<doNotGenerate>
| address end |
address := aProcessorSimulationTrap address.
(address >= methodZone freeStart
or: [address <= methodZoneBase]) ifTrue:
[^super handleWriteSimulationTrap: aProcessorSimulationTrap].
(counterMethodCache isNil
or: [address < counterMethodCache
or: [counterMethodCache address + counterMethodCache blockSize < address]]) ifTrue:
[counterMethodCache := methodZone methodFor: address].
end := counterMethodCache address + counterMethodCache blockSize.
self assert: (address
between: end - (CounterBytes * counterMethodCache numCounters)
and: end).
objectMemory longAt: address put: (processor perform: aProcessorSimulationTrap registerAccessor).
processor pc: aProcessorSimulationTrap nextpc!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>printCountersFor:on: (in category 'simulation only') -----
printCountersFor: cogMethod on: aStream
| firstCounter |
firstCounter := cogMethod address + cogMethod blockSize - (cogMethod numCounters * CounterBytes).
0 to: cogMethod numCounters - 1 do:
[:i| | addr |
addr := i * CounterBytes + firstCounter.
addr printOn: aStream base: 16.
aStream nextPut: $:; space.
(objectMemory longAt: addr) printOn: aStream base: 16.
aStream cr]!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>regenerateCounterReferences: (in category 'generate machine code') -----
regenerateCounterReferences: methodEndAddress
<var: #label type: #'AbstractInstruction *'>
<var: #dependentInstruction type: #'AbstractInstruction *'>
0 to: counterIndex - 1 do:
[:i| | label dependentInstruction |
label := self addressOf: (counters at: i).
label address: methodEndAddress - ((counterIndex - i) * CounterBytes).
dependentInstruction := label dependent.
[dependentInstruction concretizeAt: dependentInstruction address.
dependentInstruction := dependentInstruction dependent.
dependentInstruction ~= nil] whileTrue]!
Item was changed:
----- Method: Spur32BitCoMemoryManager>>checkMemoryMap (in category 'debug support') -----
checkMemoryMap
"Override to check that Cog methods are considered neither young nor old.
Being young would cause them to be scavenged.
Being old would cause them to be remembered if stored into (but wait, they don't get stored into)."
self assert: (self isYoungObject: newSpaceStart).
self assert: (self isYoungObject: newSpaceLimit - self wordSize).
self assert: (self isOldObject: newSpaceStart) not.
self assert: (self isOldObject: newSpaceLimit - self wordSize) not.
self assert: (self isYoungObject: newSpaceLimit) not.
self assert: (self isYoungObject: oldSpaceStart) not.
self assert: (self isYoungObject: endOfMemory) not.
self assert: (self isOldObject: oldSpaceStart).
self assert: (self isOldObject: endOfMemory).
"we would like the following to be true, but we either choose one boundary check for
cogMethods vs objects (isMachineCodeFrame: et al) or one boundary check for
copyAndForward:. We can't have both, and the former is likely the highest dynamic
frequency."
false ifTrue:
[self assert: (self isYoungObject: cogit minCogMethodAddress) not.
self assert: (self isYoungObject: cogit maxCogMethodAddress) not].
self assert: (self isOldObject: cogit minCogMethodAddress) not.
self assert: (self isOldObject: cogit maxCogMethodAddress) not!
Item was changed:
----- Method: Spur32BitCoMemoryManager>>clearLeakMapAndMapAccessibleObjects (in category 'debug support') -----
clearLeakMapAndMapAccessibleObjects
"Perform an integrity/leak check using the heapMap. Set a bit at each object's header.
Override to set a bit at each Cog method"
super clearLeakMapAndMapAccessibleObjects.
cogit addCogMethodsToHeapMap!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits long |
lowBits := byteAddress bitAnd: 3.
long := self longAt: byteAddress - lowBits.
^(lowBits caseOf: {
[0] -> [ long ].
[1] -> [ long bitShift: -8 ].
[2] -> [ long bitShift: -16 ].
[3] -> [ long bitShift: -24 ]
}) bitAnd: 16rFF!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| lowBits long longAddress |
lowBits := byteAddress bitAnd: 3.
longAddress := byteAddress - lowBits.
long := self longAt: longAddress.
long := (lowBits caseOf: {
[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16) ].
[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24) ]
}).
self longAt: longAddress put: long.
^byte!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>byteAtPointer: (in category 'memory access') -----
+ byteAtPointer: pointer
+ "This gets implemented by Macros in C, where its types will also be checked.
+ pointer is a raw address."
+
+ ^self byteAt: pointer!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>byteAtPointer: (in category 'memory access') -----
- byteAtPointer: pointer
- "This gets implemented by Macros in C, where its types will also be checked.
- pointer is a raw address."
-
- ^self byteAt: pointer!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>classTableFirstPage (in category 'debug support') -----
classTableFirstPage
^classTableFirstPage!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>coInterpreter:cogit: (in category 'initialization') -----
+ coInterpreter: aCoInterpreter cogit: aCogit
+ coInterpreter := aCoInterpreter.
+ cogit := aCogit.
+ scavenger coInterpreter: aCoInterpreter!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>coInterpreter:cogit: (in category 'initialization') -----
- coInterpreter: aCoInterpreter cogit: aCogit
- coInterpreter := aCoInterpreter.
- cogit := aCogit.
- scavenger coInterpreter: aCoInterpreter!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>cogCodeBase (in category 'simulation only') -----
- cogCodeBase
- ^Cogit guardPageSize!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>cogCodeBase (in category 'simulation only') -----
+ cogCodeBase
+ ^Cogit guardPageSize!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>eek (in category 'debug support') -----
+ eek
+ self halt!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>eek (in category 'debug support') -----
- eek
- self halt!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>endianness (in category 'memory access') -----
endianness
^#little!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>fetchFloatAt:into: (in category 'float primitives') -----
- fetchFloatAt: floatBitsAddress into: aFloat
- aFloat at: 2 put: (self long32At: floatBitsAddress).
- aFloat at: 1 put: (self long32At: floatBitsAddress+4)!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>fetchFloatAt:into: (in category 'float primitives') -----
+ fetchFloatAt: floatBitsAddress into: aFloat
+ aFloat at: 2 put: (self long32At: floatBitsAddress).
+ aFloat at: 1 put: (self long32At: floatBitsAddress+4)!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>fetchPointer:ofObject: (in category 'object access') -----
+ fetchPointer: fieldIndex ofObject: objOop
+ self assert: (self isForwarded: objOop) not.
+ self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)
+ or: [fieldIndex = 0 "forwarders and free objs"]]).
+ ^super fetchPointer: fieldIndex ofObject: objOop!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>fetchPointer:ofObject: (in category 'object access') -----
- fetchPointer: fieldIndex ofObject: objOop
- self assert: (self isForwarded: objOop) not.
- self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)
- or: [fieldIndex = 0 "forwarders and free objs"]]).
- ^super fetchPointer: fieldIndex ofObject: objOop!
Item was added:
+ ----- 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 numSlotsOf: objOop) << self shiftForWord))
+ to: #'oop *'].
+ "All bit objects, and indeed CompiledMethod, though this is a non-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 removed:
- ----- 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 numSlotsOf: objOop) << self shiftForWord))
- to: #'oop *'].
- "All bit objects, and indeed CompiledMethod, though this is a non-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 added:
+ ----- Method: Spur32BitMMLECoSimulator>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ "Used by Balloon"
+
+ ^long32 bitAnd: 16rFFFF!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- "Used by Balloon"
-
- ^long32 bitAnd: 16rFFFF!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- "Used by Balloon"
-
- ^long32 bitShift: -16!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ "Used by Balloon"
+
+ ^long32 bitShift: -16!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>heapMapAtWord: (in category 'debug support') -----
heapMapAtWord: address
^heapMap heapMapAtWord: address!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>intAt:put: (in category 'memory access') -----
intAt: byteAddress put: a32BitValue
^self longAt: byteAddress put: (a32BitValue bitAnd: 16rFFFFFFFF)!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+ "Answer the 32-bit word at byteAddress which must be 0 mod 4."
+
+ ^self longAt: byteAddress!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>long32At: (in category 'memory access') -----
- long32At: byteAddress
- "Answer the 32-bit word at byteAddress which must be 0 mod 4."
-
- ^self longAt: byteAddress!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ "Store the 32-bit value at byteAddress which must be 0 mod 4."
+
+ ^self longAt: byteAddress put: a32BitValue!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>long32At:put: (in category 'memory access') -----
- long32At: byteAddress put: a32BitValue
- "Store the 32-bit value at byteAddress which must be 0 mod 4."
-
- ^self longAt: byteAddress put: a32BitValue!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
- byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
- ^memory at: byteAddress // 4 + 1!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+ byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ ^memory at: byteAddress // 4 + 1!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+ "(byteAddress = 16r32F600 and: [a32BitValue = 16rB31E18]) ifTrue:
+ [self halt]."
+ byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ ^memory at: byteAddress // 4 + 1 put: a32BitValue!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a32BitValue
- "Note: Adjusted for Smalltalk's 1-based array indexing."
- "(byteAddress = 16r32F600 and: [a32BitValue = 16rB31E18]) ifTrue:
- [self halt]."
- byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
- ^memory at: byteAddress // 4 + 1 put: a32BitValue!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>longLongAt: (in category 'memory access') -----
longLongAt: byteAddress
"memory is a Bitmap, a 32-bit indexable array of bits"
| hiWord loWord |
byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
loWord := memory at: byteAddress // 4 + 1.
hiWord := memory at: byteAddress // 4 + 2.
^hiWord = 0
ifTrue: [loWord]
ifFalse: [(hiWord bitShift: 32) + loWord]!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>longLongAt:put: (in category 'memory access') -----
longLongAt: byteAddress put: a64BitValue
byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
self
longAt: byteAddress put: (a64BitValue bitAnd: 16rffffffff);
longAt: byteAddress + 4 put: a64BitValue >> 32.
^a64BitValue!
Item was changed:
----- 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>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+ "Return the half-word at byteAddress which must be even."
+ | lowBits long |
+ lowBits := byteAddress bitAnd: 2.
+ long := self longAt: byteAddress - lowBits.
+ ^ lowBits = 2
+ ifTrue: [ long bitShift: -16 ]
+ ifFalse: [ long bitAnd: 16rFFFF ]!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
- "Return the half-word at byteAddress which must be even."
- | lowBits long |
- lowBits := byteAddress bitAnd: 2.
- long := self longAt: byteAddress - lowBits.
- ^ lowBits = 2
- ifTrue: [ long bitShift: -16 ]
- ifFalse: [ long bitAnd: 16rFFFF ]!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- "Return the half-word at byteAddress which must be even."
- | lowBits long longAddress |
- lowBits := byteAddress bitAnd: 2.
- lowBits = 0
- ifTrue: "storing into LS word"
- [long := self longAt: byteAddress.
- self longAt: byteAddress
- put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)]
- ifFalse: "storing into MS word"
- [longAddress := byteAddress - 2.
- long := self longAt: longAddress.
- self longAt: longAddress
- put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))].
- ^a16BitValue!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ "Return the half-word at byteAddress which must be even."
+ | lowBits long longAddress |
+ lowBits := byteAddress bitAnd: 2.
+ lowBits = 0
+ ifTrue: "storing into LS word"
+ [long := self longAt: byteAddress.
+ self longAt: byteAddress
+ put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)]
+ ifFalse: "storing into MS word"
+ [longAddress := byteAddress - 2.
+ long := self longAt: longAddress.
+ self longAt: longAddress
+ put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))].
+ ^a16BitValue!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>storeFloatAt:from: (in category 'float primitives') -----
- storeFloatAt: floatBitsAddress from: aFloat
- self long32At: floatBitsAddress put: (aFloat at: 2).
- self long32At: floatBitsAddress+4 put: (aFloat at: 1)!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>storeFloatAt:from: (in category 'float primitives') -----
+ storeFloatAt: floatBitsAddress from: aFloat
+ self long32At: floatBitsAddress put: (aFloat at: 2).
+ self long32At: floatBitsAddress+4 put: (aFloat at: 1)!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>vmEndianness (in category 'memory access') -----
- vmEndianness
- "1 = big, 0 = little"
- ^0!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ "1 = big, 0 = little"
+ ^0!
Item was changed:
----- Method: Spur32BitMemoryManager class>>isImmediate: (in category 'simulation only') -----
isImmediate: anObject
^anObject class == SmallInteger
or: [anObject class == Character]!
Item was changed:
----- Method: Spur32BitMemoryManager class>>simulatorClass (in category 'simulation only') -----
simulatorClass
^Spur32BitMMLESimulator!
Item was changed:
----- Method: Spur32BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
changeClassOf: rcvr to: argClass
"Attempt to change the class of the receiver to the argument given that the
format of the receiver matches the format of the argument. If successful,
answer 0, otherwise answer an error code indicating the reason for failure.
Fail if the format of the receiver is incompatible with the format of the argument,
or if the argument is a fixed class and the receiver's size differs from the size
that an instance of the argument should have."
<inline: false>
| classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex |
classFormat := self formatOfClass: argClass.
fixedFields := self fixedFieldsOfClassFormat: classFormat.
classFormat := self instSpecOfClassFormat: classFormat.
instFormat := self formatOf: rcvr.
normalizedInstFormat := self classFormatForInstanceFormat: instFormat.
(normalizedInstFormat > self lastPointerFormat
and: [normalizedInstFormat = classFormat])
ifTrue: [newFormat := instFormat]
ifFalse:
[normalizedInstFormat <= self lastPointerFormat
ifTrue:
[classFormat > self lastPointerFormat ifTrue:
[^PrimErrInappropriate].
(self numSlotsOf: rcvr) < fixedFields ifTrue:
[^PrimErrBadReceiver].
newFormat := classFormat]
ifFalse:
[| instBytes |
instBytes := self byteLengthOf: rcvr.
normalizedInstFormat caseOf: {
[self sixtyFourBitIndexableFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
newFormat := classFormat].
[self firstLongFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
(classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue:
[^PrimErrBadReceiver].
newFormat := classFormat].
[self firstShortFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
classFormat caseOf: {
[self sixtyFourBitIndexableFormat]
-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat].
[self firstLongFormat]
-> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat].
[self firstByteFormat]
-> [newFormat := classFormat + (4 - instBytes bitAnd: 3)] }].
[self firstByteFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
classFormat caseOf: {
[self sixtyFourBitIndexableFormat]
-> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver]].
[self firstLongFormat]
-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]].
[self firstShortFormat]
-> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver]] }.
newFormat := classFormat].
[self firstCompiledMethodFormat] ->
[classFormat ~= self firstCompiledMethodFormat ifTrue:
[^PrimErrInappropriate].
newFormat := instFormat] }]].
(classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
[^classIndex negated].
self setFormatOf: rcvr to: newFormat;
setClassIndexOf: rcvr to: classIndex.
"ok"
^0!
Item was changed:
----- Method: Spur32BitMemoryManager>>isIntegerValue: (in category 'interpreter access') -----
isIntegerValue: intValue
"Answer if the given value can be represented as a Smalltalk integer value.
In C, use a shift and XOR to set the sign bit if and only if the top two bits of the given
value are the same, then test the sign bit. Note that the top two bits are equal for
exactly those integers in the range that can be represented in 31-bits or 63-bits."
<api>
^self
cCode: [(intValue bitXor: (intValue << 1)) >= 0]
inSmalltalk: [intValue >= 16r-40000000 and: [intValue <= 16r3FFFFFFF]]!
Item was changed:
----- Method: Spur64BitMemoryManager class>>isImmediate: (in category 'simulation only') -----
isImmediate: anObject
self flag: 'The float range is close but probably wrong. Revisit when immediate floats are implemented'.
^anObject class == SmallInteger
or: [anObject class == Character
or: [anObject class == Float and: [anObject exponent between: -128 and: 127]]]!
Item was changed:
----- Method: Spur64BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
changeClassOf: rcvr to: argClass
"Attempt to change the class of the receiver to the argument given that the
format of the receiver matches the format of the argument. If successful,
answer 0, otherwise answer an error code indicating the reason for failure.
Fail if the format of the receiver is incompatible with the format of the argument,
or if the argument is a fixed class and the receiver's size differs from the size
that an instance of the argument should have."
<inline: false>
| classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex |
classFormat := self formatOfClass: argClass.
fixedFields := self fixedFieldsOfClassFormat: classFormat.
classFormat := self instSpecOfClassFormat: classFormat.
instFormat := self formatOf: rcvr.
normalizedInstFormat := self classFormatForInstanceFormat: instFormat.
(normalizedInstFormat > self lastPointerFormat
and: [normalizedInstFormat = classFormat])
ifTrue: [newFormat := instFormat]
ifFalse:
[normalizedInstFormat <= self lastPointerFormat
ifTrue:
[classFormat > self lastPointerFormat ifTrue:
[^PrimErrInappropriate].
(self numSlotsOf: rcvr) < fixedFields ifTrue:
[^PrimErrBadReceiver].
newFormat := classFormat]
ifFalse:
[| instBytes |
instBytes := self byteLengthOf: rcvr.
normalizedInstFormat caseOf: {
[self sixtyFourBitIndexableFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
newFormat := classFormat].
[self firstLongFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
(classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue:
[^PrimErrBadReceiver].
newFormat := classFormat].
[self firstShortFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
classFormat caseOf: {
[self sixtyFourBitIndexableFormat]
-> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat].
[self firstLongFormat]
-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat + (2 - instBytes bitAnd: 1)].
[self firstByteFormat]
-> [newFormat := classFormat + (8 - instBytes bitAnd: 7)] }].
[self firstByteFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
classFormat caseOf: {
[self sixtyFourBitIndexableFormat]
-> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat].
[self firstLongFormat]
-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat + (2 - instBytes bitAnd: 1)].
[self firstShortFormat]
-> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat + (4 - instBytes bitAnd: 3)] }.
newFormat := classFormat].
[self firstCompiledMethodFormat] ->
[classFormat ~= self firstCompiledMethodFormat ifTrue:
[^PrimErrInappropriate].
newFormat := instFormat] }]].
(classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
[^classIndex negated].
self setFormatOf: rcvr to: newFormat;
setClassIndexOf: rcvr to: classIndex.
"ok"
^0!
Item was changed:
----- Method: SpurGenerationScavenger>>futureSpaceObjectsDo: (in category 'debug support') -----
futureSpaceObjectsDo: aBlock
| obj |
futureSurvivorStart > futureSpace start ifTrue:
[obj := manager objectStartingAt: futureSpace start.
[obj < futureSurvivorStart] whileTrue:
[aBlock value: obj.
obj := manager objectAfter: obj limit: futureSurvivorStart]]!
Item was changed:
----- Method: SpurGenerationScavenger>>printWeaklingList: (in category 'debug support') -----
printWeaklingList: listHead
"Print the objects on either the weakList or the ephemeronList."
| corpse |
corpse := self firstCorpse: listHead.
corpse ifNil:
[coInterpreter print: 'empty'; cr.
^self].
[corpse notNil] whileTrue:
[coInterpreter printHexnp: corpse; print: ' -> '; shortPrintOop: (manager followForwarded: corpse).
corpse := self nextCorpseOrNil: corpse]!
Item was changed:
----- Method: SpurGenerationScavenger>>rememberedSetWithIndexDo: (in category 'debug support') -----
rememberedSetWithIndexDo: aBlock
0 to: rememberedSetSize - 1 do:
[:i| aBlock value: (rememberedSet at: i) value: i]!
Item was changed:
----- Method: SpurMemoryManager>>addressCouldBeObj: (in category 'debug support') -----
addressCouldBeObj: address
<api>
<inline: false>
^(address bitAnd: self baseHeaderSize - 1) = 0
and: [(self isInOldSpace: address)
or: [(self isInEden: address)
or: [(self isInSurvivorSpace: address)
or: [scavengeInProgress and: [self isInFutureSpace: address]]]]]!
Item was changed:
----- Method: SpurMemoryManager>>addressCouldBeOop: (in category 'debug support') -----
addressCouldBeOop: address
^(self isImmediate: address)
or: [self addressCouldBeObj: address]!
Item was added:
+ ----- Method: SpurMemoryManager>>allInstancesOf: (in category 'primitive support') -----
+ allInstancesOf: aClass
+ "Attempt to answer an array of all objects, excluding those that may
+ be garbage collected as a side effect of allocating the result array.
+ If no memory is available answer the number of instances as a SmallInteger.
+ Since objects are at least 16 bytes big, and the largest SmallInteger covers
+ 1/4 of the address space, the count can never overflow."
+ | classIndex freeChunk ptr start limit count bytes |
+ classIndex := self rawHashBitsOf: aClass.
+ (classIndex = 0
+ or: [aClass ~~ (self classOrNilAtIndex: classIndex)]) ifTrue:
+ [freeChunk := self allocateSlots: 0 format: self arrayFormat classIndex: ClassArrayCompactIndex.
+ ^freeChunk].
+ self markObjects. "don't want to revive objects unnecessarily."
+ freeChunk := self allocateLargestFreeChunk.
+ ptr := start := freeChunk + self baseHeaderSize.
+ limit := self addressAfter: freeChunk.
+ count := 0.
+ self allHeapEntitiesDo:
+ [:obj| "continue enumerating even if no room so as to unmark all objects."
+ (self isMarked: obj) ifTrue:
+ [(self isNormalObject: obj)
+ ifTrue:
+ [self setIsMarkedOf: obj to: false.
+ (self classIndexOf: obj) = classIndex ifTrue:
+ [count := count + 1.
+ ptr < limit ifTrue:
+ [self longAt: ptr put: obj.
+ ptr := ptr + self bytesPerSlot]]]
+ ifFalse:
+ [(self isSegmentBridge: obj) ifFalse:
+ [self setIsMarkedOf: obj to: false]]]].
+ self assert: self allObjectsUnmarked.
+ self assert: (self isEmptyObjStack: markStack).
+ self emptyObjStack: weaklingStack.
+ (count > (ptr - start / self bytesPerSlot) "not enough room"
+ or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
+ [self freeObject: freeChunk.
+ ^self integerObjectOf: count].
+ count < self numSlotsMask ifTrue:
+ [| smallObj |
+ smallObj := self allocateSlots: count format: self arrayFormat classIndex: ClassArrayCompactIndex.
+ 0 to: count - 1 do:
+ [:i|
+ self storePointerUnchecked: i ofObject: smallObj withValue: (self fetchPointer: i ofObject: freeChunk)].
+ self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
+ self beRootIfOld: smallObj.
+ self checkFreeSpace.
+ ^smallObj].
+ bytes := self largeObjectBytesForSlots: count.
+ start := self startOfObject: freeChunk.
+ self freeChunkWithBytes: limit - start - bytes at: start + bytes.
+ totalFreeOldSpace := totalFreeOldSpace - bytes.
+ self setOverflowNumSlotsOf: freeChunk to: count.
+ self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
+ self setFormatOf: freeChunk to: self arrayFormat.
+ self possibleRootStoreInto: freeChunk.
+ self checkFreeSpace.
+ ^freeChunk
+
+ !
Item was changed:
----- Method: SpurMemoryManager>>allObjects (in category 'primitive support') -----
allObjects
"Attempt to answer an array of all objects, excluding those that may
be garbage collected as a side effect of allocating the result array.
+ If no memory is available answer the number of objects as a SmallInteger.
+ Since objects are at least 16 bytes big, and the largest SmallInteger covers
+ 1/4 of the address space, the count can never overflow."
- If no memory is available answer 0."
| freeChunk ptr start limit count bytes |
self markObjects. "don't want to revive objects unnecessarily."
freeChunk := self allocateLargestFreeChunk.
ptr := start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
count := 0.
self allHeapEntitiesDo:
[:obj| "continue enumerating even if no room so as to unmark all objects."
(self isMarked: obj) ifTrue:
[(self isNormalObject: obj)
ifTrue:
[self setIsMarkedOf: obj to: false.
count := count + 1.
ptr < limit ifTrue:
[self longAt: ptr put: obj.
ptr := ptr + self bytesPerSlot]]
ifFalse:
[(self isSegmentBridge: obj) ifFalse:
[self setIsMarkedOf: obj to: false]]]].
self assert: self allObjectsUnmarked.
+ self assert: (self isEmptyObjStack: markStack).
+ self emptyObjStack: weaklingStack.
self assert: count >= self numSlotsMask.
(count > (ptr - start / self bytesPerSlot) "not enough room"
or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
+ [self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
+ self checkFreeSpace.
+ ^self integerObjectOf: count].
- [self freeObject: freeChunk.
- ^0].
bytes := self largeObjectBytesForSlots: count.
start := self startOfObject: freeChunk.
self freeChunkWithBytes: limit - start - bytes at: start + bytes.
+ totalFreeOldSpace := totalFreeOldSpace - bytes.
self setOverflowNumSlotsOf: freeChunk to: count.
self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
self setFormatOf: freeChunk to: self arrayFormat.
self possibleRootStoreInto: freeChunk.
+ self checkFreeSpace.
^freeChunk
!
Item was added:
+ ----- Method: SpurMemoryManager>>arrayValueOf: (in category 'simulation only') -----
+ arrayValueOf: arrayOop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter arrayValueOf: arrayOop!
Item was removed:
- ----- Method: SpurMemoryManager>>arrayValueOf: (in category 'simulation only') -----
- arrayValueOf: arrayOop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter arrayValueOf: arrayOop!
Item was changed:
----- Method: SpurMemoryManager>>bitsSetInFreeSpaceMaskForAllFreeLists (in category 'debug support') -----
bitsSetInFreeSpaceMaskForAllFreeLists
0 to: self numFreeLists - 1 do:
[:i|
((freeLists at: i) ~= 0
and: [1 << i noMask: freeListsMask]) ifTrue:
[^false]].
^true!
Item was added:
+ ----- Method: SpurMemoryManager>>booleanValueOf: (in category 'simulation only') -----
+ booleanValueOf: obj
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter booleanValueOf: obj!
Item was removed:
- ----- Method: SpurMemoryManager>>booleanValueOf: (in category 'simulation only') -----
- booleanValueOf: obj
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter booleanValueOf: obj!
Item was changed:
----- Method: SpurMemoryManager>>cCoerce:to: (in category 'memory access') -----
cCoerce: value to: cTypeString
"Type coercion. For translation a cast will be emmitted. When running in Smalltalk
answer a suitable wrapper for correct indexing."
^value
ifNil: [value]
ifNotNil: [value coerceTo: cTypeString sim: self]!
Item was changed:
----- Method: SpurMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
changeClassOf: rcvr to: argClass
"Attempt to change the class of the receiver to the argument given that the
format of the receiver matches the format of the argument. If successful,
answer 0, otherwise answer an error code indicating the reason for failure.
Fail if the format of the receiver is incompatible with the format of the argument,
or if the argument is a fixed class and the receiver's size differs from the size
that an instance of the argument should have."
self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>cheapAddressCouldBeInHeap: (in category 'debug support') -----
cheapAddressCouldBeInHeap: address
^(address bitAnd: self wordSize - 1) = 0
and: [(self oop: address isGreaterThanOrEqualTo: newSpaceStart)
and: [self oop: address isLessThan: endOfMemory]]!
Item was changed:
----- Method: SpurMemoryManager>>checkForCompactableObjects (in category 'debug support') -----
checkForCompactableObjects
"self checkForCompactableObjects"
<doNotGenerate>
| firstFree them sizes |
firstFree := 0.
self allOldSpaceEntitiesDo: [:o| (firstFree = 0 and: [self isFreeObject: o]) ifTrue: [firstFree := o]].
firstFree = 0 ifTrue: [^nil].
sizes := Bag new.
self allFreeObjectsDo:
[:f| sizes add: (self bytesInObject: f)].
them := OrderedCollection new.
self allOldSpaceObjectsFrom: firstFree do:
[:o| | b |
b := self bytesInObject: o.
(sizes includes: b) ifTrue:
[them add: o.
sizes remove: b]].
^them isEmpty ifFalse:
[{them size. them first. them last}]!
Item was changed:
----- Method: SpurMemoryManager>>checkFreeSpace (in category 'debug support') -----
checkFreeSpace
self assert: self bitsSetInFreeSpaceMaskForAllFreeLists.
self assert: totalFreeOldSpace = self totalFreeListBytes!
Item was changed:
----- 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 changed:
----- Method: SpurMemoryManager>>checkMemoryMap (in category 'debug support') -----
checkMemoryMap
self assert: (self isYoungObject: newSpaceStart).
self assert: (self isYoungObject: newSpaceLimit - self wordSize).
self assert: (self isOldObject: newSpaceStart) not.
self assert: (self isOldObject: newSpaceLimit - self wordSize) not.
self assert: (self isYoungObject: newSpaceLimit) not.
self assert: (self isYoungObject: oldSpaceStart) not.
self assert: (self isYoungObject: endOfMemory) not.
self assert: (self isOldObject: newSpaceLimit).
self assert: (self isOldObject: oldSpaceStart).
self assert: (self isOldObject: endOfMemory)!
Item was changed:
----- Method: SpurMemoryManager>>checkOkayOop: (in category 'debug support') -----
checkOkayOop: oop
"Verify that the given oop is legitimate. Check address, header, and size but not class.
Answer true if OK. Otherwise print reason and answer false."
<api>
<var: #oop type: #usqInt>
| classIndex fmt unusedBits unusedBitsInYoungObjects |
<var: #unusedBits type: #usqLong>
"address and size checks"
(self isImmediate: oop) ifTrue: [^true].
(self addressCouldBeObj: oop) ifFalse:
[self print: 'oop '; printHex: oop; print: ' is not a valid address'. ^false].
(self oop: (self addressAfter: oop) isLessThanOrEqualTo: endOfMemory) ifFalse:
[self print: 'oop '; printHex: oop; print: ' size would make it extend beyond the end of memory'. ^false].
"header type checks"
(classIndex := self classIndexOf: oop) >= self firstClassIndexPun ifFalse:
[self print: 'oop '; printHex: oop; print: ' is a free chunk, or bridge, not an object'. ^false].
((self rawNumSlotsOf: oop) = self numSlotsMask
and: [(self rawNumSlotsOf: oop - self baseHeaderSize) ~= self numSlotsMask]) ifTrue:
[self print: 'oop '; printHex: oop; print: ' header has overflow header word, but overflow word does not have a saturated numSlots field'. ^false].
"format check"
fmt := self formatOf: oop.
(fmt = 6) | (fmt = 8) ifTrue:
[self print: 'oop '; printHex: oop; print: ' has an unknown format type'. ^false].
(fmt = self forwardedFormat) ~= (classIndex = self isForwardedObjectClassIndexPun) ifTrue:
[self print: 'oop '; printHex: oop; print: ' has mis-matched format/classIndex fields; only one of them is the isForwarded value'. ^false].
"specific header bit checks"
unusedBits := (1 << self classIndexFieldWidth)
| (1 << (self identityHashFieldWidth + 32)).
((self longLongAt: oop) bitAnd: unusedBits) ~= 0 ifTrue:
[self print: 'oop '; printHex: oop; print: ' has some unused header bits set; should be zero'. ^false].
unusedBitsInYoungObjects := self newSpaceRefCountMask.
((self longAt: oop) bitAnd: unusedBitsInYoungObjects) ~= 0 ifTrue:
[self print: 'oop '; printHex: oop; print: ' has some header bits unused in young objects set; should be zero'. ^false].
^true!
Item was changed:
----- Method: SpurMemoryManager>>checkOkayYoungReferrer: (in category 'debug support') -----
checkOkayYoungReferrer: obj
"Verify that the given obj is a valid youngReferrer. Check remembered is set and
is in remembered set. Answer true if OK. Otherwise print reason and answer false.
Assumes the object contains young references."
(self oop: obj isLessThan: newSpaceLimit) ifTrue:
[^true].
(self isRemembered: obj) ifFalse:
[ self print: 'remembered bit is not set in '; printHex: obj; cr. ^false ].
(scavenger isInRememberedSet: obj) ifTrue: [^true].
self printHex: obj; print: ' has remembered bit set but is not in remembered set'; cr.
^false
!
Item was changed:
----- Method: SpurMemoryManager>>checkOopHasOkayClass: (in category 'debug support') -----
checkOopHasOkayClass: obj
"Attempt to verify that the given obj has a reasonable behavior. The class must be a
valid, non-integer oop and must not be nilObj. It must be a pointers object with three
or more fields. Finally, the instance specification field of the behavior must match that
of the instance. If OK answer true. If not, print reason and answer false."
<api>
<var: #obj type: #usqInt>
| objClass objFormat |
<var: #objClass type: #usqInt>
(self checkOkayOop: obj) ifFalse:
[^false].
objClass := self cCoerce: (self fetchClassOfNonImm: obj) to: #usqInt.
(self isImmediate: objClass) ifTrue:
[self print: 'obj '; printHex: obj; print: ' an immediate is not a valid class or behavior'; cr. ^false].
(self okayOop: objClass) ifFalse:
[self print: 'obj '; printHex: obj; print: ' class obj is not ok'; cr. ^false].
((self isPointersNonImm: objClass) and: [(self numSlotsOf: objClass) >= 3]) ifFalse:
[self print: 'obj '; printHex: obj; print: ' a class (behavior) must be a pointers object of size >= 3'; cr. ^false].
objFormat := (self isBytes: obj)
ifTrue: [(self formatOf: obj) bitClear: 7] "ignore extra bytes size bits"
ifFalse: [self formatOf: obj].
(self instSpecOfClass: objClass) ~= objFormat ifTrue:
[self print: 'obj '; printHex: obj; print: ' and its class (behavior) formats differ'; cr. ^false].
^true!
Item was changed:
----- Method: SpurMemoryManager>>checkOopIntegrity:named: (in category 'debug support') -----
checkOopIntegrity: obj named: name
<inline: false>
<var: #name type: #'char *'>
(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
[^true].
coInterpreter print: name; print: ' leak '; printHex: obj; cr.
^false!
Item was changed:
----- Method: SpurMemoryManager>>checkOopIntegrity:named:index: (in category 'debug support') -----
checkOopIntegrity: obj named: name index: i
<inline: false>
<var: #name type: #'char *'>
(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
[^true].
coInterpreter print: name; print: ' leak @ '; printNum: i; print: ' = '; printHex: obj; cr.
^false!
Item was removed:
- ----- Method: SpurMemoryManager>>checkedIntegerValueOf: (in category 'simulation only') -----
- checkedIntegerValueOf: intOop
- <doNotGenerate>
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter checkedIntegerValueOf: intOop!
Item was added:
+ ----- Method: SpurMemoryManager>>checkedIntegerValueOf: (in category 'simulation only') -----
+ checkedIntegerValueOf: intOop
+ <doNotGenerate>
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter checkedIntegerValueOf: intOop!
Item was changed:
----- Method: SpurMemoryManager>>checkedLongAt: (in category 'memory access') -----
checkedLongAt: byteAddress
"Assumes zero-based array indexing."
<api>
(self isInMemory: byteAddress) ifFalse:
[self warning: 'checkedLongAt bad address'.
coInterpreter primitiveFail].
^self longAt: byteAddress!
Item was changed:
----- Method: SpurMemoryManager>>classForClassTag: (in category 'interpreter access') -----
classForClassTag: classIndex
self assert: classIndex ~= self isForwardedObjectClassIndexPun.
^self classAtIndex: classIndex!
Item was changed:
----- Method: SpurMemoryManager>>classTagForClass: (in category 'interpreter access') -----
classTagForClass: classObj
"Answer the classObj's identityHash to use as a tag in the first-level method lookup cache."
self assert: (coInterpreter addressCouldBeClassObj: classObj).
^self ensureBehaviorHash: classObj!
Item was changed:
----- Method: SpurMemoryManager>>classTagForSpecialObjectsIndex:compactClassIndex: (in category 'interpreter access') -----
classTagForSpecialObjectsIndex: splObjIndex compactClassIndex: compactClassIndex
"Answer the compactClassIndex to use as a tag in the first-level method lookup cache."
^compactClassIndex!
Item was changed:
----- Method: SpurMemoryManager>>clearLeakMapAndMapAccessibleObjects (in category 'debug support') -----
clearLeakMapAndMapAccessibleObjects
"Perform an integrity/leak check using the heapMap. Set a bit at each object's header."
<inline: false>
heapMap clearHeapMap.
self allObjectsDo:
[:oop| heapMap heapMapAtWord: (self pointerForOop: oop) Put: 1]!
Item was changed:
----- Method: SpurMemoryManager>>countMarkedAndUnmarkdObjects: (in category 'debug support') -----
countMarkedAndUnmarkdObjects: printFlags
"print the count of marked and unmarked objects.
In addition if 1 is set in printFlags, short-print marked objects,
and/or if 2 is set, short-print unmarked obejcts."
<api>
| nm nu |
nm := nu := 0.
self allObjectsDo:
[:o|
(self isMarked: o)
ifTrue:
[nm := nm + 1.
(printFlags anyMask: 1) ifTrue:
[coInterpreter shortPrintOop: o]]
ifFalse:
[nu := nu + 1.
(printFlags anyMask: 2) ifTrue:
[coInterpreter shortPrintOop: o]]].
self print: 'n marked: '; printNum: nm; cr.
self print: 'n unmarked: '; printNum: nu; cr!
Item was removed:
- ----- Method: SpurMemoryManager>>eek (in category 'debug support') -----
- eek
- <inline: true>!
Item was added:
+ ----- Method: SpurMemoryManager>>eek (in category 'debug support') -----
+ eek
+ <inline: true>!
Item was changed:
----- Method: SpurMemoryManager>>existInstancesInNewSpaceOf: (in category 'debug support') -----
existInstancesInNewSpaceOf: classObj
| classIndex |
classIndex := self rawHashBitsOf: classObj.
self allNewSpaceObjectsDo:
[:obj|
(self classIndexOf: obj) = classIndex ifTrue:
[^true]].
^false!
Item was changed:
----- Method: SpurMemoryManager>>failed (in category 'simulation only') -----
failed
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter failed!
Item was changed:
----- Method: SpurMemoryManager>>fetchClassTagOf: (in category 'interpreter access') -----
fetchClassTagOf: oop
| tagBits |
(tagBits := oop bitAnd: self tagMask) ~= 0 ifTrue:
[^(tagBits bitAnd: 1) ~= 0 ifTrue: [1] ifFalse: [tagBits]].
^self classIndexOf: oop!
Item was changed:
----- Method: SpurMemoryManager>>fetchClassTagOfNonImm: (in category 'interpreter access') -----
fetchClassTagOfNonImm: obj
"In Spur an object's classIndex is the tag in all method caches."
^self classIndexOf: obj!
Item was removed:
- ----- Method: SpurMemoryManager>>fetchInteger:ofObject: (in category 'simulation only') -----
- fetchInteger: fieldIndex ofObject: objectPointer
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter fetchInteger: fieldIndex ofObject: objectPointer!
Item was added:
+ ----- Method: SpurMemoryManager>>fetchInteger:ofObject: (in category 'simulation only') -----
+ fetchInteger: fieldIndex ofObject: objectPointer
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter fetchInteger: fieldIndex ofObject: objectPointer!
Item was added:
+ ----- Method: SpurMemoryManager>>fetchPointer:ofObject: (in category 'object access') -----
+ fetchPointer: fieldIndex ofObject: objOop
+ ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!
Item was removed:
- ----- Method: SpurMemoryManager>>fetchPointer:ofObject: (in category 'object access') -----
- fetchPointer: fieldIndex ofObject: objOop
- ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!
Item was changed:
----- Method: SpurMemoryManager>>findString: (in category 'debug support') -----
findString: aCString
"Print the oops of all string-like things that have the same characters as aCString"
<api>
<var: #aCString type: #'char *'>
| cssz |
cssz := self strlen: aCString.
self allObjectsDo:
[:obj|
((self isBytesNonImm: obj)
and: [(self lengthOf: obj) = cssz
and: [(self str: aCString n: (self pointerForOop: obj + BaseHeaderSize) cmp: cssz) = 0]]) ifTrue:
[coInterpreter printHex: obj; space; printOopShort: obj; cr]]!
Item was changed:
----- Method: SpurMemoryManager>>findStringBeginningWith: (in category 'debug support') -----
findStringBeginningWith: aCString
"Print the oops of all string-like things that start with the same characters as aCString"
<api>
<var: #aCString type: #'char *'>
| cssz |
cssz := self strlen: aCString.
self allObjectsDo:
[:obj|
((self isBytesNonImm: obj)
and: [(self lengthOf: obj) >= cssz
and: [(self str: aCString n: (self pointerForOop: obj + BaseHeaderSize) cmp: cssz) = 0]]) ifTrue:
[coInterpreter printHex: obj; space; printNum: (self lengthOf: obj); space; printOopShort: obj; cr]]!
Item was changed:
----- Method: SpurMemoryManager>>firstFixedFieldOfMaybeImmediate: (in category 'debug support') -----
firstFixedFieldOfMaybeImmediate: oop
"for the message send breakpoint; selectors can be immediates."
<inline: false>
^(self isImmediate: oop)
ifTrue: [oop asVoidPointer]
ifFalse: [self firstFixedField: oop]!
Item was added:
+ ----- Method: SpurMemoryManager>>firstIndexableField: (in category 'object format') -----
+ firstIndexableField: objOop
+ "NOTE: overridden in various simulator subclasses 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 weakArrayFormat ifTrue:
+ [fmt = self arrayFormat ifTrue: "array starts at 0."
+ [^self pointerForOop: objOop + self baseHeaderSize].
+ fmt >= self indexablePointersFormat ifTrue: "indexable with inst vars; need to delve into the class format word"
+ [classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
+ ^self pointerForOop: objOop
+ + self baseHeaderSize
+ + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord)].
+ "otherwise not indexable"
+ ^0].
+ "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
+ (fmt >= self sixtyFourBitIndexableFormat
+ and: [fmt < self firstCompiledMethodFormat]) ifTrue:
+ [^self pointerForOop: objOop + self baseHeaderSize].
+ "otherwise not indexable"
+ ^0!
Item was removed:
- ----- Method: SpurMemoryManager>>firstIndexableField: (in category 'object format') -----
- firstIndexableField: objOop
- "NOTE: overridden in various simulator subclasses 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 weakArrayFormat ifTrue:
- [fmt = self arrayFormat ifTrue: "array starts at 0."
- [^self pointerForOop: objOop + self baseHeaderSize].
- fmt >= self indexablePointersFormat ifTrue: "indexable with inst vars; need to delve into the class format word"
- [classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
- ^self pointerForOop: objOop
- + self baseHeaderSize
- + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord)].
- "otherwise not indexable"
- ^0].
- "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
- (fmt >= self sixtyFourBitIndexableFormat
- and: [fmt < self firstCompiledMethodFormat]) ifTrue:
- [^self pointerForOop: objOop + self baseHeaderSize].
- "otherwise not indexable"
- ^0!
Item was changed:
----- Method: SpurMemoryManager>>floatValueOf: (in category 'simulation only') -----
floatValueOf: obj
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter floatValueOf: obj!
Item was changed:
----- Method: SpurMemoryManager>>freeSpaceCharacterisation (in category 'debug support') -----
freeSpaceCharacterisation
<doNotGenerate>
| n s |
n := 0.
s := Bag new.
self allFreeObjectsDo:
[:f| n := n + 1. s add: (self bytesInObject: f)].
^{ n. s sortedCounts. s sortedElements }!
Item was added:
+ ----- Method: SpurMemoryManager>>fullGC (in category 'gc - global') -----
+ fullGC
+ "Perform a full lazy compacting GC. Answer the size of the largest free chunk."
+ <returnTypeC: #usqLong>
+ <inline: false>
+ needGCFlag := false.
+ gcStartUsecs := self ioUTCMicrosecondsNow.
+ statMarkCount := 0.
+ coInterpreter preGCAction: GCModeFull.
+ self globalGarbageCollect.
+ coInterpreter postGCAction: GCModeFull.
+ statFullGCs := statFullGCs + 1.
+ statGCEndUsecs := self ioUTCMicrosecondsNow.
+ statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
+ ^(freeLists at: 0) ~= 0
+ ifTrue: [self bytesInObject: self findLargestFreeChunk]
+ ifFalse: [0]!
Item was removed:
- ----- Method: SpurMemoryManager>>fullGC (in category 'gc - global') -----
- fullGC
- "Perform a full lazy compacting GC. Answer the size of the largest free chunk."
- <returnTypeC: #usqLong>
- <inline: false>
- needGCFlag := false.
- gcStartUsecs := self ioUTCMicrosecondsNow.
- statMarkCount := 0.
- coInterpreter preGCAction: GCModeFull.
- self globalGarbageCollect.
- coInterpreter postGCAction: GCModeFull.
- statFullGCs := statFullGCs + 1.
- statGCEndUsecs := self ioUTCMicrosecondsNow.
- statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
- ^(freeLists at: 0) ~= 0
- ifTrue: [self bytesInObject: self findLargestFreeChunk]
- ifFalse: [0]!
Item was added:
+ ----- Method: SpurMemoryManager>>getThisSessionID (in category 'simulation only') -----
+ getThisSessionID
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter getThisSessionID!
Item was removed:
- ----- Method: SpurMemoryManager>>getThisSessionID (in category 'simulation only') -----
- getThisSessionID
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter getThisSessionID!
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.
+
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 added:
+ ----- Method: SpurMemoryManager>>growToAccomodateContainerWithNumSlots: (in category 'growing/shrinking memory') -----
+ growToAccomodateContainerWithNumSlots: numSlots
+ "Grow memory to accomodate a container (an Array) with numSlots.
+ Grow by at least the growHeadroom. Supports allInstancesOf: and allObjects."
+ | delta |
+ delta := self baseHeaderSize * 2 + (numSlots * self bytesPerOop).
+ self growOldSpaceByAtLeast: (growHeadroom max: delta)!
Item was changed:
----- Method: SpurMemoryManager>>heapMap (in category 'debug support') -----
heapMap
^heapMap!
Item was removed:
- ----- Method: SpurMemoryManager>>incrementalGC (in category 'gc - global') -----
- incrementalGC
- self shouldNotImplement!
Item was added:
+ ----- Method: SpurMemoryManager>>incrementalGC (in category 'gc - global') -----
+ incrementalGC
+ self shouldNotImplement!
Item was changed:
----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
initializeObjectMemory: bytesToShift
"Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks."
"Assume: image reader initializes the following variables:
memory
memoryLimit
specialObjectsOop
lastHash
"
<inline: false>
| freeListObj |
"Catch mis-initializations leading to bad translations to C"
self assert: BaseHeaderSize = self baseHeaderSize.
self bootstrapping ifFalse:
[self
initSegmentBridgeWithBytes: self bridgeSize
at: endOfMemory - self bridgeSize].
segmentManager adjustSegmentSwizzlesBy: bytesToShift.
"image may be at a different address; adjust oops for new location"
self adjustAllOopsBy: bytesToShift.
specialObjectsOop := segmentManager swizzleObj: specialObjectsOop.
"heavily used special objects"
nilObj := self splObj: NilObject.
falseObj := self splObj: FalseObject.
trueObj := self splObj: TrueObject.
"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
conditional branch code as a result). In addition, Spur places the free lists and
class table root page immediately following them."
self assert: nilObj = oldSpaceStart.
self assert: falseObj = (self objectAfter: nilObj).
self assert: trueObj = (self objectAfter: falseObj).
freeListObj := self objectAfter: trueObj.
self reInitializeClassTablePostLoad: (self objectAfter: freeListObj).
markStack := self swizzleObjStackAt: MarkStackRootIndex.
weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex.
ephemeronQueue := self swizzleObjStackAt: EphemeronQueueRootIndex.
self assert: self validObjStacks.
+ self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self initializeFreeSpacePostLoad: freeListObj.
segmentManager collapseSegmentsPostSwizzle.
self computeFreeSpacePostSwizzle.
self bootstrapping ifFalse:
[self initializeNewSpaceVariables].
self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
segmentManager checkSegments.
"These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi."
growHeadroom := 16*1024*1024. "headroom when growing"
shrinkThreshold := 32*1024*1024. "free space before shrinking"!
Item was changed:
----- Method: SpurMemoryManager>>instanceSizeOf: (in category 'interpreter access') -----
instanceSizeOf: classObj
<api>
"Answer the number of slots in a class. For example the instanceSizeOf:
ClassPoint is 2, for the x & y slots. The instance size of non-pointer classes is 0."
self assert: (coInterpreter addressCouldBeClassObj: classObj).
^(self formatOfClass: classObj) bitAnd: self fixedFieldsOfClassFormatMask!
Item was removed:
- ----- Method: SpurMemoryManager>>ioLoadFunction:From: (in category 'simulation only') -----
- ioLoadFunction: functionName From: moduleName
- "hack around the CoInterpreter/ObjectMemory split refactoring.
- provide accurate types for the VMPluginCodeGenerator."
- <doNotGenerate>
- <returnTypeC: #'void *'>
- <var: #functionName type: #'char *'>
- <var: #moduleName type: #'char *'>
- ^coInterpreter ioLoadFunction: functionName From: moduleName!
Item was added:
+ ----- Method: SpurMemoryManager>>ioLoadFunction:From: (in category 'simulation only') -----
+ ioLoadFunction: functionName From: moduleName
+ "hack around the CoInterpreter/ObjectMemory split refactoring.
+ provide accurate types for the VMPluginCodeGenerator."
+ <doNotGenerate>
+ <returnTypeC: #'void *'>
+ <var: #functionName type: #'char *'>
+ <var: #moduleName type: #'char *'>
+ ^coInterpreter ioLoadFunction: functionName From: moduleName!
Item was changed:
----- Method: SpurMemoryManager>>ioLoadModule:OfLength: (in category 'simulation only') -----
ioLoadModule: moduleNameIndex OfLength: moduleLength
<doNotGenerate>
<returnTypeC: #'void *'>
"Dummy - provided by support code"
^0!
Item was removed:
- ----- Method: SpurMemoryManager>>ioUTCMicrosecondsNow (in category 'simulation only') -----
- ioUTCMicrosecondsNow
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter ioUTCMicrosecondsNow!
Item was added:
+ ----- Method: SpurMemoryManager>>ioUTCMicrosecondsNow (in category 'simulation only') -----
+ ioUTCMicrosecondsNow
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter ioUTCMicrosecondsNow!
Item was removed:
- ----- Method: SpurMemoryManager>>is:KindOf: (in category 'simulation only') -----
- is: oop KindOf: classNameString
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter is: oop KindOf: classNameString!
Item was added:
+ ----- Method: SpurMemoryManager>>is:KindOf: (in category 'simulation only') -----
+ is: oop KindOf: classNameString
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter is: oop KindOf: classNameString!
Item was changed:
----- Method: SpurMemoryManager>>isEnumerableObjectNoAssert: (in category 'object enumeration') -----
isEnumerableObjectNoAssert: objOop
"Answer if objOop should be included in an allObjects...Do: enumeration.
+ This is for assert-checking only."
+ | classIndex |
+ classIndex := self classIndexOf: objOop.
+ ^classIndex >= self isForwardedObjectClassIndexPun
+ and: [classIndex < (numClassTablePages * self classTablePageSize)]!
- Non-objects should be excluded; these are bridges and free chunks."
- ^(self classIndexOf: objOop) >= self isForwardedObjectClassIndexPun!
Item was changed:
----- Method: SpurMemoryManager>>isFloatObject: (in category 'simulation only') -----
isFloatObject: oop
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter isFloatObject: oop!
Item was changed:
----- Method: SpurMemoryManager>>isHiddenObj: (in category 'debug support') -----
isHiddenObj: objOop
^objOop = self freeListsObject
or: [(self numSlotsOfAny: objOop) = ObjStackPageSlots
and: [self isValidObjStackPage: objOop myIndex: (self fetchPointer: ObjStackMyx ofObject: objOop)]]!
Item was changed:
----- Method: SpurMemoryManager>>isIntegerValue: (in category 'interpreter access') -----
isIntegerValue: intValue
"Answer if the given value can be represented as a Smalltalk integer value."
^self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>leakCheckBecome (in category 'debug support') -----
leakCheckBecome
<api>
^(checkForLeaks bitAnd: 4) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>leakCheckFullGC (in category 'debug support') -----
leakCheckFullGC
<api>
^(checkForLeaks bitAnd: 1) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>leakCheckIncrementalGC (in category 'debug support') -----
leakCheckIncrementalGC
<api>
^(checkForLeaks bitAnd: 8) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>leakCheckNewSpaceGC (in category 'debug support') -----
leakCheckNewSpaceGC
<api>
^(checkForLeaks bitAnd: 2) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>lengthOfMaybeImmediate: (in category 'debug support') -----
lengthOfMaybeImmediate: oop
"for the message send breakpoint; selectors can be immediates."
<inline: false>
(self isImmediate: oop) ifTrue: [^0].
^self lengthOf: oop!
Item was changed:
----- Method: SpurMemoryManager>>lookupAddress: (in category 'simulation only') -----
lookupAddress: address
"If address appears to be that of a Symbol or a few well-known objects (such as classes) answer it, otherwise answer nil.
For code disassembly"
<doNotGenerate>
| fmt size string class classSize maybeThisClass classNameIndex thisClassIndex |
((self addressCouldBeObj: address)
and: [(self classIndexOf: address) > 0]) ifFalse:
[^address = scavengeThreshold ifTrue:
['scavengeThreshold']].
address - self baseHeaderSize = hiddenRootsObj ifTrue:
[^'(hiddenRootsObj+baseHeaderSize)'].
fmt := self formatOf: address.
size := self lengthOf: address baseHeader: (self baseHeader: address) format: fmt.
size = 0 ifTrue:
[^address caseOf: { [nilObj] -> ['nil']. [trueObj] -> ['true']. [falseObj] -> ['false'] } otherwise: []].
((fmt between: self firstByteFormat and: self firstCompiledMethodFormat - 1) "indexable byte fields"
and: [(size between: 1 and: 64)
and: [Scanner isLiteralSymbol: (string := (0 to: size - 1) collect: [:i| Character value: (self fetchByte: i ofObject: address)])]]) ifTrue:
[^'#', (ByteString withAll: string)].
class := self fetchClassOfNonImm: address.
(class isNil or: [class = nilObj]) ifTrue:
[^nil].
"address is either a class or a metaclass, or an instance of a class or invalid. determine which."
classNameIndex := coInterpreter classNameIndex.
thisClassIndex := coInterpreter thisClassIndex.
((classSize := self numSlotsOf: class) <= (classNameIndex max: thisClassIndex)
or: [classSize > 255]) ifTrue:
[^nil].
"Address could be a class or a metaclass"
(fmt = 1 and: [size >= classNameIndex]) ifTrue:
["Is address a class? If so class's thisClass is address."
(self lookupAddress: (self fetchPointer: classNameIndex ofObject: address)) ifNotNil:
[:maybeClassName|
(self fetchPointer: thisClassIndex ofObject: class) = address ifTrue:
[^maybeClassName allButFirst]].
"Is address a Metaclass? If so class's name is Metaclass and address's thisClass holds the class name"
((self isBytes: (self fetchPointer: classNameIndex ofObject: class))
and: [(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) = '#Metaclass'
and: [size >= thisClassIndex]]) ifTrue:
[maybeThisClass := self fetchPointer: thisClassIndex ofObject: address.
(self lookupAddress: (self fetchPointer: classNameIndex ofObject: maybeThisClass)) ifNotNil:
[:maybeThisClassName| ^maybeThisClassName allButFirst, ' class']]].
^(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) ifNotNil:
[:maybeClassName| 'a(n) ', maybeClassName allButFirst]!
Item was changed:
----- Method: SpurMemoryManager>>maybeSplObj: (in category 'interpreter access') -----
maybeSplObj: index
<api>
"Answer one of the objects in the SpecialObjectsArray, if in range, otherwise answer nil."
^index < (self numSlotsOf: specialObjectsOop) ifTrue:
[self fetchPointer: index ofObject: specialObjectsOop]!
Item was removed:
- ----- Method: SpurMemoryManager>>methodArgumentCount (in category 'simulation only') -----
- methodArgumentCount
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter methodArgumentCount!
Item was added:
+ ----- Method: SpurMemoryManager>>methodArgumentCount (in category 'simulation only') -----
+ methodArgumentCount
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter methodArgumentCount!
Item was changed:
----- Method: SpurMemoryManager>>methodReturnValue: (in category 'simulation only') -----
methodReturnValue: oop
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter methodReturnValue: oop!
Item was changed:
----- Method: SpurMemoryManager>>objStack:from:do: (in category 'obj stacks') -----
objStack: objStack from: start do: aBlock
"Evaluate aBlock with all elements from start (0-relative) in objStack.
Answer the size of the stack *before* the enumeration commences.
This evaluates in top-of-stack-to-bottom order. N.B. this is also stable
if aBlock causes new elements to be added to the objStack, but
unstable if aBlock causes elements to be removed."
<inline: true>
| size objStackPage numToEnumerate |
+ self assert: (self isValidObjStack: weaklingStack).
size := self fetchPointer: ObjStackTopx ofObject: objStack.
objStackPage := self fetchPointer: ObjStackNextx ofObject: objStack.
[objStackPage ~= 0] whileTrue:
[size := size + ObjStackLimit.
self assert: (self fetchPointer: ObjStackTopx ofObject: objStackPage) = ObjStackLimit.
objStackPage := self fetchPointer: ObjStackNextx ofObject: objStackPage].
numToEnumerate := size - start.
objStackPage := objStack.
[numToEnumerate > 0] whileTrue:
[| numOnThisPage numToEnumerateOnThisPage topIndex |
numOnThisPage := self fetchPointer: ObjStackTopx ofObject: objStackPage.
numToEnumerateOnThisPage := numToEnumerate min: numOnThisPage.
topIndex := numOnThisPage + ObjStackFixedSlots - 1.
topIndex
to: topIndex - numToEnumerateOnThisPage + 1
by: -1
+ do: [:i|
+ self assert: (self isWeak: (self fetchPointer: i ofObject: objStackPage)).
+ aBlock value: (self fetchPointer: i ofObject: objStackPage)].
- do: [:i| aBlock value: (self fetchPointer: i ofObject: objStackPage)].
numToEnumerate := numToEnumerate - numToEnumerateOnThisPage.
objStackPage := self fetchPointer: ObjStackNextx ofObject: objStackPage].
^size!
Item was added:
+ ----- Method: SpurMemoryManager>>objectBefore: (in category 'object enumeration') -----
+ objectBefore: objOop
+ <api>
+ | prev |
+ prev := nil.
+ (self oop: objOop isLessThan: newSpaceLimit) ifTrue:
+ [self allNewSpaceObjectsDo:
+ [:o|
+ (self oop: o isGreaterThanOrEqualTo: objOop) ifTrue:
+ [^prev].
+ prev := o].
+ ^prev].
+ self allOldSpaceObjectsDo:
+ [:o|
+ (self oop: o isGreaterThanOrEqualTo: objOop) ifTrue:
+ [^prev].
+ prev := o].
+ ^prev!
Item was removed:
- ----- Method: SpurMemoryManager>>objectBefore: (in category 'object enumeration') -----
- objectBefore: objOop
- <api>
- | prev |
- prev := nil.
- (self oop: objOop isLessThan: newSpaceLimit) ifTrue:
- [self allNewSpaceObjectsDo:
- [:o|
- (self oop: o isGreaterThanOrEqualTo: objOop) ifTrue:
- [^prev].
- prev := o].
- ^prev].
- self allOldSpaceObjectsDo:
- [:o|
- (self oop: o isGreaterThanOrEqualTo: objOop) ifTrue:
- [^prev].
- prev := o].
- ^prev!
Item was changed:
----- Method: SpurMemoryManager>>okayOop: (in category 'debug support') -----
okayOop: signedOop
"Verify that the given oop is legitimate. Check address, header, and size but not class."
| oop classIndex fmt unusedBits unusedBitsInYoungObjects |
<var: #oop type: #usqInt>
<var: #unusedBits type: #usqLong>
oop := self cCoerce: signedOop to: #usqInt.
"address and size checks"
(self isImmediate: oop) ifTrue: [^true].
(self addressCouldBeObj: oop) ifFalse:
[self error: 'oop is not a valid address'. ^false].
(self oop: (self addressAfter: oop) isLessThanOrEqualTo: endOfMemory) ifFalse:
[self error: 'oop size would make it extend beyond the end of memory'. ^false].
"header type checks"
(classIndex := self classIndexOf: oop) >= self firstClassIndexPun ifFalse:
[self error: 'oop is a free chunk, or bridge, not an object'. ^false].
((self rawNumSlotsOf: oop) = self numSlotsMask
and: [(self rawNumSlotsOf: oop - self baseHeaderSize) ~= self numSlotsMask]) ifTrue:
[self error: 'oop header has overflow header word, but overflow word does not have a saturated numSlots field'. ^false].
"format check"
fmt := self formatOf: oop.
(fmt = 6) | (fmt = 8) ifTrue:
[self error: 'oop has an unknown format type'. ^false].
(fmt = self forwardedFormat) ~= (classIndex = self isForwardedObjectClassIndexPun) ifTrue:
[self error: 'oop has mis-matched format/classIndex fields; only one of them is the isForwarded value'. ^false].
"specific header bit checks"
unusedBits := (1 << self classIndexFieldWidth)
| (1 << (self identityHashFieldWidth + 32)).
((self longLongAt: oop) bitAnd: unusedBits) ~= 0 ifTrue:
[self error: 'some unused header bits are set; should be zero'. ^false].
unusedBitsInYoungObjects := (1 << self greyBitShift)
| (1 << self pinnedBitShift)
| (1 << self rememberedBitShift).
((self longAt: oop) bitAnd: unusedBitsInYoungObjects) ~= 0 ifTrue:
[self error: 'some header bits unused in young objects are set; should be zero'. ^false].
^true
!
Item was changed:
----- Method: SpurMemoryManager>>pop: (in category 'simulation only') -----
pop: nItems
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter pop: nItems!
Item was removed:
- ----- Method: SpurMemoryManager>>pop:thenPush: (in category 'simulation only') -----
- pop: nItems thenPush: oop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter pop: nItems thenPush: oop!
Item was added:
+ ----- Method: SpurMemoryManager>>pop:thenPush: (in category 'simulation only') -----
+ pop: nItems thenPush: oop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter pop: nItems thenPush: oop!
Item was changed:
----- Method: SpurMemoryManager>>popObjStack: (in category 'obj stacks') -----
popObjStack: objStack
| topx top nextPage myx |
self assert: (self isValidObjStack: objStack).
topx := self fetchPointer: ObjStackTopx ofObject: objStack.
topx = 0 ifTrue:
[self assert: (self fetchPointer: ObjStackNextx ofObject: objStack) = 0.
self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
inSmalltalk:
[(self fetchPointer: ObjStackMyx ofObject: objStack) = MarkStackRootIndex ifTrue:
[MarkStackRecord ifNotNil:
[MarkStackRecord addLast: {#EMPTY. nil}]]].
^nil].
topx := topx - 1.
top := self fetchPointer: topx + ObjStackFixedSlots ofObject: objStack.
self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
inSmalltalk:
[(self fetchPointer: ObjStackMyx ofObject: objStack) = MarkStackRootIndex ifTrue:
[MarkStackRecord ifNotNil:
[(MarkStackRecord last first = #push and: [MarkStackRecord last last = top])
ifTrue: [MarkStackRecord removeLast]
ifFalse: [MarkStackRecord addLast: {#pop. top}]]]].
self storePointer: ObjStackTopx ofObject: objStack withValue: topx.
(topx = 0
+ and: [(nextPage := self fetchPointer: ObjStackNextx ofObject: objStack) ~= 0])
+ ifTrue:
+ [self storePointer: ObjStackFreex ofObjStack: nextPage withValue: objStack.
+ self storePointer: ObjStackNextx ofObjStack: objStack withValue: 0.
+ myx := self fetchPointer: ObjStackMyx ofObject: objStack.
+ self updateRootOfObjStackAt: myx with: nextPage.
+ self assert: (self isValidObjStack: nextPage)]
+ ifFalse:
+ [self assert: (self isValidObjStack: objStack)].
- and: [(nextPage := self fetchPointer: ObjStackNextx ofObject: objStack) ~= 0]) ifTrue:
- [self storePointer: ObjStackFreex ofObjStack: nextPage withValue: objStack.
- self storePointer: ObjStackNextx ofObjStack: objStack withValue: 0.
- myx := self fetchPointer: ObjStackMyx ofObject: objStack.
- self updateRootOfObjStackAt: myx with: nextPage].
- self assert: (self isValidObjStack: objStack).
^top!
Item was changed:
----- Method: SpurMemoryManager>>popRemappableOop (in category 'interpreter access') -----
popRemappableOop
"Pop and return the possibly remapped object from the remap buffer.
We support this excessence for compatibility with ObjectMemory.
Spur doesn't GC during allocation."
<api>
| oop |
oop := remapBuffer at: remapBufferCount.
remapBufferCount := remapBufferCount - 1.
^oop!
Item was added:
+ ----- Method: SpurMemoryManager>>positive32BitIntegerFor: (in category 'simulation only') -----
+ positive32BitIntegerFor: integerValue
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter positive32BitIntegerFor: integerValue!
Item was removed:
- ----- Method: SpurMemoryManager>>positive32BitIntegerFor: (in category 'simulation only') -----
- positive32BitIntegerFor: integerValue
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter positive32BitIntegerFor: integerValue!
Item was added:
+ ----- Method: SpurMemoryManager>>positive32BitValueOf: (in category 'simulation only') -----
+ positive32BitValueOf: oop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter positive32BitValueOf: oop!
Item was removed:
- ----- Method: SpurMemoryManager>>positive32BitValueOf: (in category 'simulation only') -----
- positive32BitValueOf: oop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter positive32BitValueOf: oop!
Item was removed:
- ----- Method: SpurMemoryManager>>positive64BitIntegerFor: (in category 'simulation only') -----
- positive64BitIntegerFor: integerValue
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter positive64BitIntegerFor: integerValue!
Item was added:
+ ----- Method: SpurMemoryManager>>positive64BitIntegerFor: (in category 'simulation only') -----
+ positive64BitIntegerFor: integerValue
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter positive64BitIntegerFor: integerValue!
Item was changed:
----- Method: SpurMemoryManager>>positive64BitValueOf: (in category 'simulation only') -----
positive64BitValueOf: oop
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter positive64BitValueOf: oop!
Item was changed:
----- Method: SpurMemoryManager>>primitiveFail (in category 'simulation only') -----
primitiveFail
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter primitiveFail!
Item was changed:
----- Method: SpurMemoryManager>>primitiveFailFor: (in category 'simulation only') -----
primitiveFailFor: reasonCode
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter primitiveFailFor: reasonCode!
Item was removed:
- ----- Method: SpurMemoryManager>>primitiveFailureCode (in category 'simulation only') -----
- primitiveFailureCode
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter primitiveFailureCode!
Item was added:
+ ----- Method: SpurMemoryManager>>primitiveFailureCode (in category 'simulation only') -----
+ primitiveFailureCode
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter primitiveFailureCode!
Item was changed:
----- Method: SpurMemoryManager>>printAdjacentFreeChunks (in category 'debug support') -----
printAdjacentFreeChunks
"self printAdjacentFreeChunks"
<doNotGenerate>
| uncoalesced |
uncoalesced := OrderedCollection new.
self allOldSpaceEntitiesDo:
[:e| | s |
((self isFreeObject: e)
and: [(s := self objectAfter: e limit: endOfMemory) < endOfMemory
and: [self isFreeObject: s]]) ifTrue:
[uncoalesced addLast: e]].
uncoalesced do:
[:f|
self printFreeChunk: f. coInterpreter printHexnp: (self objectAfter: f limit: endOfMemory); cr]
!
Item was changed:
----- Method: SpurMemoryManager>>push: (in category 'simulation only') -----
push: oop
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter push: oop!
Item was changed:
----- Method: SpurMemoryManager>>pushBool: (in category 'simulation only') -----
pushBool: trueOrFalse
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter pushBool: trueOrFalse!
Item was removed:
- ----- Method: SpurMemoryManager>>pushFloat: (in category 'simulation only') -----
- pushFloat: f
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter pushFloat: f!
Item was added:
+ ----- Method: SpurMemoryManager>>pushFloat: (in category 'simulation only') -----
+ pushFloat: f
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter pushFloat: f!
Item was added:
+ ----- Method: SpurMemoryManager>>pushInteger: (in category 'simulation only') -----
+ pushInteger: integerValue
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter pushInteger: integerValue!
Item was removed:
- ----- Method: SpurMemoryManager>>pushInteger: (in category 'simulation only') -----
- pushInteger: integerValue
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter pushInteger: integerValue!
Item was changed:
----- Method: SpurMemoryManager>>pushRemappableOop: (in category 'interpreter access') -----
pushRemappableOop: oop
"Record the given object in a the remap buffer. Objects in this buffer are remapped
when a compaction occurs. This facility is used by the interpreter to ensure that
objects in temporary variables are properly remapped.
We support this excessence for compatibility with ObjectMemory.
Spur doesn't GC during allocation."
<api>
self assert: (self addressCouldBeOop: oop).
remapBuffer at: (remapBufferCount := remapBufferCount + 1) put: oop.
remapBufferCount <= RemapBufferSize ifFalse:
[self error: 'remapBuffer overflow']!
Item was changed:
----- Method: SpurMemoryManager>>remapBuffer (in category 'interpreter access') -----
remapBuffer
"We support this excessence for compatibility with ObjectMemory.
Spur doesn't GC during allocation."
^remapBuffer!
Item was changed:
----- Method: SpurMemoryManager>>runLeakCheckerForFullGC: (in category 'debug support') -----
runLeakCheckerForFullGC: fullGCFlag
^self runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: false!
Item was changed:
----- 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>>showDisplayBits:Left:Top:Right:Bottom: (in category 'simulation only') -----
+ showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter showDisplayBits: aForm Left: l Top: t Right: r Bottom: b!
Item was removed:
- ----- Method: SpurMemoryManager>>showDisplayBits:Left:Top:Right:Bottom: (in category 'simulation only') -----
- showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter showDisplayBits: aForm Left: l Top: t Right: r Bottom: b!
Item was removed:
- ----- Method: SpurMemoryManager>>signed32BitIntegerFor: (in category 'simulation only') -----
- signed32BitIntegerFor: integerValue
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter signed32BitIntegerFor: integerValue!
Item was added:
+ ----- Method: SpurMemoryManager>>signed32BitIntegerFor: (in category 'simulation only') -----
+ signed32BitIntegerFor: integerValue
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter signed32BitIntegerFor: integerValue!
Item was added:
+ ----- Method: SpurMemoryManager>>signed32BitValueOf: (in category 'simulation only') -----
+ signed32BitValueOf: oop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter signed32BitValueOf: oop!
Item was removed:
- ----- Method: SpurMemoryManager>>signed32BitValueOf: (in category 'simulation only') -----
- signed32BitValueOf: oop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter signed32BitValueOf: oop!
Item was changed:
----- Method: SpurMemoryManager>>splObj: (in category 'interpreter access') -----
splObj: index
<api>
<inline: true>
"Return one of the objects in the specialObjectsArray"
^self fetchPointer: index ofObject: specialObjectsOop!
Item was changed:
----- Method: SpurMemoryManager>>splObj:put: (in category 'interpreter access') -----
splObj: index put: anObject
"Set one of the objects in the SpecialObjectsArray"
self storePointer: index ofObject: specialObjectsOop withValue: anObject!
Item was changed:
----- Method: SpurMemoryManager>>sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto: (in category 'simulation only') -----
sqAllocateMemorySegmentOfSize: segmentSize Above: minAddress AllocatedSizeInto: allocSizePtrOrBlock
<doNotGenerate>
"Simulate heap growth by growing memory by segmentSize + a delta.
To test bridges alternate the delta between 0 bytes and 1M bytes
depending on the number of segments.
The delta will be the distance between segments to be bridged."
| delta newMemory start |
delta := segmentManager numSegments odd ifTrue: [1024 * 1024] ifFalse: [0].
start := memory size * 4 + delta.
newMemory := memory class new: memory size + (segmentSize + delta / 4).
newMemory replaceFrom: 1 to: memory size with: memory startingAt: 1.
memory := newMemory.
allocSizePtrOrBlock value: segmentSize.
^start!
Item was removed:
- ----- Method: SpurMemoryManager>>stObject:at:put: (in category 'simulation only') -----
- stObject: objOop at: indexOop put: valueOop
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter stObject: objOop at: indexOop put: valueOop!
Item was added:
+ ----- Method: SpurMemoryManager>>stObject:at:put: (in category 'simulation only') -----
+ stObject: objOop at: indexOop put: valueOop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter stObject: objOop at: indexOop put: valueOop!
Item was changed:
----- Method: SpurMemoryManager>>stackFloatValue: (in category 'simulation only') -----
stackFloatValue: offset
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter stackFloatValue: offset!
Item was added:
+ ----- Method: SpurMemoryManager>>stackIntegerValue: (in category 'simulation only') -----
+ stackIntegerValue: offset
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter stackIntegerValue: offset!
Item was removed:
- ----- Method: SpurMemoryManager>>stackIntegerValue: (in category 'simulation only') -----
- stackIntegerValue: offset
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter stackIntegerValue: offset!
Item was changed:
----- Method: SpurMemoryManager>>stackObjectValue: (in category 'simulation only') -----
stackObjectValue: offset
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter stackObjectValue: offset!
Item was added:
+ ----- Method: SpurMemoryManager>>stackValue: (in category 'simulation only') -----
+ stackValue: offset
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter stackValue: offset!
Item was removed:
- ----- Method: SpurMemoryManager>>stackValue: (in category 'simulation only') -----
- stackValue: offset
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter stackValue: offset!
Item was changed:
----- Method: SpurMemoryManager>>storeInteger:ofObject:withValue: (in category 'simulation only') -----
storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue!
Item was removed:
- ----- Method: SpurMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') -----
- storePointerUnchecked: fieldIndex ofObject: objOop withValue: valuePointer
- <api>
- self assert: (self isForwarded: objOop) not.
- ^self
- longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
- put: valuePointer!
Item was added:
+ ----- Method: SpurMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') -----
+ storePointerUnchecked: fieldIndex ofObject: objOop withValue: valuePointer
+ <api>
+ self assert: (self isForwarded: objOop) not.
+ ^self
+ longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
+ put: valuePointer!
Item was changed:
----- Method: SpurMemoryManager>>stringOf: (in category 'simulation only') -----
stringOf: oop
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter stringOf: oop!
Item was changed:
----- Method: SpurMemoryManager>>success: (in category 'simulation only') -----
success: boolean
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter success: boolean!
Item was changed:
----- Method: SpurMemoryManager>>topRemappableOop (in category 'interpreter access') -----
topRemappableOop
<api>
"Answers the top of the remappable oop stack. Useful when writing loops.
We support this excessence for compatibility with ObjectMemory.
Spur doesn't GC during allocation."
^remapBuffer at: remapBufferCount!
Item was changed:
----- Method: SpurMemoryManager>>transcript (in category 'simulation only') -----
transcript
"hack around the CoInterpreter/ObjectMemory split refactoring"
<doNotGenerate>
^coInterpreter transcript!
Item was added:
+ ----- Method: SpurMemoryManager>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ <api>
+ "1 = big, 0 = little"
+ ^self cCode: [VMBIGENDIAN] inSmalltalk: [self subclassResponsibility]!
Item was removed:
- ----- Method: SpurMemoryManager>>vmEndianness (in category 'memory access') -----
- vmEndianness
- <api>
- "1 = big, 0 = little"
- ^self cCode: [VMBIGENDIAN] inSmalltalk: [self subclassResponsibility]!
Item was added:
+ ----- Method: SpurSegmentInfo>>containsPinned (in category 'accessing') -----
+ containsPinned
+ "Answer the value of containsPinned"
+
+ ^ containsPinned!
Item was removed:
- ----- Method: SpurSegmentInfo>>containsPinned (in category 'accessing') -----
- containsPinned
- "Answer the value of containsPinned"
-
- ^ containsPinned!
Item was removed:
- ----- Method: SpurSegmentInfo>>containsPinned: (in category 'accessing') -----
- containsPinned: anObject
- "Set the value of containsPinned"
-
- ^containsPinned := anObject!
Item was added:
+ ----- Method: SpurSegmentInfo>>containsPinned: (in category 'accessing') -----
+ containsPinned: anObject
+ "Set the value of containsPinned"
+
+ ^containsPinned := anObject!
Item was added:
+ ----- Method: SpurSegmentInfo>>initialize (in category 'initialization') -----
+ initialize
+ segSize := segStart := swizzle := 0.
+ containsPinned := false!
Item was removed:
- ----- Method: SpurSegmentInfo>>initialize (in category 'initialization') -----
- initialize
- segSize := segStart := swizzle := 0.
- containsPinned := false!
Item was added:
+ ----- Method: SpurSegmentInfo>>lastFreeObject (in category 'accessing') -----
+ lastFreeObject
+ "Answer the value of lastFreeObject"
+
+ ^ lastFreeObject!
Item was removed:
- ----- Method: SpurSegmentInfo>>lastFreeObject (in category 'accessing') -----
- lastFreeObject
- "Answer the value of lastFreeObject"
-
- ^ lastFreeObject!
Item was removed:
- ----- Method: SpurSegmentInfo>>lastFreeObject: (in category 'accessing') -----
- lastFreeObject: anObject
- "Set the value of lastFreeObject"
-
- ^lastFreeObject := anObject!
Item was added:
+ ----- Method: SpurSegmentInfo>>lastFreeObject: (in category 'accessing') -----
+ lastFreeObject: anObject
+ "Set the value of lastFreeObject"
+
+ ^lastFreeObject := anObject!
Item was added:
+ ----- Method: SpurSegmentInfo>>printOn: (in category 'printing') -----
+ printOn: aStream
+ <doNotGenerate>
+ super printOn: aStream.
+ (self class instVarNames copyReplaceAll: #('segSize') with: #('segSize' 'segLimit')) do:
+ [:name| | iv |
+ iv := self perform: name asSymbol.
+ aStream space; nextPutAll: name; space; print: iv.
+ (iv isInteger and: [iv ~= 0]) ifTrue:
+ [aStream nextPut: $/. iv storeOn: aStream base: 16]]!
Item was removed:
- ----- Method: SpurSegmentInfo>>printOn: (in category 'printing') -----
- printOn: aStream
- <doNotGenerate>
- super printOn: aStream.
- (self class instVarNames copyReplaceAll: #('segSize') with: #('segSize' 'segLimit')) do:
- [:name| | iv |
- iv := self perform: name asSymbol.
- aStream space; nextPutAll: name; space; print: iv.
- (iv isInteger and: [iv ~= 0]) ifTrue:
- [aStream nextPut: $/. iv storeOn: aStream base: 16]]!
Item was removed:
- ----- Method: SpurSegmentInfo>>savedSegSize (in category 'accessing') -----
- savedSegSize
- "Answer the value of savedSegSize"
-
- ^ savedSegSize!
Item was added:
+ ----- Method: SpurSegmentInfo>>savedSegSize (in category 'accessing') -----
+ savedSegSize
+ "Answer the value of savedSegSize"
+
+ ^ savedSegSize!
Item was added:
+ ----- Method: SpurSegmentInfo>>savedSegSize: (in category 'accessing') -----
+ savedSegSize: anObject
+ "Set the value of savedSegSize"
+
+ ^savedSegSize := anObject!
Item was removed:
- ----- Method: SpurSegmentInfo>>savedSegSize: (in category 'accessing') -----
- savedSegSize: anObject
- "Set the value of savedSegSize"
-
- ^savedSegSize := anObject!
Item was added:
+ ----- Method: SpurSegmentInfo>>segLimit (in category 'accessing') -----
+ segLimit
+ ^segSize + segStart!
Item was removed:
- ----- Method: SpurSegmentInfo>>segLimit (in category 'accessing') -----
- segLimit
- ^segSize + segStart!
Item was added:
+ ----- Method: SpurSegmentInfo>>segSize (in category 'accessing') -----
+ segSize
+ "Answer the value of segSize"
+
+ ^ segSize!
Item was removed:
- ----- Method: SpurSegmentInfo>>segSize (in category 'accessing') -----
- segSize
- "Answer the value of segSize"
-
- ^ segSize!
Item was added:
+ ----- Method: SpurSegmentInfo>>segSize: (in category 'accessing') -----
+ segSize: anObject
+ "Set the value of segSize"
+
+ ^segSize := anObject!
Item was removed:
- ----- Method: SpurSegmentInfo>>segSize: (in category 'accessing') -----
- segSize: anObject
- "Set the value of segSize"
-
- ^segSize := anObject!
Item was removed:
- ----- Method: SpurSegmentInfo>>segStart (in category 'accessing') -----
- segStart
- "Answer the value of segStart"
-
- ^ segStart!
Item was added:
+ ----- Method: SpurSegmentInfo>>segStart (in category 'accessing') -----
+ segStart
+ "Answer the value of segStart"
+
+ ^ segStart!
Item was added:
+ ----- Method: SpurSegmentInfo>>segStart: (in category 'accessing') -----
+ segStart: anObject
+ "Set the value of segStart"
+
+ ^segStart := anObject!
Item was removed:
- ----- Method: SpurSegmentInfo>>segStart: (in category 'accessing') -----
- segStart: anObject
- "Set the value of segStart"
-
- ^segStart := anObject!
Item was removed:
- ----- Method: SpurSegmentInfo>>swizzle (in category 'accessing') -----
- swizzle
- "Answer the value of swizzle"
-
- ^ swizzle!
Item was added:
+ ----- Method: SpurSegmentInfo>>swizzle (in category 'accessing') -----
+ swizzle
+ "Answer the value of swizzle"
+
+ ^ swizzle!
Item was added:
+ ----- Method: SpurSegmentInfo>>swizzle: (in category 'accessing') -----
+ swizzle: anObject
+ "Set the value of swizzle"
+
+ ^swizzle := anObject!
Item was removed:
- ----- Method: SpurSegmentInfo>>swizzle: (in category 'accessing') -----
- swizzle: anObject
- "Set the value of swizzle"
-
- ^swizzle := anObject!
Item was changed:
----- Method: SpurSegmentManager>>allBridgesMarked (in category 'debug support') -----
allBridgesMarked
0 to: numSegments - 1 do:
[:i| | bridgeObj |
bridgeObj := self bridgeAt: i.
self assert: (self isValidSegmentBridge: bridgeObj).
(manager isMarked: bridgeObj) ifFalse:
[^false]].
^true
"for debugging:"
"(0 to: numSegments - 1) select:
[:i| | bridgeObj |
bridgeObj := self bridgeAt: i.
self assert: (self isValidSegmentBridge: bridgeObj).
manager isMarked: bridgeObj]"!
Item was changed:
----- Method: SpurSegmentManager>>checkSegments (in category 'debug support') -----
checkSegments
self assert: numSegments >= 1.
0 to: numSegments - 1 do:
[:i|
self assert: (manager addressCouldBeObj: (segments at: i) segStart).
self assert: (self isValidSegmentBridge: (self bridgeAt: i))].
self assert: (segments at: numSegments - 1) segLimit = manager endOfMemory!
Item was changed:
----- Method: SpurSegmentManager>>initializeFromFreeChunks: (in category 'simulation only') -----
initializeFromFreeChunks: freeChunks
"For testing, create a set of segments using the freeChunks as bridges."
self assert: (freeChunks allSatisfy: [:f| manager hasOverflowHeader: f]).
numSegments := freeChunks size.
freeChunks do:
[:f|
manager initSegmentBridgeWithBytes: (manager bytesInObject: f) at: (manager startOfObject: f).
self assert: (manager isSegmentBridge: f)].
segments := (1 to: numSegments) collect:
[:i| | bridge start size |
bridge := freeChunks at: i.
start := i = 1
ifTrue: [manager newSpaceLimit]
ifFalse: [manager addressAfter: (freeChunks at: i - 1)].
size := bridge + manager baseHeaderSize - start.
SpurSegmentInfo new
segStart: start;
segSize: size;
yourself].
manager setEndOfMemory: segments last segLimit.
segments := CArrayAccessor on: segments.
freeChunks with: segments object do:
[:bridge :segment|
self assert: (self isValidSegmentBridge: bridge).
self assert: bridge = (self bridgeFor: segment)]!
Item was changed:
----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)
Item was added:
+ ----- Method: StackInterpreter>>ioLocalMicrosecondsNow (in category 'primitive support') -----
+ ioLocalMicrosecondsNow
+ <doNotGenerate>
+ ^self ioUTCMicrosecondsNow + (1000000 * DateAndTime localOffset asSeconds)!
Item was added:
+ ----- Method: StackInterpreter>>ioLocalSecondsOffset (in category 'primitive support') -----
+ ioLocalSecondsOffset
+ "simulation-only implementation"
+ <doNotGenerate>
+ ^DateAndTime localOffset asSeconds!
Item was added:
+ ----- Method: StackInterpreter>>ioSeconds (in category 'primitive support') -----
+ ioSeconds
+ "simulation-only implementation"
+ <doNotGenerate>
+ ^self ioLocalMicroseconds // 1000000!
Item was added:
+ ----- Method: StackInterpreter>>ioSecondsNow (in category 'primitive support') -----
+ ioSecondsNow
+ "simulation-only implementation"
+ <doNotGenerate>
+ ^self ioLocalMicrosecondsNow // 1000000!
Item was added:
+ ----- Method: StackInterpreter>>ioSetHeartbeatMilliseconds: (in category 'primitive support') -----
+ ioSetHeartbeatMilliseconds: ignored
+ "simulation-only implementation"
+ <doNotGenerate>!
Item was added:
+ ----- Method: StackInterpreter>>ioUTCMicrosecondsNow (in category 'primitive support') -----
+ ioUTCMicrosecondsNow
+ "simulation-only implementation"
+ <doNotGenerate>
+ ^self ioUTCMicroseconds!
Item was removed:
- ----- Method: StackInterpreterSimulator>>ioLocalSecondsOffset (in category 'I/O primitives support') -----
- ioLocalSecondsOffset
- ^DateAndTime localOffset asSeconds!
Item was removed:
- ----- Method: StackInterpreterSimulator>>ioSeconds (in category 'I/O primitives support') -----
- ioSeconds
- "Return the value of the second clock."
-
- ^ Time primSecondsClock!
Item was removed:
- ----- Method: StackInterpreterSimulator>>ioSetHeartbeatMilliseconds: (in category 'I/O primitives support') -----
- ioSetHeartbeatMilliseconds: ignored!
Item was removed:
- ----- Method: StackInterpreterSimulator>>ioUTCMicrosecondsNow (in category 'I/O primitives support') -----
- ioUTCMicrosecondsNow
- ^self ioUTCMicroseconds!
Item was changed:
----- Method: StackToRegisterMappingCogit>>bytecodeFixupClass (in category 'simulation only') -----
bytecodeFixupClass
<doNotGenerate>
^CogSSBytecodeFixup!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ceEnter0ArgsPIC (in category 'simulation only') -----
ceEnter0ArgsPIC
<api: 'extern void (*ceEnter0ArgsPIC)()'>
<doNotGenerate>
self simulateEnilopmart: ceEnter0ArgsPIC numArgs: 1!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ceEnter1ArgsPIC (in category 'simulation only') -----
ceEnter1ArgsPIC
<api: 'extern void (*ceEnter1ArgsPIC)()'>
<doNotGenerate>
self simulateEnilopmart: ceEnter1ArgsPIC numArgs: 1!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ceEnter2ArgsPIC (in category 'simulation only') -----
ceEnter2ArgsPIC
<api: 'extern void (*ceEnter2ArgsPIC)()'>
<doNotGenerate>
self simulateEnilopmart: ceEnter2ArgsPIC numArgs: 1!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ceEnterCogCodePopReceiverArg0Regs (in category 'simulation only') -----
ceEnterCogCodePopReceiverArg0Regs
<api: 'extern void (*ceEnterCogCodePopReceiverArg0Regs)()'>
<doNotGenerate>
self simulateEnilopmart: ceEnterCogCodePopReceiverArg0Regs numArgs: 2!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ceEnterCogCodePopReceiverArg1Arg0Regs (in category 'simulation only') -----
ceEnterCogCodePopReceiverArg1Arg0Regs
<api: 'extern void (*ceEnterCogCodePopReceiverArg1Arg0Regs)()'>
<doNotGenerate>
self simulateEnilopmart: ceEnterCogCodePopReceiverArg1Arg0Regs numArgs: 3!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ceShortCutTraceStore: (in category 'simulation only') -----
ceShortCutTraceStore: aProcessorSimulationTrap
<doNotGenerate>
self shortcutTrampoline: aProcessorSimulationTrap
to: [coInterpreter
ceTraceStoreOf: (processor registerAt: (backEnd concreteRegister: TempReg))
into: (processor registerAt: (backEnd concreteRegister: ReceiverResultReg))]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>debugStackPointerFor: (in category 'simulation only') -----
debugStackPointerFor: bcpc
<doNotGenerate>
^(debugStackPointers at: bcpc) - (needsFrame ifTrue: [1] ifFalse: [0])!
Item was changed:
----- Method: StackToRegisterMappingCogit>>printSimStack (in category 'simulation only') -----
printSimStack
<doNotGenerate>
coInterpreter transcript ensureCr.
simStackPtr < 0 ifTrue:
[^coInterpreter transcript nextPutAll: 'simStackEmpty'; cr; flush].
0 to: simStackPtr do:
[:i|
coInterpreter transcript print: i.
i = simSpillBase
ifTrue: [coInterpreter transcript nextPutAll: ' sb'; tab]
ifFalse: [coInterpreter transcript tab; tab].
(simStack at: i) printStateOn: coInterpreter transcript.
coInterpreter transcript cr; flush]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>traceDescriptor: (in category 'simulation only') -----
traceDescriptor: descriptor
<cmacro: '(ign) 0'>
(compilationTrace anyMask: 2) ifTrue:
[coInterpreter transcript cr; print: bytecodePC; space; nextPutAll: descriptor generator; flush]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>traceFixup: (in category 'simulation only') -----
traceFixup: fixup
<cmacro: '(ign) 0'>
| index |
(compilationTrace anyMask: 8) ifTrue:
[index := (fixups object identityIndexOf: fixup) - 1.
coInterpreter transcript
ensureCr;
print: bytecodePC; nextPutAll: ' -> '; print: index; nextPut: $/; print: index + initialPC;
nextPut: $:; space.
fixup printStateOn: coInterpreter transcript.
coInterpreter transcript cr; flush]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>traceMerge: (in category 'simulation only') -----
traceMerge: fixup
<cmacro: '(ign) 0'>
| index |
(compilationTrace anyMask: 4) ifTrue:
[index := (fixups object identityIndexOf: fixup) - 1.
coInterpreter transcript
ensureCr;
print: index; nextPut: $/; print: index + initialPC;
nextPut: $:; space.
fixup printStateOn: coInterpreter transcript.
coInterpreter transcript cr; flush]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>traceSimStack (in category 'simulation only') -----
traceSimStack
<cmacro: '() 0'>
(compilationTrace anyMask: 1) ifTrue:
[self printSimStack]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>traceSpill: (in category 'simulation only') -----
traceSpill: simStackEntry
<cmacro: '(ign) 0'>
(compilationTrace anyMask: 2) ifTrue:
[coInterpreter transcript cr; print: bytecodePC; space; print: simStackEntry; flush]!
Item was removed:
- ----- Method: ThreadedFFICalloutState class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ThreadedFFICalloutState struct."
-
- self instVarNames do:
- [:ivn|
- aBinaryBlock
- value: ivn
- value: (ivn caseOf: {
- ['argVector'] -> [#'char *'].
- ['currentArg'] -> [#'char *'].
- ['limit'] -> [#'char *'].
- ['ffiArgSpec'] -> [#'void *'].
- ['stringArgs'] -> [{#'char *'. '[', ThreadedFFIPlugin maxNumArgs printString, ']'}] }
- otherwise:
- [#sqInt])]!
Item was added:
+ ----- Method: ThreadedFFICalloutState class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ThreadedFFICalloutState struct."
+
+ self instVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn caseOf: {
+ ['argVector'] -> [#'char *'].
+ ['currentArg'] -> [#'char *'].
+ ['limit'] -> [#'char *'].
+ ['ffiArgSpec'] -> [#'void *'].
+ ['stringArgs'] -> [{#'char *'. '[', ThreadedFFIPlugin maxNumArgs printString, ']'}] }
+ otherwise:
+ [#sqInt])]!
Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ReentrantFFICalloutState struct."
+
+ superclass instVarNamesAndTypesForTranslationDo: aBinaryBlock.
+ self instVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn caseOf: {
+ ['integerRegisters'] -> [{#sqInt. '[', ThreadedARMFFIPlugin numRegArgs printString, ']'}] }
+ otherwise:
+ [#sqInt])]!
Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ReentrantFFICalloutState struct."
-
- superclass instVarNamesAndTypesForTranslationDo: aBinaryBlock.
- self instVarNames do:
- [:ivn|
- aBinaryBlock
- value: ivn
- value: (ivn caseOf: {
- ['integerRegisters'] -> [{#sqInt. '[', ThreadedARMFFIPlugin numRegArgs printString, ']'}] }
- otherwise:
- [#sqInt])]!
Item was removed:
- ----- Method: ThreadedFFICalloutStateForPPC class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ReentrantFFICalloutState struct."
-
- superclass instVarNamesAndTypesForTranslationDo: aBinaryBlock.
- self instVarNames do:
- [:ivn|
- aBinaryBlock
- value: ivn
- value: (ivn caseOf: {
- ['integerRegisters'] -> [{#sqInt. '[', ThreadedPPCBEFFIPlugin numRegArgs printString, ']'}].
- ['floatRegisters'] -> [{#double. '[', ThreadedPPCBEFFIPlugin numRegArgs printString, ']'}] }
- otherwise:
- [#sqInt])]!
Item was added:
+ ----- Method: ThreadedFFICalloutStateForPPC class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ReentrantFFICalloutState struct."
+
+ superclass instVarNamesAndTypesForTranslationDo: aBinaryBlock.
+ self instVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn caseOf: {
+ ['integerRegisters'] -> [{#sqInt. '[', ThreadedPPCBEFFIPlugin numRegArgs printString, ']'}].
+ ['floatRegisters'] -> [{#double. '[', ThreadedPPCBEFFIPlugin numRegArgs printString, ']'}] }
+ otherwise:
+ [#sqInt])]!
Item was removed:
- ----- Method: VMCallbackReturnValue class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "Define a CallbackContext, the argument to sendInvokeCallbackContext:
- self typedef"
-
- | rvsType |
- VMCallbackContext instVarNamesAndTypesForTranslationDo:
- [:ivname :type| ivname = 'rvs' ifTrue: [rvsType := type]].
- self instVarNames do:
- [:ivn|
- aBinaryBlock
- value: ivn
- value: (ivn = 'crvrvs'
- ifTrue: [rvsType]
- ifFalse: [#int])]!
Item was added:
+ ----- Method: VMCallbackReturnValue class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "Define a CallbackContext, the argument to sendInvokeCallbackContext:
+ self typedef"
+
+ | rvsType |
+ VMCallbackContext instVarNamesAndTypesForTranslationDo:
+ [:ivname :type| ivname = 'rvs' ifTrue: [rvsType := type]].
+ self instVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn = 'crvrvs'
+ ifTrue: [rvsType]
+ ifFalse: [#int])]!
Item was changed:
----- Method: VMClass>>assert:l: (in category 'debug support') -----
assert: aBooleanExpression l: linenum
<doNotGenerate>
^self assert: aBooleanExpression!
Item was changed:
----- Method: VMClass>>asserta: (in category 'debug support') -----
asserta: aBooleanExpression
<doNotGenerate>
| result |
(result := aBooleanExpression value) ifFalse:
[AssertionFailure signal: 'Assertion failed'].
^result!
Item was changed:
----- Method: VMClass>>asserta:l: (in category 'debug support') -----
asserta: aBooleanExpression l: linenum
<doNotGenerate>
^self asserta: aBooleanExpression!
Item was changed:
----- Method: VMClass>>fetchSingleFloatAtPointer:into: (in category 'memory access') -----
fetchSingleFloatAtPointer: pointer into: aFloat
"This gets implemented by Macros in C, where its types will also be checked.
pointer is a raw address, and aFloat is a 32-bit single precision float."
<doNotGenerate>
^self fetchSingleFloatAt: pointer into: aFloat!
Item was changed:
----- Method: VMClass>>longAtPointer: (in category 'memory access') -----
longAtPointer: pointer
"This gets implemented by Macros in C, where its types will also be checked.
pointer is a raw address, and the result is the width of a machine word."
<doNotGenerate>
^self longAt: pointer!
Item was changed:
----- Method: VMClass>>longAtPointer:put: (in category 'memory access') -----
longAtPointer: pointer put: longValue
"This gets implemented by Macros in C, where its types will also be checked.
pointer is a raw address, and longValue is the width of a machine word."
<doNotGenerate>
^self longAt: pointer put: longValue!
Item was changed:
----- Method: VMClass>>oopForPointer: (in category 'memory access') -----
oopForPointer: pointerOrSurrogate
"This gets implemented by Macros in C, where its types will also be checked.
oop is the width of a machine word, and pointer is a raw address."
<doNotGenerate>
^pointerOrSurrogate asInteger!
Item was changed:
----- Method: VMClass>>storeFloatAtPointer:from: (in category 'memory access') -----
storeFloatAtPointer: pointer from: aFloat
"This gets implemented by Macros in C, where its types will also be checked.
pointer is a raw address, and aFloat is a 64-bit double precision float."
<doNotGenerate>
^self storeFloatAt: pointer from: aFloat!
Item was changed:
----- Method: VMClass>>storeSingleFloatAtPointer:from: (in category 'memory access') -----
storeSingleFloatAtPointer: pointer from: aFloat
"This gets implemented by Macros in C, where its types will also be checked.
pointer is a raw address, and aFloat is a 32-bit single precision float."
<doNotGenerate>
^self storeSingleFloatAt: pointer from: aFloat!
Item was changed:
----- Method: VMStructType class>>alignedByteSizeOf:forClient: (in category 'simulation only') -----
alignedByteSizeOf: objectSymbolOrClass forClient: aVMClass
^objectSymbolOrClass byteSizeForSimulator: aVMClass!
Item was added:
+ ----- Method: VMStructType class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a struct of this type."
+
+ self subclassResponsibility!
Item was removed:
- ----- Method: VMStructType class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a struct of this type."
-
- self subclassResponsibility!
More information about the Vm-dev
mailing list