[Vm-dev] VM Maker: VMMaker-oscog-EstebanLorenzano.303.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Jul 31 13:19:07 UTC 2013
Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-oscog-EstebanLorenzano.303.mcz
==================== Summary ====================
Name: VMMaker-oscog-EstebanLorenzano.303
Author: EstebanLorenzano
Time: 31 July 2013, 3:17:27.253 pm
UUID: 2facc2ec-9943-43f4-b0cd-9504c874df9d
Ancestors: VMMaker-oscog-EstebanLorenzano.302, VMMaker.oscog-eem.314
- merged with Eliot's 314
=============== Diff against VMMaker-oscog-EstebanLorenzano.302 ===============
Item was changed:
----- Method: CArray>>coerceTo:sim: (in category 'converting') -----
coerceTo: cTypeString sim: interpreterSimulator
^cTypeString caseOf: {
['int'] -> [self ptrAddress].
['float *'] -> [self asCArrayAccessor asFloatAccessor].
['int *'] -> [self asCArrayAccessor asIntAccessor].
+ ['char *'] -> [self shallowCopy unitSize: 1; yourself].
['unsigned'] -> [self ptrAddress].
['sqInt'] -> [self ptrAddress].
['usqInt'] -> [self ptrAddress] }!
Item was removed:
- ----- Method: CCodeGenerator>>builtin: (in category 'utilities') -----
- builtin: sel
- "Answer true if the given selector is one of the builtin selectors."
-
- ^(self kernel: sel) or: [translationDict includesKey: sel]!
Item was changed:
----- Method: CCodeGenerator>>emitCHeaderOn: (in category 'C code generator') -----
emitCHeaderOn: aStream
"Emit the initial part of a source file on aStream, comprising the version stamp,
the global struct usage flags, the header files and preamble code."
| headerClass |
headerClass := [vmClass coreInterpreterClass]
on: MessageNotUnderstood
do: [:ex| vmClass].
aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: headerClass); cr; cr.
self emitGlobalStructFlagOn: aStream.
self addHeaderFileFirst: '"sq.h"'.
vmClass isInterpreterClass ifTrue:
[self addHeaderFile: '"sqMemoryAccess.h"'].
"Additional header files; include C library ones first."
self emitHeaderFiles: (headerFiles select: [:hdr| hdr includes: $<]) on: aStream.
"Additional header files; include squeak VM ones last"
self emitHeaderFiles: (headerFiles reject: [:hdr| hdr includes: $<]) on: aStream.
vmClass isInterpreterClass ifTrue:
+ [self maybePutPreambleFor: vmClass on: aStream].
- [aStream cr; cr; nextPutAll: vmClass preambleCCode].
aStream cr!
Item was added:
+ ----- Method: CCodeGenerator>>isBuiltinSelector: (in category 'utilities') -----
+ isBuiltinSelector: sel
+ "Answer true if the given selector is one of the builtin selectors."
+
+ ^(self isKernelSelector: sel) or: [translationDict includesKey: sel]!
Item was added:
+ ----- Method: CCodeGenerator>>isKernelSelector: (in category 'utilities') -----
+ isKernelSelector: sel
+ "Answer true if the given selector is one of the kernel selectors that are implemented as macros."
+
+ ^(#(error:
+ oopAt: oopAt:put: oopAtPointer: oopAtPointer:put:
+ byteAt: byteAt:put: byteAtPointer: byteAtPointer:put:
+ shortAt: shortAt:put: shortAtPointer: shortAtPointer:put:
+ intAt: intAt:put: intAtPointer: intAtPointer:put:
+ longAt: longAt:put: longAtPointer: longAtPointer:put:
+ fetchFloatAt:into: storeFloatAt:from:
+ fetchFloatAtPointer:into: storeFloatAtPointer:from:
+ fetchSingleFloatAt:into: storeSingleFloatAt:from:
+ fetchSingleFloatAtPointer:into: storeSingleFloatAtPointer:from:
+ pointerForOop: oopForPointer:
+ cCoerce:to: cCoerceSimple:to:)
+ includes: sel)!
Item was removed:
- ----- Method: CCodeGenerator>>kernel: (in category 'utilities') -----
- kernel: sel
- "Answer true if the given selector is one of the kernel selectors that are implemented as macros."
-
- ^(#(error:
- oopAt: oopAt:put: oopAtPointer: oopAtPointer:put:
- byteAt: byteAt:put: byteAtPointer: byteAtPointer:put:
- shortAt: shortAt:put: shortAtPointer: shortAtPointer:put:
- intAt: intAt:put: intAtPointer: intAtPointer:put:
- longAt: longAt:put: longAtPointer: longAtPointer:put:
- fetchFloatAt:into: storeFloatAt:from:
- fetchFloatAtPointer:into: storeFloatAtPointer:from:
- fetchSingleFloatAt:into: storeSingleFloatAt:from:
- fetchSingleFloatAtPointer:into: storeSingleFloatAtPointer:from:
- pointerForOop: oopForPointer:)
- includes: sel)!
Item was added:
+ ----- Method: CCodeGenerator>>maybePutPreambleFor:on: (in category 'C code generator') -----
+ maybePutPreambleFor: aClass on: aStream
+ aClass preambleCCode ifNotNil:
+ [:preamble| | actualClass |
+ actualClass := aClass class whichClassIncludesSelector: #preambleCCode.
+ aStream
+ ensureCr; cr;
+ nextPutAll: '/* '; print: actualClass; nextPutAll: '>>preambleCCode */'; cr;
+ nextPutAll: preamble; cr;
+ nextPutAll: '/* end '; print: actualClass; nextPutAll: '>>preambleCCode */'; cr]!
Item was changed:
----- Method: CCodeGenerator>>messageReceiverIsInterpreterProxy: (in category 'utilities') -----
messageReceiverIsInterpreterProxy: sendNode
^self isGeneratingPluginCode
and: [sendNode receiver isVariable
and: ['interpreterProxy' = sendNode receiver name
+ and: [(self isKernelSelector: sendNode selector) not]]]!
- and: [(self kernel: sendNode selector) not]]]!
Item was changed:
----- Method: CCodeGenerator>>removeUnneededBuiltins (in category 'public') -----
removeUnneededBuiltins
| toRemove |
toRemove := Set new: 64.
methods keysDo:
[:sel|
+ (self isBuiltinSelector: sel) ifTrue:
- (self builtin: sel) ifTrue:
[(requiredSelectors includes: sel) ifFalse:
[toRemove add: sel]]].
toRemove do:
[:sel| self removeMethodForSelector: sel]!
Item was removed:
- ----- Method: CoInterpreter>>assertValidExecutionPointe:r:s:imbar: (in category 'debug support') -----
- assertValidExecutionPointe: lip r: lifp s: lisp imbar: inInterpreter
- <var: #lip type: #usqInt>
- <var: #lifp type: #'char *'>
- <var: #lisp type: #'char *'>
- | methodField cogMethod |
- <var: #cogMethod type: #'CogMethod *'>
- self assert: stackPage = (stackPages stackPageFor: lifp).
- self assert: stackPage = stackPages mostRecentlyUsedPage.
- self deferStackLimitSmashAround: #assertValidStackLimits.
- self assert: lifp < stackPage baseAddress.
- self assert: lisp < lifp.
- self assert: lifp > lisp.
- self assert: lisp >= (stackPage realStackLimit - self stackLimitOffset).
- self assert: (lifp - lisp) < LargeContextSize.
- methodField := self frameMethodField: lifp.
- inInterpreter
- ifTrue:
- [self assert: (self isMachineCodeFrame: lifp) not.
- self assert: method = methodField.
- self cppIf: MULTIPLEBYTECODESETS
- ifTrue: [self assert: (self methodUsesAlternateBytecodeSet: method) = (bytecodeSetSelector = 256)].
- ((self asserta: methodField asUnsignedInteger > objectMemory startOfMemory)
- and: [self asserta: methodField asUnsignedInteger < objectMemory freeStart]) ifTrue:
- [lip ~= cogit ceReturnToInterpreterPC ifTrue:
- [self assert: (lip >= (methodField + (objectMemory lastPointerOf: methodField) + BaseHeaderSize - 1)
- and: [lip < (methodField + (objectMemory byteLengthOf: methodField) + BaseHeaderSize)])]].
- self assert: ((self iframeIsBlockActivation: lifp)
- or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self iframeReceiver: lifp)])]
- ifFalse:
- [self assert: (self isMachineCodeFrame: lifp).
- ((self asserta: methodField asUnsignedInteger >= cogit minCogMethodAddress)
- and: [self asserta: methodField asUnsignedInteger < cogit maxCogMethodAddress]) 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)])].
- self assert: ((self mframeIsBlockActivation: lifp)
- or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self mframeReceiver: lifp)])].
- (self isBaseFrame: lifp) ifTrue:
- [self assert: (self frameHasContext: lifp).
- self assert: (self frameContext: lifp) = (stackPages longAt: stackPage baseAddress - BytesPerWord)]!
Item was added:
+ ----- 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 savedIP |
+ <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: methodField asUnsignedInteger > objectMemory startOfMemory l: ln)
+ and: [self asserta: methodField asUnsignedInteger < objectMemory freeStart l: ln]) ifTrue:
+ [lip = cogit ceReturnToInterpreterPC
+ ifTrue:
+ [savedIP := self iframeSavedIP: lifp.
+ self assert: (savedIP >= (methodField + (objectMemory lastPointerOf: methodField) + BaseHeaderSize - 1)
+ and: [savedIP < (methodField + (objectMemory byteLengthOf: methodField) + BaseHeaderSize)])
+ l: ln]
+ ifFalse:
+ [self assert: (lip >= (methodField + (objectMemory lastPointerOf: methodField) + BaseHeaderSize - 1)
+ and: [lip < (methodField + (objectMemory byteLengthOf: methodField) + BaseHeaderSize)])
+ 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 added:
+ ----- 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 added:
+ ----- 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) + BaseHeaderSize - 1)
+ and: [theIP < (methodObj + (objectMemory byteLengthOf: methodObj) + BaseHeaderSize)])
+ 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>>ceReturnToInterpreter: (in category 'trampolines') -----
ceReturnToInterpreter: anOop
"Perform a return from a machine code frame to an interpreted frame.
The machine code has executed a return instruction when the return address
is set to ceReturnToInterpreterPC. Return the result and switch to the interpreter."
<api>
self assert: ((objectMemory isIntegerObject: anOop) or: [objectMemory addressCouldBeObj: anOop]).
self flag: 'are you really sure setStackPageAndLimit: is needed?'.
"I think you're only doing this for the markStackPageMostRecentlyUsed:
and that's probably not needed either"
self setStackPageAndLimit: stackPage.
self assert: (self isMachineCodeFrame: framePointer) not.
self setMethod: (self iframeMethod: framePointer).
self assertValidExecutionPointe: (self iframeSavedIP: framePointer)
r: framePointer
s: stackPointer
+ imbar: true
+ line: #'__LINE__'.
- imbar: true.
instructionPointer := self iframeSavedIP: framePointer.
self push: anOop.
self siglong: reenterInterpreter jmp: ReturnToInterpreter.
"NOTREACHED"
^nil!
Item was changed:
----- Method: CoInterpreter>>ceStackOverflow: (in category 'trampolines') -----
ceStackOverflow: contextSwitchIfNotNil
"If contextSwitchIfNotNil is nil we can't context switch.
contextSwitchIfNotNil is set to nil by
- the special primitiveClosureValueNoContextSwitch entry-point in block dispatch
- the stack check in methods with primitive 198.
In a normal method contextSwitchIfNotNil will be the method (see e.g.
SimpleStackBasedCogit>>compileFrameBuild). In a block it will be the
closure (see e.g. SimpleStackBasedCogit>>compileMethodBody)."
<api>
| cogMethod switched cesoRetAddr |
<var: #cogMethod type: #'CogBlockMethod *'>
cesoRetAddr := self popStack. "discard the ceStackOverflow call return address."
cogMethod := self mframeCogMethod: framePointer.
self assert: cesoRetAddr - cogit abortOffset = (self asCogHomeMethod: cogMethod) asInteger.
instructionPointer := cogMethod asInteger + cogMethod stackCheckOffset.
+ self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: false line: #'__LINE__'.
- self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: false.
method := newMethod := messageSelector := lkupClass := objectMemory nilObject.
switched := self handleStackOverflowOrEventAllowContextSwitch: contextSwitchIfNotNil ~= 0.
self returnToExecutive: false postContextSwitch: switched.
self error: 'should not be reached'
!
Item was changed:
----- Method: CoInterpreter>>commenceCogCompiledCodeCompaction (in category 'process primitive support') -----
commenceCogCompiledCodeCompaction
| startTime |
<var: #startTime type: #usqLong>
cogCompiledCodeCompactionCalledFor := false.
cogit recordEventTrace ifTrue:
[self recordTrace: TraceCodeCompaction thing: TraceCodeCompaction source: 0].
+ cogit recordPrimTrace ifTrue:
+ [self fastLogPrim: TraceCodeCompaction].
startTime := self ioUTCMicrosecondsNow.
"This can be called in a number of circumstances. The instructionPointer
may contain a native pc that must be relocated. There may already be a
pushed instructionPointer on stack. Clients ensure that instructionPointer
is 0 if it should not be pushed and/or relocated. Pushing twice is a mistake
because only the top one will be relocated."
instructionPointer ~= 0 ifTrue:
+ ["better not have already been pushed"
+ self assert: self stackTop asUnsignedInteger ~= instructionPointer.
+ self push: instructionPointer.
- [self push: instructionPointer.
self externalWriteBackHeadStackPointer].
+ self assertValidStackedInstructionPointers: #'__LINE__'.
cogit compactCogCompiledCode.
instructionPointer ~= 0 ifTrue:
[instructionPointer := self popStack.
self externalWriteBackHeadStackPointer].
+ self assertValidStackedInstructionPointers: #'__LINE__'.
statCodeCompactionCount := statCodeCompactionCount + 1.
statCodeCompactionUsecs := statCodeCompactionUsecs + (self ioUTCMicrosecondsNow - startTime).
objectMemory checkForLeaks ~= 0 ifTrue:
[objectMemory clearLeakMapAndMapAccessibleObjects.
self assert: (self checkCodeIntegrity: false)]!
Item was changed:
----- Method: CoInterpreter>>deferStackLimitSmashAround: (in category 'process primitive support') -----
deferStackLimitSmashAround: functionSymbol
"Defer smashes of the stackLimit around the call of functionSymbol (for assert checks)"
<var: #functionSymbol declareC: 'void (*functionSymbol)(void)'>
deferSmash := true.
self perform: functionSymbol.
deferSmash := false.
deferredSmash ifTrue:
[deferredSmash := false.
+ self forceInterruptCheck].
+ ^true "called from assert"!
- self forceInterruptCheck]!
Item was added:
+ ----- Method: CoInterpreter>>deferStackLimitSmashAround:with: (in category 'process primitive support') -----
+ deferStackLimitSmashAround: functionSymbol with: arg
+ "Defer smashes of the stackLimit around the call of functionSymbol (for assert checks)"
+ <var: #functionSymbol declareC: 'void (*functionSymbol)(sqInt)'>
+ deferSmash := true.
+ self sqLowLevelMFence.
+ self perform: functionSymbol with: arg.
+ deferSmash := false.
+ self sqLowLevelMFence.
+ deferredSmash ifTrue:
+ [deferredSmash := false.
+ self sqLowLevelMFence.
+ self forceInterruptCheck].
+ ^true "called from assert"!
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: [^nil].
(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[primTraceLogIndex to: PrimTraceLogSize - 1 do:
+ [:i | self printPrimLogEntryAt: i; cr]].
- [:i | objectMemory safePrintStringOf: (primTraceLog at: i); cr]].
0 to: primTraceLogIndex - 1 do:
+ [:i | self printPrimLogEntryAt: i; cr]!
- [:i | objectMemory safePrintStringOf: (primTraceLog at: i); cr]!
Item was changed:
----- Method: CoInterpreter>>enterSmalltalkExecutiveImplementation (in category 'initialization') -----
enterSmalltalkExecutiveImplementation
"Main entry-point into the interpreter at each execution level, where an execution
level is either the start of execution or reentry for a callback. Capture the C stack
pointers so that calls from machine-code into the C run-time occur at this level.
This is the actual implementation, separated from enterSmalltalkExecutive so the
simulator can wrap it in an exception handler and hence simulate the setjmp/longjmp."
<inline: false>
cogit assertCStackWellAligned.
cogit ceCaptureCStackPointers.
"Setjmp for reentry into interpreter from elsewhere, e.g. machine-code trampolines."
self sigset: reenterInterpreter jmp: 0.
(self isMachineCodeFrame: framePointer) ifTrue:
[self returnToExecutive: false postContextSwitch: true
"NOTREACHED"].
self setMethod: (self iframeMethod: framePointer).
instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
[instructionPointer := self iframeSavedIP: framePointer].
+ self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true line: #'__LINE__'.
- self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true.
self interpret.
^0!
Item was changed:
----- Method: CoInterpreter>>executeCogMethodFromLinkedSend:withReceiver: (in category 'enilopmarts') -----
executeCogMethodFromLinkedSend: cogMethod withReceiver: rcvr
<api>
"Execute a CogMethod from a linked send. The receiver,
arguments and return address are on the Smalltalk stack. First
push the entry-point and finally the register argument(s). Then write
back the frame pointers and call the routine that will pop off the register
argument(s) and jump to the entry by executing a return instruction.
In the simple jit only the receiver gets passed in registers, so only the
receiver gets pushed."
<var: #cogMethod type: #'CogMethod *'>
cogit assertCStackWellAligned.
self assert: (self isMachineCodeFrame: framePointer).
+ self assertValidExecutionPointe: self stackTop r: framePointer s: stackPointer imbar: false line: #'__LINE__'.
- self assertValidExecutionPointe: self stackTop r: framePointer s: stackPointer imbar: false.
self
cppIf: cogit numRegArgs > 0
ifTrue:
[cogMethod cmNumArgs <= cogit numRegArgs ifTrue:
[self enterRegisterArgCogMethod: cogMethod at: cogit entryOffset receiver: rcvr]].
self
push: cogMethod asInteger + cogit entryOffset;
push: rcvr.
cogit ceEnterCogCodePopReceiverReg
"NOTREACHED"!
Item was changed:
----- Method: CoInterpreter>>executeCogMethodFromLinkedSend:withReceiver:andCacheTag: (in category 'enilopmarts') -----
executeCogMethodFromLinkedSend: cogMethod withReceiver: rcvr andCacheTag: cacheTag
<api>
"Execute a CogMethod from a linked send. The receiver,
arguments and return address are on the Smalltalk stack. First
push the entry-point and finally the register argument(s). Then write
back the frame pointers and call the routine that will pop off the register
argument(s) and jump to the entry by executing a return instruction.
In the simple jit only the receiver gets passed in registers, so only the
receiver gets pushed."
<var: #cogMethod type: #'CogMethod *'>
cogit assertCStackWellAligned.
self assert: (self isMachineCodeFrame: framePointer).
+ self assertValidExecutionPointe: self stackTop r: framePointer s: stackPointer imbar: false line: #'__LINE__'.
- self assertValidExecutionPointe: self stackTop r: framePointer s: stackPointer imbar: false.
self push: cogMethod asInteger + cogit entryOffset.
self
cppIf: cogit numRegArgs > 0
ifTrue:
[cogMethod cmNumArgs <= cogit numRegArgs ifTrue:
[self assert: cogit numRegArgs <= 2.
self push: cacheTag.
cogMethod cmNumArgs = 0 ifTrue:
[cogit ceEnter0ArgsPIC].
cogMethod cmNumArgs = 1 ifTrue:
[cogit ceEnter1ArgsPIC].
cogMethod cmNumArgs = 2 ifTrue:
[cogit ceEnter2ArgsPIC].
self error: 'not reached']].
self
push: rcvr;
push: cacheTag.
cogit ceEnterCogCodePopReceiverAndClassRegs
"NOTREACHED"!
Item was changed:
----- Method: CoInterpreter>>executeCogMethodFromUnlinkedSend:withReceiver: (in category 'enilopmarts') -----
executeCogMethodFromUnlinkedSend: cogMethod withReceiver: rcvr
"Execute a CogMethod from an unlinked send. The receiver,
arguments and return address are on the Smalltalk stack. First
push the entry-point and finally the register argument(s). Then write
back the frame pointers and call the routine that will pop off the register
argument(s) and jump to the entry by executing a return instruction.
In the simple jit only the receiver gets passed in registers, so only the
receiver gets pushed."
<var: #cogMethod type: #'CogMethod *'>
cogit assertCStackWellAligned.
self assert: (self isMachineCodeFrame: framePointer).
+ self assertValidExecutionPointe: self stackTop r: framePointer s: stackPointer imbar: false line: #'__LINE__'.
- self assertValidExecutionPointe: self stackTop r: framePointer s: stackPointer imbar: false.
self
cppIf: cogit numRegArgs > 0
ifTrue:
[cogMethod cmNumArgs <= cogit numRegArgs ifTrue:
[self enterRegisterArgCogMethod: cogMethod at: cogit noCheckEntryOffset receiver: rcvr]].
self
push: cogMethod asInteger + cogit noCheckEntryOffset;
push: rcvr.
cogit ceEnterCogCodePopReceiverReg
"NOTREACHED"!
Item was changed:
----- Method: CoInterpreter>>forceInterruptCheckFromHeartbeat (in category 'process primitive support') -----
forceInterruptCheckFromHeartbeat
"Force an interrupt check ASAP. This version is the
entry-point to forceInterruptCheck for the heartbeat
timer to allow for repeatable debugging."
suppressHeartbeatFlag ifFalse:
[self checkForLongRunningPrimitive.
+ self sqLowLevelMFence.
deferSmash
+ ifTrue:
+ [deferredSmash := true.
+ self sqLowLevelMFence]
+ ifFalse:
+ [self forceInterruptCheck]]!
- ifTrue: [deferredSmash := true]
- ifFalse: [self forceInterruptCheck]]!
Item was changed:
----- Method: CoInterpreter>>long:jmp: (in category 'cog jit support') -----
long: aJumpBuf jmp: returnValue
"Hack simulation of setjmp/longjmp.
Signal the exception that simulates a longjmp back to the interpreter."
<doNotGenerate>
aJumpBuf == reenterInterpreter ifTrue:
+ [self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true line: nil].
- [self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true].
aJumpBuf returnValue: returnValue; signal!
Item was changed:
----- 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]!
- self recordTrace: traceType thing: traceType source: 0]!
Item was changed:
----- Method: CoInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
printFrame: theFP WithSP: theSP
+ <api>
| theMethod theMethodEnd numArgs numTemps rcvrAddress topThing |
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #addr type: #'char *'>
<var: #rcvrAddress type: #'char *'>
<var: #cogMethod type: #'CogBlockMethod *'>
<var: #homeMethod type: #'CogMethod *'>
self cCode: '' inSmalltalk: [self transcript ensureCr].
(self isMachineCodeFrame: theFP)
ifTrue:
[| cogMethod homeMethod |
cogMethod := self mframeCogMethod: theFP.
homeMethod := self mframeHomeMethod: theFP.
theMethod := homeMethod asInteger.
theMethodEnd := homeMethod asInteger + homeMethod blockSize.
numArgs := cogMethod cmNumArgs.
numTemps := self temporaryCountOfMethodHeader: homeMethod methodHeader]
ifFalse:
[theMethod := self frameMethodObject: theFP.
theMethodEnd := theMethod + (objectMemory sizeBitsOfSafe: theMethod).
numArgs := self iframeNumArgs: theFP.
numTemps := self tempCountOf: theMethod].
(self frameIsBlockActivation: theFP) ifTrue:
[| rcvrOrClosure |
rcvrOrClosure := self pushedReceiverOrClosureOfFrame: theFP.
((objectMemory isNonIntegerObject: rcvrOrClosure)
and: [(objectMemory addressCouldBeObj: rcvrOrClosure)
and: [(objectMemory fetchClassOfNonInt: rcvrOrClosure) = (objectMemory splObj: ClassBlockClosure)]])
ifTrue: [numTemps := numArgs + (self stSizeOf: rcvrOrClosure)]
ifFalse: [numTemps := 0]].
self shortPrintFrame: theFP.
(self isBaseFrame: theFP) ifTrue:
[self printFrameOop: '(caller ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (2 * BytesPerWord).
self printFrameOop: '(saved ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (1 * BytesPerWord)].
self printFrameOop: 'rcvr/clsr'
at: theFP + FoxCallerSavedIP + ((numArgs + 1) * BytesPerWord).
numArgs to: 1 by: -1 do:
[:i|
self printFrameOop: 'arg' index: numArgs - i at: theFP + FoxCallerSavedIP + (i * BytesPerWord)].
self printFrameThing: 'caller ip' at: theFP + FoxCallerSavedIP.
self printFrameThing: 'saved fp' at: theFP + FoxSavedFP.
self printFrameMethodFor: theFP.
(self isMachineCodeFrame: theFP) ifFalse:
[self printFrameFlagsForFP: theFP].
self printFrameOop: 'context' at: theFP + FoxThisContext.
(self isMachineCodeFrame: theFP) ifTrue:
[self printFrameFlagsForFP: theFP].
(self isMachineCodeFrame: theFP)
ifTrue: [rcvrAddress := theFP + FoxMFReceiver]
ifFalse:
[self printFrameThing: 'saved ip'
at: theFP + FoxIFSavedIP
extra: ((self iframeSavedIP: theFP) = 0
ifTrue: [0]
ifFalse: [(self iframeSavedIP: theFP) - theMethod + 2 - BaseHeaderSize]).
rcvrAddress := theFP + FoxIFReceiver].
self printFrameOop: 'receiver' at: rcvrAddress.
topThing := stackPages longAt: theSP.
(topThing between: theMethod and: theMethodEnd)
ifTrue:
[rcvrAddress - BytesPerWord to: theSP + BytesPerWord by: BytesPerWord negated do:
[:addr| | index |
index := rcvrAddress - addr / BytesPerWord + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
ifFalse: [self printFrameOop: 'stck' at: addr]].
self printFrameThing: 'frame ip'
at: theSP
extra: ((self isMachineCodeFrame: theFP)
ifTrue: [topThing - theMethod]
ifFalse: [topThing - theMethod + 2 - BaseHeaderSize])]
ifFalse:
[rcvrAddress - BytesPerWord to: theSP by: BytesPerWord negated do:
[:addr| | index |
index := rcvrAddress - addr / BytesPerWord + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
ifFalse: [self printFrameOop: 'stck' at: addr]]]!
Item was added:
+ ----- Method: CoInterpreter>>printPrimLogEntryAt: (in category 'debug support') -----
+ printPrimLogEntryAt: i
+ <inline: false>
+ | intOrSelector |
+ intOrSelector := primTraceLog at: i.
+ (objectMemory isIntegerObject: 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>>return:toExecutive: (in category 'enilopmarts') -----
return: returnValue toExecutive: inInterpreter
"We have made a context switch, either when interpreting or from machine code.
Effectively return to the current frame, either by entering machine code, or
longjmp-ing back to the interpreter or simply returning, depending on where we are."
cogit assertCStackWellAligned.
(self isMachineCodeFrame: framePointer) ifTrue:
+ [self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: false line: #'__LINE__'.
- [self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: false.
self push: instructionPointer.
self push: returnValue.
cogit ceEnterCogCodePopReceiverReg
"NOTREACHED"].
self push: returnValue.
self setMethod: (self iframeMethod: framePointer).
+ self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true line: #'__LINE__'.
- self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true.
instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
[instructionPointer := self iframeSavedIP: framePointer].
inInterpreter ifTrue:
[^nil].
self siglong: reenterInterpreter jmp: ReturnToInterpreter.
"NOTREACHED"
^nil!
Item was changed:
----- Method: CoInterpreter>>returnToExecutive:postContextSwitch: (in category 'enilopmarts') -----
returnToExecutive: inInterpreter postContextSwitch: switchedContext
"Return to the current frame, either by entering machine code, or longjmp-ing back to the
interpreter or simply returning, depending on where we are. To know whether to return or
enter machine code we have to know from whence we came. We could have come from
the interpreter, either directly or via a machine code primitive. We could have come from
machine code. The instructionPointer tells us where from. If it is above startOfMemory we're
in the interpreter. If it is below, then we are in machine-code unless it is ceReturnToInterpreterPC,
in which case we're in a machine-code primitive called from the interpreter."
<inline: false>
| cogMethod retValue fullyInInterpreter |
<var: #cogMethod type: #'CogBlockMethod *'>
cogit assertCStackWellAligned.
(self isMachineCodeFrame: framePointer) ifTrue:
+ [self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: false line: #'__LINE__'.
- [self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: false.
"If returning after a context switch then a result may have to be popped from the stack.
If the process is suspended at a send then the result of the primitive in which the
process was suspended is still on the stack and must be popped into ReceiverResultReg.
If not, nothing should be popped and ReceiverResultReg gets the receiver."
switchedContext
ifTrue:
[cogMethod := self mframeCogMethod: framePointer.
(instructionPointer ~= (cogMethod asInteger + cogMethod stackCheckOffset)
and: [cogit isSendReturnPC: instructionPointer])
ifTrue:
[self assert: ((objectMemory isIntegerObject: self stackTop) or: [objectMemory addressCouldBeObj: self stackTop]).
retValue := self popStack]
ifFalse:
[retValue := self mframeReceiver: framePointer]]
ifFalse: [retValue := self mframeReceiver: framePointer].
self push: instructionPointer.
self push: retValue.
cogit ceEnterCogCodePopReceiverReg
"NOTREACHED"].
self setMethod: (self iframeMethod: framePointer).
fullyInInterpreter := inInterpreter.
instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
[instructionPointer := (self iframeSavedIP: framePointer) asUnsignedInteger.
fullyInInterpreter := false].
+ self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true line: #'__LINE__'.
- self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true.
fullyInInterpreter ifFalse:
[self siglong: reenterInterpreter jmp: ReturnToInterpreter.
"NOTREACHED"].
^nil!
Item was changed:
----- Method: CoInterpreter>>returnToMachineCodeFrame (in category 'return bytecodes') -----
returnToMachineCodeFrame
"Return to the previous context/frame after assigning localIP, localSP and localFP."
<inline: true>
cogit assertCStackWellAligned.
self assert: localIP asUnsignedInteger < objectMemory startOfMemory.
self assert: (self isMachineCodeFrame: localFP).
+ self assertValidExecutionPointe: localIP asUnsignedInteger r: localFP s: localSP imbar: false line: #'__LINE__'.
- self assertValidExecutionPointe: localIP asUnsignedInteger r: localFP s: localSP imbar: false.
self internalStackTopPut: localIP.
self internalPush: localReturnValue.
self externalizeFPandSP.
self cCode: '' inSmalltalk:
[self maybeCheckStackDepth: 1 sp: stackPointer pc: localIP].
cogit ceEnterCogCodePopReceiverReg
"NOTREACHED"!
Item was changed:
----- Method: CoInterpreter>>siglong:jmp: (in category 'cog jit support') -----
siglong: aJumpBuf jmp: returnValue
"Hack simulation of sigsetjmp/siglongjmp.
Signal the exception that simulates a longjmp back to the interpreter."
<doNotGenerate>
(aJumpBuf == reenterInterpreter
and: [returnValue ~= 2 "2 == returnToThreadSchedulingLoopVia:"]) ifTrue:
[self assert: (self isOnRumpCStack: cogit processor sp).
+ self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true line: nil].
- self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true].
aJumpBuf returnValue: returnValue; signal!
Item was changed:
----- Method: CoInterpreter>>transferTo:from: (in category 'process primitive support') -----
transferTo: newProc from: sourceCode
"Record a process to be awoken on the next interpreter cycle.
+ Reimplement to record the source of the switch for debugging,
+ and to cope with possible code compaction in makeBaseFrameFor:."
+ | activeContext sched oldProc |
- Reimplement to record the source of the switch for debugging."
<inline: false>
self recordContextSwitchFrom: self activeProcess in: sourceCode.
+ statProcessSwitch := statProcessSwitch + 1.
+ self push: instructionPointer.
+ self externalWriteBackHeadFramePointers.
+ self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer.
+ "ensureMethodIsCogged: in makeBaseFrameFor: in
+ externalSetStackPageAndPointersForSuspendedContextOfProcess:
+ below may do a code compaction. Nil instructionPointer to avoid it getting pushed twice."
+ instructionPointer := 0.
+ sched := self schedulerPointer.
+ oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
+ activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
+ objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext.
+ objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc.
+ objectMemory storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject.
+ self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc!
- super transferTo: newProc!
Item was changed:
----- Method: CoInterpreterMT>>deferStackLimitSmashAround: (in category 'process primitive support') -----
deferStackLimitSmashAround: functionSymbol
"Defer smashes of the stackLimit around the call of functionSymbol (for assert checks).
N.B. SYNCHRONIZE WITH forceInterruptCheckFromHeartbeat"
<var: #functionSymbol declareC: 'void (*functionSymbol)(void)'>
deferSmash := true.
self perform: functionSymbol.
deferSmash := false.
deferredSmash ifTrue:
[deferredSmash := false.
self forceInterruptCheck.
+ self checkVMOwnershipFromHeartbeat].
+ ^true "called from assert"!
- self checkVMOwnershipFromHeartbeat]!
Item was added:
+ ----- Method: CoInterpreterMT>>deferStackLimitSmashAround:with: (in category 'process primitive support') -----
+ deferStackLimitSmashAround: functionSymbol with: arg
+ "Defer smashes of the stackLimit around the call of functionSymbol (for assert checks).
+
+ N.B. SYNCHRONIZE WITH forceInterruptCheckFromHeartbeat"
+
+ <var: #functionSymbol declareC: 'void (*functionSymbol)(sqInt)'>
+ deferSmash := true.
+ self sqLowLevelMFence.
+ self perform: functionSymbol with: arg.
+ deferSmash := false.
+ self sqLowLevelMFence.
+ deferredSmash ifTrue:
+ [deferredSmash := false.
+ self sqLowLevelMFence.
+ self forceInterruptCheck.
+ self checkVMOwnershipFromHeartbeat].
+ ^true "called from assert"!
Item was changed:
----- Method: CoInterpreterMT>>enterSmalltalkExecutiveImplementation (in category 'initialization') -----
enterSmalltalkExecutiveImplementation
"Main entry-point into the interpreter at each execution level, where an execution
level is either the start of execution or reentry for a callback. Capture the C stack
pointers so that calls from machine-code into the C run-time occur at this level.
This is the actual implementation, separated from enterSmalltalkExecutive so the
simulator can wrap it in an exception handler and hence simulate the setjmp/longjmp.
Override to return if a longjmp to reenterInterpreter passes a parameter greater than 1.
This causes a return to threadSchedulingLoop:startingVM: and is used to surrender
control to another thread."
<inline: false>
self assertSaneThreadAndProcess.
cogit assertCStackWellAligned.
cogit ceCaptureCStackPointers.
"Setjmp for reentry into interpreter from elsewhere, e.g. machine-code trampolines."
(self sigset: reenterInterpreter jmp: 0) > 1 ifTrue:
[^0].
(self isMachineCodeFrame: framePointer) ifTrue:
[self returnToExecutive: false postContextSwitch: true
"NOTREACHED"].
self setMethod: (self iframeMethod: framePointer).
instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
[instructionPointer := self iframeSavedIP: framePointer].
+ self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true line: #'__LINE__'.
- self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true.
self interpret.
"NOTREACHED"
^0!
Item was changed:
----- Method: CoInterpreterMT>>forceInterruptCheckFromHeartbeat (in category 'process primitive support') -----
forceInterruptCheckFromHeartbeat
"Force an interrupt check ASAP. This version is the
entry-point to forceInterruptCheck for the heartbeat
timer to allow for repeatable debugging.
N.B. SYNCHRONIZE WITH deferStackLimitSmashAround:"
suppressHeartbeatFlag ifFalse:
[self checkForLongRunningPrimitive.
+ self sqLowLevelMFence.
deferSmash
+ ifTrue:
+ [deferredSmash := true.
+ self sqLowLevelMFence]
- ifTrue: [deferredSmash := true]
ifFalse:
[self forceInterruptCheck.
self checkVMOwnershipFromHeartbeat]]!
Item was changed:
----- Method: CoInterpreterMT>>ownVM: (in category 'vm scheduling') -----
ownVM: threadIndexAndFlags
<api>
<inline: false>
"This is the entry-point for plugins and primitives that wish to reacquire the VM after having
released it via disownVM or callbacks that want to acquire it without knowing their ownership
status. This call will block until the VM is owned by the current thread or an error occurs.
The argument should be the value answered by disownVM, or 0 for callbacks that don't know
if they have disowned or not. This is both an optimization to avoid having to query thread-
local storage for the current thread's index (since it can easily keep it in some local variable),
and a record of when an unbound process becomes affined to a thread for the dynamic
extent of some operation.
Answer 0 if the current thread is known to the VM.
Answer 1 if the current thread is unknown to the VM and takes ownership.
Answer -1 if the current thread is unknown to the VM and fails to take ownership."
| threadIndex flags vmThread myProc activeProc sched |
<var: #vmThread type: #'CogVMThread *'>
threadIndexAndFlags = 0 ifTrue:
[^self ownVMFromUnidentifiedThread].
threadIndex := threadIndexAndFlags bitAnd: ThreadIdMask.
flags := threadIndexAndFlags >> DisownFlagsShift.
(flags anyMask: DisownVMForProcessorRelinquish) ifTrue:
[relinquishing := false.
self sqLowLevelMFence].
(threadIndexAndFlags anyMask: LockGUIThreadFlag) ifTrue:
[self assert: (noThreadingOfGUIThread and: [self inGUIThread]).
self assert: disowningVMThread = nil.
(flags anyMask: DisownVMLockOutFullGC) ifTrue:
[objectMemory decrementFullGCLock].
cogit recordEventTrace ifTrue:
[self recordTrace: TraceOwnVM thing: ConstZero source: 0].
^0].
vmThread := cogThreadManager acquireVMFor: threadIndex.
disownCount := disownCount - 1.
(flags anyMask: DisownVMLockOutFullGC) ifTrue:
[objectMemory decrementFullGCLock].
disowningVMThread notNil ifTrue:
[vmThread = disowningVMThread ifTrue:
[self cCode: ''
inSmalltalk:
[| range |
range := self cStackRangeForThreadIndex: threadIndex.
self assert: (range includes: cogit getCStackPointer).
self assert: (range includes: cogit getCFramePointer)].
self assert: self successful.
self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
disowningVMThread := nil.
cogit recordEventTrace ifTrue:
[self recordTrace: TraceOwnVM thing: ConstOne source: 0].
^0]. "if not preempted we're done."
self preemptDisowningThread].
"We've been preempted; we must restore state and update the threadId
in our process, and may have to put the active process to sleep."
activeProc := self activeProcess.
(threadIndexAndFlags anyMask: OwnVMForeignThreadFlag)
ifTrue:
[self assert: foreignCallbackProcessSlot == ForeignCallbackProcess.
myProc := objectMemory splObj: foreignCallbackProcessSlot.
self assert: myProc ~= objectMemory nilObject.
objectMemory splObj: foreignCallbackProcessSlot put: objectMemory nilObject]
ifFalse: [myProc := cogThreadManager popAWOLProcess: vmThread].
self assert: activeProc ~= myProc.
(activeProc ~= objectMemory nilObject
and: [(objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject]) ifTrue:
[self putToSleep: activeProc yieldingIf: preemptionYields].
self assert: (objectMemory fetchPointer: MyListIndex ofObject: myProc) = (objectMemory splObj: ProcessInExternalCodeTag).
sched := self schedulerPointer.
objectMemory
storePointer: ActiveProcessIndex ofObject: sched withValue: myProc;
storePointerUnchecked: MyListIndex ofObject: myProc withValue: objectMemory nilObject.
"Only unaffine if the process was affined at this level and did not become bound in the interim."
((threadIndexAndFlags anyMask: ProcessUnaffinedOnDisown)
and: [(self isBoundProcess: myProc) not]) ifTrue:
[self setOwnerIndexOfProcess: myProc to: 0 bind: false].
self initPrimCall.
self externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc.
"If this primitive is called from machine code maintain the invariant that the return pc
of an interpreter callee calling a machine code caller is ceReturnToInterpreterPC."
- instructionPointer := self popStack.
(vmThread inMachineCode
and: [instructionPointer >= objectMemory startOfMemory]) ifTrue:
[self iframeSavedIP: framePointer put: instructionPointer.
instructionPointer := cogit ceReturnToInterpreterPC].
newMethod := vmThread newMethodOrNull.
argumentCount := vmThread argumentCount.
self cCode:
[self mem: reenterInterpreter
cp: vmThread reenterInterpreter
y: (self sizeof: #'jmp_buf')]
inSmalltalk:
[reenterInterpreter := vmThread reenterInterpreter].
vmThread newMethodOrNull: nil.
self cCode: ''
inSmalltalk:
[| range |
range := self cStackRangeForThreadIndex: threadIndex.
self assert: (range includes: vmThread cStackPointer).
self assert: (range includes: vmThread cFramePointer)].
cogit setCStackPointer: vmThread cStackPointer.
cogit setCFramePointer: vmThread cFramePointer.
self assert: newMethod ~~ nil..
cogit recordEventTrace ifTrue:
[self recordTrace: TraceOwnVM thing: ConstTwo source: 0].
^threadIndexAndFlags bitAnd: OwnVMForeignThreadFlag!
Item was changed:
----- Method: CoInterpreterMT>>transferTo:from: (in category 'process primitive support') -----
transferTo: newProc from: sourceCode
"Record a process to be awoken on the next interpreter cycle. Override to
potentially switch threads either if the new process is bound to another thread,
or if there is no runnable process but there is a waiting thread. Note that the
abort on no runnable process has beeen moved here from wakeHighestPriority."
| sched oldProc activeContext vmThread |
<inline: false>
<var: #vmThread type: #'CogVMThread *'>
statProcessSwitch := statProcessSwitch + 1.
self push: instructionPointer.
self externalWriteBackHeadFramePointers.
sched := self schedulerPointer.
oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
self recordContextSwitchFrom: oldProc in: sourceCode.
activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext.
newProc isNil ifTrue:
["Two possibilities. One, there is at least one thread waiting to own the VM in which
case it should be activated. Two, there are no processes to run and so abort."
vmThread := self willingVMThread.
(vmThread notNil and: [vmThread state = CTMWantingOwnership]) ifTrue:
[self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: sourceCode].
self error: 'scheduler could not find a runnable process'].
objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc.
objectMemory storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject.
self threadSwitchIfNecessary: newProc from: sourceCode.
+ self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc!
- self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc.
- instructionPointer := self popStack!
Item was changed:
----- Method: CoInterpreterMT>>tryToExecuteSmalltalk: (in category 'vm scheduling') -----
tryToExecuteSmalltalk: vmThread
"Attempt to run the current process, if it exists, on the given vmThread."
<var: #vmThread type: #'CogVMThread *'>
| dvmt activeProc ownerIndex |
<var: #dvmt type: #'CogVMThread *'>
self assert: cogThreadManager getVMOwner = vmThread index.
self assert: cogThreadManager ioGetThreadLocalThreadIndex = vmThread index.
dvmt := disowningVMThread.
disowningVMThread
ifNil: [activeProc := self activeProcess]
ifNotNil:
[self preemptDisowningThread.
activeProc := self wakeHighestPriority.
activeProc
ifNil: [activeProc := objectMemory nilObject]
ifNotNil: [objectMemory
storePointerUnchecked: MyListIndex
ofObject: activeProc
withValue: objectMemory nilObject].
objectMemory
storePointer: ActiveProcessIndex
ofObject: self schedulerPointer
withValue: activeProc].
activeProc = objectMemory nilObject ifTrue:
[cogThreadManager releaseVM.
^nil].
ownerIndex := self ownerIndexOfProcess: activeProc.
(ownerIndex = 0
or: [ownerIndex ~= 0 and: [ownerIndex = cogThreadManager getVMOwner]])
ifTrue:
[self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
(objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc) ~= objectMemory nilObject ifTrue:
+ [self externalSetStackPageAndPointersForSuspendedContextOfProcess: activeProc].
- [self externalSetStackPageAndPointersForSuspendedContextOfProcess: activeProc.
- instructionPointer := self popStack].
self enterSmalltalkExecutive.
"When we return here we should have already given up
the VM and so we cannot touch any interpreter state."]
ifFalse:
[cogThreadManager wakeVMThreadFor: ownerIndex]!
Item was changed:
----- Method: CoInterpreterPrimitives>>pathTo:using:followWeak: (in category 'object access primitives') -----
pathTo: goal using: stack followWeak: followWeak
"Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found.
If found, unmark, leaving path in stack, and answer 0. Otherwise answer an error:
PrimErrBadArgument if stack is not an Array
PrimErrBadIndex if search overflows stack
PrimErrNotFound if goal cannot be found"
| current hdr index next stackSize stackp freeStartAtStart |
(objectMemory isArray: stack) ifFalse:
[^PrimErrBadArgument].
freeStartAtStart := objectMemory freeStart. "check no allocations during search"
objectMemory beRootIfOld: stack. "so no store checks are necessary on stack"
stackSize := objectMemory lengthOf: stack.
objectMemory mark: stack.
"no need. the current context is not reachable from the active process (suspendedContext is nil)"
"objectMemory mark: self activeProcess."
current := objectMemory specialObjectsOop.
objectMemory mark: current.
index := objectMemory lengthOf: current.
stackp := 0.
[[(index := index - 1) >= -1] whileTrue:
[next := (stackPages couldBeFramePointer: current)
ifTrue:
[index >= 0
+ ifTrue: [self field: index ofFrame: (self cCoerceSimple: current to: #'char *')]
- ifTrue: [self field: index ofFrame: current]
ifFalse: [objectMemory nilObject]]
ifFalse:
[index >= 0
ifTrue:
[hdr := objectMemory baseHeader: current.
(objectMemory isContextHeader: hdr)
ifTrue: [self fieldOrSenderFP: index ofContext: current]
ifFalse: [objectMemory fetchPointer: index ofObject: current]]
ifFalse:
[objectMemory fetchClassOfNonInt: current]].
(stackPages couldBeFramePointer: next)
+ ifTrue: [self assert: (self isFrame: (self cCoerceSimple: next to: #'char *')
+ onPage: (stackPages stackPageFor: (self cCoerceSimple: next to: #'char *')))]
- ifTrue: [self assert: (self isFrame: next onPage: (stackPages stackPageFor: next))]
ifFalse:
[next >= heapBase ifTrue:
[self assert: (self checkOkayOop: next)]].
next = goal ifTrue:
[self assert: freeStartAtStart = objectMemory freeStart.
self unmarkAfterPathTo.
objectMemory storePointer: stackp ofObject: stack withValue: current.
self pruneStack: stack stackp: stackp.
^0].
((objectMemory isNonIntegerObject: next)
and: [(stackPages couldBeFramePointer: next)
ifTrue: [(self frameIsMarked: next) not]
ifFalse:
[next >= heapBase "exclude Cog methods"
and: [(objectMemory isMarked: next) not
and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next])
and: [followWeak or: [(objectMemory isWeakNonInt: next) not]]]]]])
ifTrue:
[stackp + 2 > stackSize ifTrue:
[self assert: freeStartAtStart = objectMemory freeStart.
self unmarkAfterPathTo.
objectMemory nilFieldsOf: stack.
^PrimErrBadIndex]. "PrimErrNoMemory ?"
objectMemory
storePointerUnchecked: stackp ofObject: stack withValue: current;
storePointerUnchecked: stackp + 1 ofObject: stack withValue: (objectMemory integerObjectOf: index).
stackp := stackp + 2.
(stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *'))
ifTrue:
[self markFrame: next.
index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')]
ifFalse:
[hdr := objectMemory baseHeader: next.
objectMemory baseHeader: next put: (hdr bitOr: MarkBit).
(objectMemory isCompiledMethodHeader: hdr)
ifTrue: [index := self literalCountOf: next]
ifFalse: [index := objectMemory lengthOf: next]].
current := next]].
current = objectMemory specialObjectsOop ifTrue:
[self assert: freeStartAtStart = objectMemory freeStart.
self unmarkAfterPathTo.
objectMemory nilFieldsOf: stack.
^PrimErrNotFound].
index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: stack).
current := objectMemory fetchPointer: stackp - 2 ofObject: stack.
stackp := stackp - 2] repeat!
Item was changed:
----- Method: CoInterpreterPrimitives>>primitiveTerminateTo (in category 'control primitives') -----
primitiveTerminateTo
"Primitive. Terminate up the context stack from the receiver up to but not including
the argument, if previousContext is on my Context stack. Make previousContext my
sender. This prim has to shadow the code in ContextPart>terminateTo: to be correct.
Override to ensure the caller's saved ip is correct, i.e. if an interpreter frame it may
have to move to iframeSavedIP."
| thisCtx currentCtx aContextOrNil contextsFP contextsSP contextsIP nextCntx stackedReceiverOffset
theFP newFP newSP pageToStopOn thePage frameAbove |
<var: #contextsFP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #newFP type: #'char *'>
<var: #newSP type: #'char *'>
<var: #contextsIP type: #usqInt>
<var: #frameAbove type: #'char *'>
<var: #contextsSP type: #'char *'>
<var: #source type: #'char *'>
<var: #pageToStopOn type: #'StackPage *'>
<var: #thePage type: #'StackPage *'>
aContextOrNil := self stackTop.
(aContextOrNil = objectMemory nilObject or: [objectMemory isContext: aContextOrNil]) ifFalse:
[^self primitiveFail].
thisCtx := self stackValue: 1.
thisCtx = aContextOrNil ifTrue:
[^self primitiveFail].
"All stackPages need to have current head pointers to avoid confusion."
self externalWriteBackHeadFramePointers.
"If we're searching for aContextOrNil it might be on a stack page. Helps to know
if we can free a whole page or not, or if we can short-cut the termination."
(aContextOrNil ~= objectMemory nilObject and: [self isStillMarriedContext: aContextOrNil])
ifTrue: [contextsFP := self frameOfMarriedContext: aContextOrNil.
pageToStopOn := stackPages stackPageFor: contextsFP]
ifFalse: [pageToStopOn := 0].
"if thisCtx is married ensure it is a base frame. Then we can assign its sender."
(self isStillMarriedContext: thisCtx)
ifTrue:
[theFP := self frameOfMarriedContext: thisCtx.
"Optimize terminating thisContext. Move its frame down to be next to
aContextOrNil's frame. Common in the exception system and so helps to be fast."
(theFP = framePointer
and: [pageToStopOn = stackPage]) ifTrue:
+ [self assertValidStackedInstructionPointersIn: stackPage line: #'__LINE__'.
+ (self frameCallerFP: theFP) ~= contextsFP ifTrue:
- [(self frameCallerFP: theFP) ~= contextsFP ifTrue:
[stackedReceiverOffset := self frameStackedReceiverOffset: theFP.
frameAbove := self findFrameAbove: contextsFP inPage: pageToStopOn.
contextsIP := (self frameCallerSavedIP: frameAbove) asUnsignedInteger.
self assert: ((contextsIP asUnsignedInteger >= objectMemory startOfMemory)
or: [contextsIP = cogit ceReturnToInterpreterPC]) == (self isMachineCodeFrame: contextsFP) not.
newSP := self frameCallerSP: frameAbove.
newFP := newSP - stackedReceiverOffset - BytesPerWord.
theFP + stackedReceiverOffset
to: stackPointer
by: BytesPerWord negated
do: [:source|
newSP := newSP - BytesPerWord.
stackPages longAt: newSP put: (stackPages longAt: source)].
stackPages longAt: newFP + FoxSavedFP put: contextsFP.
"Ensure contract between machine-code callee and interpreter caller frames is preserved.
Return pc needs to be ceReturnToInterpreterPC."
((self isMachineCodeFrame: newFP)
and: [contextsIP >= objectMemory startOfMemory]) ifTrue:
[self iframeSavedIP: contextsFP put: contextsIP.
contextsIP := cogit ceReturnToInterpreterPC].
stackPages longAt: newFP + FoxCallerSavedIP put: contextsIP.
self assert: (objectMemory isContext: thisCtx).
objectMemory storePointerUnchecked: SenderIndex
ofObject: thisCtx
withValue: (self withSmallIntegerTags: newFP).
objectMemory storePointerUnchecked: InstructionPointerIndex
ofObject: thisCtx
withValue: (self withSmallIntegerTags: contextsFP).
framePointer := newFP.
stackPointer := newSP].
+ self pop: 1.
+ self assertValidStackedInstructionPointersIn: stackPage line: #'__LINE__'.
+ self assert: stackPage = stackPages mostRecentlyUsedPage.
+ ^nil].
+ self assertValidStackedInstructionPointers: #'__LINE__'.
- self pop: 1.
- self assert: stackPage = stackPages mostRecentlyUsedPage.
- ^nil].
theFP := self externalEnsureIsBaseFrame: theFP. "May cause a GC!!!!"
currentCtx := self frameCallerContext: theFP.
"May also reclaim aContextOrNil's page, hence..."
(aContextOrNil ~= objectMemory nilObject and: [self isStillMarriedContext: aContextOrNil])
ifTrue: [contextsFP := self frameOfMarriedContext: aContextOrNil.
pageToStopOn := stackPages stackPageFor: contextsFP]
ifFalse: [pageToStopOn := 0]]
ifFalse:
[currentCtx := objectMemory fetchPointer: SenderIndex ofObject: thisCtx].
+ self assertValidStackedInstructionPointers: #'__LINE__'.
(self context: thisCtx hasSender: aContextOrNil) ifTrue:
["Need to walk the stack freeing stack pages and nilling contexts."
[currentCtx = aContextOrNil
or: [currentCtx = objectMemory nilObject]] whileFalse:
[self assert: (objectMemory isContext: currentCtx).
(self isMarriedOrWidowedContext: currentCtx)
ifTrue:
[theFP := self frameOfMarriedContext: currentCtx.
thePage := stackPages stackPageFor: theFP.
"If externalEnsureIsBaseFrame: above has moved thisContext to its own stack
then we will always terminate to a frame on a different page. But if we are
terminating some other context to a context somewhere on the current page
we must save the active frames above that context. Things will look e.g. like this:
thisCtx 499383332 s MethodContext(ContextPart)>resume:
499380484 s BlockClosure>ensure:
499377320 s MethodContext(ContextPart)>handleSignal:
499373760 s MethodContext(ContextPart)>handleSignal:
499372772 s MessageNotUnderstood(Exception)>signal
499369068 s CodeSimulationTests(Object)>doesNotUnderstand: absentMethod
499368708 s [] in CodeSimulationTests>testDNU
(sender is 0xbffc2480 I CodeSimulationTests>runSimulated:)
------------
framePointer 0xbffc234c M MethodContext(ContextPart)>doPrimitive:method:receiver:args:
0xbffc2378 M MethodContext(ContextPart)>tryPrimitiveFor:receiver:args:
0xbffc23ac M MethodContext(ContextPart)>send:to:with:super:
0xbffc23e4 M MethodContext(ContextPart)>send:super:numArgs:
0xbffc2418 M MethodContext(InstructionStream)>interpretNextInstructionFor:
0xbffc2434 M MethodContext(ContextPart)>step
0xbffc2458 I MethodContext(ContextPart)>runSimulated:contextAtEachStep:
------------
(499368708's sender) 0xbffc2480 I CodeSimulationTests>runSimulated:
0xbffc249c M CodeSimulationTests>testDNU
0xbffc24bc I CodeSimulationTests(TestCase)>performTest
0xbffc24dc I [] in CodeSimulationTests(TestCase)>runCase
aContextOrNil 0xbffc24fc M BlockClosure>ensure:
0xbffc2520 I CodeSimulationTests(TestCase)>runCase
0xbffc253c M [] in TestResult>runCase:
When we find this case we move the frames above to a new page by making the
frame above currentCtx a base frame, i.e. making 0xbffc2458 in the above example
a base frame. But in this iteration of the loop we don't move down a frame i.e. currentCtx
doesn't change on this iteration."
thePage = stackPage
ifTrue:
[frameAbove := self findFrameAbove: theFP inPage: thePage.
self assert: frameAbove ~= 0.
frameAbove := self externalEnsureIsBaseFrame: frameAbove. "May cause a GC!!!! May also reclaim aContextOrNil's page, hence..."
(aContextOrNil ~= objectMemory nilObject and: [self isStillMarriedContext: aContextOrNil])
ifTrue: [contextsFP := self frameOfMarriedContext: aContextOrNil.
pageToStopOn := stackPages stackPageFor: contextsFP]
ifFalse: [pageToStopOn := 0]]
ifFalse:
[thePage = pageToStopOn
ifTrue:
["We're here. Cut back the stack to aContextOrNil's frame,
push its instructionPointer if it's not already a head frame,
and we're done."
frameAbove := self findFrameAbove: contextsFP inPage: thePage.
frameAbove ~= 0 ifTrue:
[contextsSP := (self frameCallerSP: frameAbove) - BytesPerWord.
stackPages longAt: contextsSP put: (self frameCallerSavedIP: frameAbove).
self setHeadFP: contextsFP andSP: contextsSP inPage: thePage].
currentCtx := aContextOrNil]
ifFalse:
["We can free the entire page without further ado."
currentCtx := self frameCallerContext: thePage baseFP.
"for a short time invariant is violated; assert follows"
stackPages freeStackPageNoAssert: thePage]]]
ifFalse:
[nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx.
self markContextAsDead: currentCtx.
currentCtx := nextCntx]]].
self assert: stackPages pageListIsWellFormed.
(self isMarriedOrWidowedContext: thisCtx)
ifTrue:
[self assert: (self checkIsStillMarriedContext: thisCtx currentFP: framePointer).
self assert: (self isBaseFrame: (self frameOfMarriedContext: thisCtx)).
theFP := self frameOfMarriedContext: thisCtx.
self frameCallerContext: theFP put: aContextOrNil]
+ ifFalse:
+ [objectMemory storePointer: SenderIndex ofObject: thisCtx withValue: aContextOrNil].
- ifFalse: [objectMemory storePointer: SenderIndex ofObject: thisCtx withValue: aContextOrNil].
self pop: 1.
+ self assertValidStackedInstructionPointers: #'__LINE__'.
self assert: stackPage = stackPages mostRecentlyUsedPage!
Item was added:
+ ----- 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 added:
+ ----- Method: CogBytecodeFixup 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 changed:
----- Method: CogIA32Compiler>>relocateCallBeforeReturnPC:by: (in category 'inline cacheing') -----
relocateCallBeforeReturnPC: retpc by: delta
| distance |
delta ~= 0 ifTrue:
[distance := ((objectMemory byteAt: retpc - 1) << 24)
+ ((objectMemory byteAt: retpc - 2) << 16)
+ ((objectMemory byteAt: retpc - 3) << 8)
+ (objectMemory byteAt: retpc - 4).
distance := distance + delta.
objectMemory
byteAt: retpc - 1 put: (distance >> 24 bitAnd: 16rFF);
byteAt: retpc - 2 put: (distance >> 16 bitAnd: 16rFF);
byteAt: retpc - 3 put: (distance >> 8 bitAnd: 16rFF);
byteAt: retpc - 4 put: (distance bitAnd: 16rFF).
+ (self asserta: (self callTargetFromReturnAddress: retpc) >= cogit minCallAddress) ifFalse:
+ [self error: 'relocating call to invalid address']]!
- false
- ifTrue: [self assert: (self callTargetFromReturnAddress: retpc) signedIntToLong >= cogit minCallAddress]
- ifFalse: [(self callTargetFromReturnAddress: retpc) signedIntToLong >= cogit minCallAddress ifFalse:
- [self error: 'relocating call to invalid address']]]!
Item was added:
+ ----- 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: CogVMSimulator>>assertValidExecutionPointers (in category 'testing') -----
- assertValidExecutionPointers
- self assertValidExecutionPointe: localIP r: localFP s: localSP!
Item was added:
+ ----- Method: CogVMSimulator>>deferStackLimitSmashAround:with: (in category 'multi-threading simulation switch') -----
+ deferStackLimitSmashAround: functionSymbol with: arg
+ "This method includes or excludes CoInterpreterMT methods as required.
+ Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
+
+ ^self perform: #deferStackLimitSmashAround:with:
+ withArguments: {functionSymbol. arg}
+ inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was removed:
- ----- Method: CogVMSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- objectMemory memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
CogClass subclass: #Cogit
instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMissCall missOffset entryPointMask checkedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxMethodBefore maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceStoreCheckTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceClosureCopyTrampoline ceCreateNewArrayTrampoline ceEnterCogCodePopReceiverReg ceEnterCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceActiveContextTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline cePositive32BitIntegerTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB'
+ classVariableNames: 'AltBlockCreationBytecodeSize AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxStackAllocSize MaxUnitDisplacement MaxX2NDisplacement MethodTooBig NSSendIsPCAnnotated NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass YoungSelectorInPIC'
- classVariableNames: 'AltBlockCreationBytecodeSize AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxUnitDisplacement MaxX2NDisplacement MethodTooBig NSSendIsPCAnnotated NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass YoungSelectorInPIC'
poolDictionaries: 'CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices VMStackFrameOffsets'
category: 'VMMaker-JIT'!
Cogit class
instanceVariableNames: 'generatorTable primitiveTable'!
!Cogit commentStamp: 'eem 2/13/2013 15:37' prior: 0!
I am the code generator for the Cog VM. My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance. I can be tested in the current image using my class-side in-image compilation facilities. e.g. try
StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib)
I have concrete subclasses that implement different levels of optimization:
SimpleStackBasedCogit is the simplest code generator.
StackToRegisterMappingCogit is the current production code generator It defers pushing operands
to the stack until necessary and implements a register-based calling convention for low-arity sends.
StackToRegisterMappingCogit is an experimental code generator with support for counting
conditional branches, intended to support adaptive optimization.
coInterpreter <CoInterpreterSimulator>
the VM's interpreter with which I cooperate
methodZoneManager <CogMethodZoneManager>
the manager of the machine code zone
objectRepresentation <CogObjectRepresentation>
the object used to generate object accesses
processor <BochsIA32Alien|?>
the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk
simulatedTrampolines <Dictionary of Integer -> MessageSend>
the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time.
simulatedVariableGetters <Dictionary of Integer -> MessageSend>
the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time.
simulatedVariableSetters <Dictionary of Integer -> MessageSend>
the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time.
printRegisters printInstructions clickConfirm <Boolean>
flags controlling debug printing and code simulation
breakPC <Integer>
machine code pc breakpoint
cFramePointer cStackPointer <Integer>
the variables representing the C stack & frame pointers, which must change on FFI callback and return
selectorOop <sqInt>
the oop of the methodObj being compiled
methodObj <sqInt>
the bytecode method being compiled
initialPC endPC <Integer>
the start and end pcs of the methodObj being compiled
methodOrBlockNumArgs <Integer>
argument count of current method or block being compiled
needsFrame <Boolean>
whether methodObj or block needs a frame to execute
primitiveIndex <Integer>
primitive index of current method being compiled
methodLabel <CogAbstractOpcode>
label for the method header
blockEntryLabel <CogAbstractOpcode>
label for the start of the block dispatch code
stackOverflowCall <CogAbstractOpcode>
label for the call of ceStackOverflow in the method prolog
sendMissCall <CogAbstractOpcode>
label for the call of ceSICMiss in the method prolog
entryOffset <Integer>
offset of method entry code from start (header) of method
entry <CogAbstractOpcode>
label for the first instruction of the method entry code
noCheckEntryOffset <Integer>
offset of the start of a method proper (after the method entry code) from start (header) of method
noCheckEntry <CogAbstractOpcode>
label for the first instruction of start of a method proper
fixups <Array of <AbstractOpcode Label | nil>>
the labels for forward jumps that will be fixed up when reaching the relevant bytecode. fixup shas one element per byte in methodObj's bytecode
abstractOpcodes <Array of <AbstractOpcode>>
the code generated when compiling methodObj
byte0 byte1 byte2 byte3 <Integer>
individual bytes of current bytecode being compiled in methodObj
bytecodePointer <Integer>
bytecode pc (same as Smalltalk) of the current bytecode being compiled
opcodeIndex <Integer>
the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist)
numAbstractOpcodes <Integer>
the number of elements in abstractOpcocdes
blockStarts <Array of <BlockStart>>
the starts of blocks in the current method
blockCount
the index into blockStarts as they are being noted, and hence eventuakly teh total number of blocks in the current method
labelCounter <Integer>
a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about
ceStackOverflowTrampoline <Integer>
ceSend0ArgsTrampoline <Integer>
ceSend1ArgsTrampoline <Integer>
ceSend2ArgsTrampoline <Integer>
ceSendNArgsTrampoline <Integer>
ceSendSuper0ArgsTrampoline <Integer>
ceSendSuper1ArgsTrampoline <Integer>
ceSendSuper2ArgsTrampoline <Integer>
ceSendSuperNArgsTrampoline <Integer>
ceSICMissTrampoline <Integer>
ceCPICMissTrampoline <Integer>
ceStoreCheckTrampoline <Integer>
ceReturnToInterpreterTrampoline <Integer>
ceBaseFrameReturnTrampoline <Integer>
ceSendMustBeBooleanTrampoline <Integer>
ceClosureCopyTrampoline <Integer>
the various trampolines (system-call-like jumps from machine code to the run-time).
See Cogit>>generateTrampolines for the mapping from trampoline to run-time
routine and then read the run-time routine for a funcitonal description.
ceEnterCogCodePopReceiverReg <Integer>
the enilopmart (jump from run-time to machine-code)
methodZoneBase <Integer>
!
Cogit class
instanceVariableNames: 'generatorTable primitiveTable'!
Item was removed:
- ----- Method: Cogit class>>initializeCompilationWithConstantsOptions: (in category 'class initialization') -----
- initializeCompilationWithConstantsOptions: optionsDictionary
- ProcessorClass := (optionsDictionary at: #ISA ifAbsent: [#IA32]) caseOf: {
- [#IA32] -> [BochsIA32Alien].
- [#ARMv5] -> [GdbARMAlien]. }.
- NumSendTrampolines := 4!
Item was changed:
----- Method: Cogit class>>initializeMiscConstantsWith: (in category 'class initialization') -----
initializeMiscConstantsWith: optionsDictionary
super initializeMiscConstantsWith: optionsDictionary.
Debug := optionsDictionary at: #Debug ifAbsent: [false].
(optionsDictionary includesKey: #EagerInstructionDecoration)
ifTrue:
[EagerInstructionDecoration := optionsDictionary at: #EagerInstructionDecoration]
ifFalse:
[EagerInstructionDecoration isNil ifTrue:
[EagerInstructionDecoration := false]]. "speeds up single stepping but could lose fidelity"
+ ProcessorClass := (optionsDictionary at: #ISA ifAbsent: [#IA32]) caseOf: {
+ [#IA32] -> [BochsIA32Alien].
+ [#ARMv5] -> [GdbARMAlien]. }.
+ "we special-case 0, 1 & 2 argument sends, N is numArgs >= 3"
+ NumSendTrampolines := 4.
"Currently only the ceImplicitReceiverTrampoline contains object references."
+ NumObjRefsInRuntime := 2.
+ "Max size to alloca when compiling.
+ Mac OS X 10.6.8 segfaults approaching 8Mb.
+ Linux 2.6.9 segfaults above 11Mb.
+ WIndows XP segfaults approaching 2Mb."
+ MaxStackAllocSize := 1024 * 1024 * 3 / 2 !
- NumObjRefsInRuntime := 2!
Item was changed:
----- Method: Cogit class>>initializeWithOptions: (in category 'class initialization') -----
initializeWithOptions: optionsDictionary
self initializeMiscConstantsWith: optionsDictionary. "must preceed other initialization."
self initializeErrorCodes.
self initializeCogMethodConstants.
self initializeAnnotationConstants.
- self initializeCompilationWithConstantsOptions: optionsDictionary.
self initializeBytecodeTable.
self initializePrimitiveTable!
Item was changed:
----- Method: Cogit>>addressSpaceMask (in category 'accessing') -----
addressSpaceMask
<doNotGenerate>
+ "Quad-byte-align, because the ARM requires 4-byte aligned jump & call targets."
+ ^((1 << (8 * BytesPerWord)) - 1) bitAnd: -4!
- "The first parenthesis generates a word of ones, -3 removes the two lowest bits because of ARM's requirement to have 4-aligned jumping addresses"
- ^((1 << (8 * BytesPerWord)) - 1) - 3!
Item was added:
+ ----- Method: Cogit>>allButTopBitOfAddressSpaceMask (in category 'accessing') -----
+ allButTopBitOfAddressSpaceMask
+ <doNotGenerate>
+ "Quad-byte-align, because the ARM requires 4-byte aligned jump & call targets."
+ ^((1 << (8 * BytesPerWord - 1)) - 1) bitAnd: -4!
Item was added:
+ ----- Method: Cogit>>allocateOpcodes:bytecodes:ifFail: (in category 'initialization') -----
+ allocateOpcodes: numberOfAbstractOpcodes bytecodes: numberOfBytecodes ifFail: failBlock
+ "Allocate the various arrays needed to compile abstract instructions.
+ This needs to be a macro since the arrays are alloca'ed (stack allocated)
+ to ensure their being freed when compilation is done.
+ Notionally we only need as many fixups as there are bytecodes. But we
+ reuse fixups to record pc-dependent instructions in generateInstructionsAt:
+ and so need at least as many as there are abstract opcodes.
+
+ N.B. We do one single alloca to save embarrassing C optimizers that
+ generate incorrect code as both gcc and the intel compiler do on x86."
+ <cmacro: '(numberOfAbstractOpcodes,numberOfBytecodes,failBlock) do { \
+ int opcodeSize = sizeof(AbstractInstruction) * (numAbstractOpcodes = (numberOfAbstractOpcodes)); \
+ int fixupSize = sizeof(BytecodeFixup) * numAbstractOpcodes; \
+ int annotationSize = sizeof(InstructionAnnotation) * ((numAbstractOpcodes + 3) / 4); \
+ int allocSize = opcodeSize + fixupSize + annotationSize; \
+ if (allocSize > MaxStackAllocSize) failBlock; \
+ abstractOpcodes = alloca(allocSize); \
+ bzero(abstractOpcodes, opcodeSize + fixupSize); \
+ fixups = (void *)((char *)abstractOpcodes + opcodeSize); \
+ annotations = (void *)((char *)fixups + fixupSize); \
+ opcodeIndex = labelCounter = annotationIndex = 0; \
+ } while (0)'>
+ | opcodeSize fixupSize annotationSize allocSize |
+ opcodeSize := (self sizeof: CogAbstractInstruction) * numberOfAbstractOpcodes.
+ fixupSize := (self sizeof: CogBytecodeFixup) * numberOfAbstractOpcodes.
+ annotationSize := (self sizeof: CogInstructionAnnotation) * ((numberOfAbstractOpcodes + 3) / 4).
+ allocSize := opcodeSize + fixupSize + annotationSize.
+ allocSize > MaxStackAllocSize ifTrue: [^failBlock value].
+ numAbstractOpcodes := numberOfAbstractOpcodes.
+ abstractOpcodes := CArrayAccessor on:
+ ((1 to: numAbstractOpcodes) collect:
+ [:ign| processor abstractInstructionCompilerClass for: self]).
+ fixups := CArrayAccessor on:
+ ((1 to: numAbstractOpcodes) collect:
+ [:ign| self bytecodeFixupClass new]).
+ annotations := CArrayAccessor on:
+ ((1 to: numAbstractOpcodes + 3 // 4) collect:
+ [:ign| CogInstructionAnnotation new]).
+ opcodeIndex := labelCounter := annotationIndex := 0!
Item was changed:
----- Method: Cogit>>cog:selector: (in category 'jit - api') -----
cog: aMethodObj selector: aSelectorOop
"Attempt to produce a machine code method for the bytecode method
object aMethodObj. N.B. If there is no code memory available do *NOT*
attempt to reclaim the method zone. Certain clients (e.g. ceSICMiss:)
depend on the zone remaining constant across method generation."
<api>
<returnTypeC: #'CogMethod *'>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
self assert: ((coInterpreter methodHasCogMethod: aMethodObj) not
or: [(self noAssertMethodClassAssociationOf: aMethodObj) = objectMemory nilObject]).
"coInterpreter stringOf: aSelectorOop"
coInterpreter
compilationBreak: aSelectorOop
point: (objectMemory lengthOf: aSelectorOop).
aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
self cppIf: NewspeakVM
ifTrue: [cogMethod := methodZone findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop.
cogMethod ifNotNil:
[(coInterpreter methodHasCogMethod: aMethodObj) not ifTrue:
[self assert: (coInterpreter rawHeaderOf: aMethodObj) = cogMethod methodHeader.
cogMethod methodObject: aMethodObj.
coInterpreter rawHeaderOf: aMethodObj put: cogMethod asInteger].
^cogMethod]].
"If the generators for the alternate bytecode set are missing then interpret."
(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj)
ifTrue:
[(self numElementsIn: generatorTable) <= 256 ifTrue:
[^nil].
bytecodeSetOffset := 256]
ifFalse:
[bytecodeSetOffset := 0].
extA := extB := 0.
methodObj := aMethodObj.
cogMethod := self compileCogMethod: aSelectorOop.
(cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
+ [cogMethod asInteger = InsufficientCodeSpace ifTrue:
- [cogMethod asUnsignedInteger = InsufficientCodeSpace ifTrue:
[coInterpreter callForCogCompiledCodeCompaction].
"Right now no errors should be reported, so nothing more to do."
"self reportError: (self cCoerceSimple: cogMethod to: #sqInt)."
^nil].
"self cCode: ''
inSmalltalk:
[coInterpreter printCogMethod: cogMethod.
""coInterpreter symbolicMethod: aMethodObj.""
self assertValidMethodMap: cogMethod."
"self disassembleMethod: cogMethod."
"printInstructions := clickConfirm := true""]."
^cogMethod!
Item was changed:
----- Method: Cogit>>compileCogMethod: (in category 'compile abstract instructions') -----
compileCogMethod: selector
<returnTypeC: #'CogMethod *'>
| numBytecodes numBlocks result extra |
hasYoungReferent := (objectMemory isYoung: methodObj)
or: [objectMemory isYoung: selector].
methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
inBlock := false.
primInvokeLabel := nil.
postCompileHook := nil.
maxLitIndex := -1.
extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
ifTrue: [30]
ifFalse: [10].
initialPC := coInterpreter startPCOfMethod: methodObj.
"initial estimate. Actual endPC is determined in scanMethod."
endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
ifTrue: [initialPC - 1]
ifFalse: [objectMemory byteLengthOf: methodObj].
numBytecodes := endPC - initialPC + 1.
+ self allocateOpcodes: (numBytecodes + extra) * 10
+ bytecodes: numBytecodes
+ ifFail: [^coInterpreter cCoerceSimple: MethodTooBig to: #'CogMethod *'].
- self allocateOpcodes: (numBytecodes + extra) * 10 bytecodes: numBytecodes.
(numBlocks := self scanMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
self allocateBlockStarts: numBlocks.
blockEntryLabel := nil.
methodLabel dependent: nil.
(result := self compileEntireMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
^self generateCogMethod: selector!
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
- [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>>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.
- uniqueAddress := -1 - methodZoneBase - (primitiveIndex * 4) - 16r1000 bitAnd: self addressSpaceMask.
simulatedTrampolines
at: uniqueAddress
ifAbsentPut:
[primitiveRoutine isSymbol
ifTrue: [MessageSend receiver: coInterpreter selector: primitiveRoutine]
ifFalse: [primitiveRoutine]].
^uniqueAddress!
Item was changed:
----- Method: Cogit>>printMethodHeader:on: (in category 'disassembly') -----
printMethodHeader: cogMethod on: aStream
<doNotGenerate>
self cCode: ''
inSmalltalk:
[cogMethod isInteger ifTrue:
[^self printMethodHeader: (self cogMethodOrBlockSurrogateAt: cogMethod) on: aStream]].
aStream ensureCr.
cogMethod asInteger printOn: aStream base: 16.
aStream crtab.
+ cogMethod cmType = CMMethod ifTrue:
+ [aStream nextPutAll: 'objhdr: '.
+ cogMethod objectHeader printOn: aStream base: 16].
+ cogMethod cmType = CMBlock ifTrue:
+ [aStream nextPutAll: 'homemth: '.
+ cogMethod cmHomeMethod asUnsignedInteger printOn: aStream base: 16.
+ aStream crtab; nextPutAll: 'startpc: '; print: cogMethod startpc].
- cogMethod cmType = CMMethod
- ifTrue:
- [aStream nextPutAll: 'objhdr: '.
- cogMethod objectHeader printOn: aStream base: 16]
- ifFalse:
- [aStream nextPutAll: 'homemth: '.
- cogMethod cmHomeMethod asUnsignedInteger printOn: aStream base: 16.
- aStream crtab; nextPutAll: 'startpc: '; print: cogMethod startpc].
aStream
crtab; nextPutAll: 'nArgs: '; print: cogMethod cmNumArgs;
tab; nextPutAll: 'type: '; print: cogMethod cmType.
(cogMethod cmType ~= 0 and: [cogMethod cmType ~= CMBlock]) ifTrue:
[aStream crtab; nextPutAll: 'blksiz: '.
cogMethod blockSize printOn: aStream base: 16.
aStream crtab; nextPutAll: 'method: '.
cogMethod methodObject printOn: aStream base: 16.
aStream crtab; nextPutAll: 'mthhdr: '.
cogMethod methodHeader printOn: aStream base: 16.
aStream crtab; nextPutAll: 'selctr: '.
cogMethod selector printOn: aStream base: 16.
(coInterpreter lookupAddress: cogMethod selector) ifNotNil:
[:string| aStream nextPut: $=; nextPutAll: string].
aStream crtab; nextPutAll: 'blkentry: '.
cogMethod blockEntryOffset printOn: aStream base: 16.
cogMethod blockEntryOffset ~= 0 ifTrue:
[aStream nextPutAll: ' => '.
cogMethod asInteger + cogMethod blockEntryOffset printOn: aStream base: 16]].
cogMethod cmType = CMClosedPIC
ifTrue:
[aStream crtab; nextPutAll: 'cPICNumCases: '.
cogMethod cPICNumCases printOn: aStream base: 16.]
ifFalse:
[aStream crtab; nextPutAll: 'stackCheckOffset: '.
cogMethod stackCheckOffset printOn: aStream base: 16.
cogMethod stackCheckOffset > 0 ifTrue:
[aStream nextPut: $/.
cogMethod asInteger + cogMethod stackCheckOffset printOn: aStream base: 16].
cogMethod cmType ~= CMBlock ifTrue:
[aStream
crtab;
nextPutAll: 'cmRefersToYoung: ';
nextPutAll: (cogMethod cmRefersToYoung ifTrue: ['yes'] ifFalse: ['no'])].
cogMethod cmType = CMMethod ifTrue:
[([cogMethod numCounters] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil:
[:nc| aStream crtab; nextPutAll: 'numCounters: '; print: nc]]].
aStream cr; flush!
Item was changed:
----- Method: Cogit>>simulatedAddressFor: (in category 'initialization') -----
simulatedAddressFor: anObject
"Answer a simulated address for a block or a symbol. This is an address that
can be called, read or written by generated machine code, and will be mapped
+ into a Smalltalk message send or block evaluation.
+
+ N.B. These addresses are at the top end of the bottom half of the address space
+ so that they don't have the sign bit set and so will not look like negative numbers."
- into a Smalltalk message send or block evaluation."
<doNotGenerate>
^simulatedAddresses
at: anObject
+ ifAbsentPut: [(simulatedAddresses size + 101 * BytesPerWord) negated bitAnd: self allButTopBitOfAddressSpaceMask]!
- ifAbsentPut: [(simulatedAddresses size + 101 * BytesPerWord) negated bitAnd: self addressSpaceMask]!
Item was changed:
----- Method: FilePlugin>>primitiveFileRead (in category 'file primitives') -----
primitiveFileRead
<export: true>
| retryCount count startIndex array file elementSize bytesRead |
<var: 'file' type: #'SQFile *'>
<var: 'count' type: #'size_t'>
<var: 'startIndex' type: #'size_t'>
<var: 'elementSize' type: #'size_t'>
retryCount := 0.
count := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
startIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
[array := interpreterProxy stackValue: 2.
file := self fileValueOf: (interpreterProxy stackValue: 3).
(interpreterProxy failed
"buffer can be any indexable words or bytes object except CompiledMethod"
or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1].
(startIndex >= 1
and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
"Note: adjust startIndex for zero-origin indexing"
bytesRead := self
sqFile: file
Read: count * elementSize
+ Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
- Into: (self cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
At: (startIndex - 1) * elementSize.
interpreterProxy primitiveFailureCode = PrimErrObjectMayMove
and: [(retryCount := retryCount + 1) <= 2] "Two objects, the file and the array can move"] whileTrue:
[interpreterProxy
tenuringIncrementalGC;
primitiveFailFor: PrimNoErr].
interpreterProxy failed ifFalse:
[interpreterProxy
pop: 5 "pop rcvr, file, array, startIndex, count"
thenPush:(interpreterProxy integerObjectOf: bytesRead // elementSize) "push # of elements read"]!
Item was changed:
----- Method: FilePlugin>>primitiveFileWrite (in category 'file primitives') -----
primitiveFileWrite
+ | count startIndex array file elementSize bytesWritten |
- | count startIndex array file byteSize arrayIndex bytesWritten |
<var: 'file' type: 'SQFile *'>
<var: 'arrayIndex' type: 'char *'>
<var: 'count' type: 'size_t'>
<var: 'startIndex' type: 'size_t'>
+ <var: 'elementSize' type: 'size_t'>
- <var: 'byteSize' type: 'size_t'>
<export: true>
count := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
startIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
array := interpreterProxy stackValue: 2.
file := self fileValueOf: (interpreterProxy stackValue: 3).
+
+ (interpreterProxy failed
+ "buffer can be any indexable words or bytes object except CompiledMethod"
+ or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+
+ elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1].
+ (startIndex >= 1
+ and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+
+ "Note: adjust startIndex for zero-origin indexing"
+ bytesWritten := self
- "buffer can be any indexable words or bytes object except CompiledMethod "
- (interpreterProxy isWordsOrBytes: array)
- ifFalse: [^ interpreterProxy primitiveFail].
- (interpreterProxy isWords: array)
- ifTrue: [byteSize := 4]
- ifFalse: [byteSize := 1].
- (startIndex >= 1 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)])
- ifFalse: [^ interpreterProxy primitiveFail].
- interpreterProxy failed
- ifFalse: [arrayIndex := interpreterProxy firstIndexableField: array.
- "Note: adjust startIndex for zero-origin indexing"
- bytesWritten := self
sqFile: file
+ Write: count * elementSize
+ From: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
+ At: startIndex - 1 * elementSize.
+ interpreterProxy failed ifFalse:
+ [interpreterProxy pop: 5 thenPush: (interpreterProxy integerObjectOf: bytesWritten // elementSize)]!
- Write: count * byteSize
- From: arrayIndex
- At: startIndex - 1 * byteSize].
- interpreterProxy failed
- ifFalse: [interpreterProxy pop: 5 thenPush:( interpreterProxy integerObjectOf: bytesWritten // byteSize)]!
Item was removed:
- ----- Method: InterpreterSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: NewCoObjectMemory>>copyObj:toSegment:addr:stopAt:saveOopAt:headerAt: (in category 'image segment in/out') -----
copyObj: oop toSegment: segmentWordArray addr: lastSeg stopAt: stopAddr saveOopAt: oopPtr headerAt: hdrPtr
"Copy this object into the segment beginning at lastSeg.
Install a forwarding pointer, and save oop and header.
Fail if out of space. Return the next segmentAddr if successful."
"Copy the object..."
| extraSize bodySize hdrAddr |
<inline: false>
self flag: #Dan. "None of the imageSegment stuff has been updated for 64 bits"
extraSize := self extraHeaderBytes: oop.
bodySize := self sizeBitsOf: oop.
(self oop: (lastSeg + extraSize + bodySize) isGreaterThanOrEqualTo: stopAddr) ifTrue:
[^0]. "failure"
self transfer: extraSize + bodySize // BytesPerWord "wordCount"
from: oop - extraSize
to: lastSeg+BytesPerWord.
"Clear root and mark bits of all headers copied into the segment"
hdrAddr := lastSeg+BytesPerWord + extraSize.
self longAt: hdrAddr put: ((self longAt: hdrAddr) bitAnd: AllButRootBit - MarkBit).
"Make sure Cogged methods have their true header field written to the segment."
((self isCompiledMethod: oop)
+ and: [coInterpreter methodHasCogMethod: oop]) ifTrue:
+ [self longAt: hdrAddr+BaseHeaderSize put: (coInterpreter headerOf: oop)].
- and: [self methodHasCogMethod: oop]) ifTrue:
- [self longAt: hdrAddr+BaseHeaderSize put: (self headerOf: oop)].
self forward: oop to: (lastSeg+BytesPerWord + extraSize - segmentWordArray)
savingOopAt: oopPtr
andHeaderAt: hdrPtr.
"Return new end of segment"
^lastSeg + extraSize + bodySize!
Item was changed:
----- Method: NewCoObjectMemorySimulator>>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: oop >= self startOfMemory.
+ self assert: oop + BaseHeaderSize + (fieldIndex << ShiftForWord) < freeStart.
^super fetchPointer: fieldIndex ofObject: oop!
Item was removed:
- ----- Method: NewCoObjectMemorySimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: NewCoObjectMemorySimulator>>storePointer:ofObject:withValue: (in category 'interpreter access') -----
+ storePointer: fieldIndex ofObject: oop withValue: valuePointer
- 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 <= 4 or: [fmt >= 12])
+ and: [fieldIndex >= 0 and: [fieldIndex < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
+ self assert: oop + BaseHeaderSize + (fieldIndex << ShiftForWord) < freeStart.
+ ^super storePointer: fieldIndex ofObject: oop withValue: valuePointer!
- and: [index >= 0 and: [index < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
- ^super storePointer: index ofObject: oop withValue: valuePointer!
Item was changed:
----- Method: NewCoObjectMemorySimulator>>storePointerUnchecked:ofObject:withValue: (in category 'interpreter access') -----
+ storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
- 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 <= 4 or: [fmt >= 12])
+ and: [fieldIndex >= 0 and: [fieldIndex < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
+ self assert: oop + BaseHeaderSize + (fieldIndex << ShiftForWord) < freeStart.
+ ^super storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer!
- and: [index >= 0 and: [index < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
- ^super storePointerUnchecked: index ofObject: oop withValue: valuePointer!
Item was changed:
----- Method: NewCoObjectMemorySimulatorLSB>>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 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: NewObjectMemory>>checkForLastObjectOverwrite (in category 'allocation') -----
+ checkForLastObjectOverwrite
+ <doNotGenerate>
+ self assert: (freeStart >= scavengeThreshold
+ or: [(AllocationCheckFiller = 0
+ or: [(self longAt: freeStart) = (AllocationCheckFiller = 16rADD4E55
+ ifTrue: [freeStart]
+ ifFalse: [AllocationCheckFiller])])])!
Item was added:
+ ----- Method: NewObjectMemory>>imageSegmentVersion (in category 'image segment in/out') -----
+ imageSegmentVersion
+ | wholeWord |
+ "a more complex version that tells both the word reversal and the endianness of the machine it came from. Low half of word is 6502. Top byte is top byte of #doesNotUnderstand: on this machine. ($d on the Mac or $s on the PC)"
+
+ wholeWord := self longAt: (self splObj: SelectorDoesNotUnderstand) + BaseHeaderSize.
+ "first data word, 'does' "
+ ^coInterpreter imageFormatVersion bitOr: (wholeWord bitAnd: 16rFF000000)!
Item was added:
+ ----- Method: NewObjectMemory>>printMemoryFrom:to: (in category 'printing') -----
+ printMemoryFrom: start to: end
+ <doNotGenerate>
+ | address |
+ address := start bitAnd: (BytesPerWord - 1) bitInvert.
+ [address < end] whileTrue:
+ [coInterpreter printHex: address; printChar: $:; space; printHex: (self longAt: address); cr.
+ address := address + BytesPerWord]!
Item was changed:
----- Method: NewObjectMemory>>safePrintStringOf: (in category 'debug printing') -----
safePrintStringOf: oop
"Version of printStringOf: that copes with forwarding during garbage collection."
| fmt header cnt i |
<inline: false>
(self isIntegerObject: oop) ifTrue:
[^nil].
(oop between: self startOfMemory and: freeStart) ifFalse:
[^nil].
(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
[^nil].
header := self headerWhileForwardingOf: oop.
fmt := self formatOfHeader: header.
fmt < 8 ifTrue: [ ^nil ].
cnt := 100 min: (self lengthOf: oop baseHeader: header format: fmt).
i := 0.
[i < cnt] whileTrue:
[self printChar: (self fetchByte: i ofObject: oop).
i := i + 1].
+ coInterpreter flush.
- self flush.
^oop!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>printMemoryFrom:to: (in category 'printing') -----
- printMemoryFrom: start to: end
- | address |
- address := start bitAnd: (BytesPerWord - 1) bitInvert.
- [address < end] whileTrue:
- [self printHex: address; printChar: $:; space; printHex: (self longAt: address); cr.
- address := address + BytesPerWord]!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
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 changed:
----- Method: NewObjectMemorySimulatorMSB>>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 removed:
- ----- Method: NewspeakInterpreterSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- memory swapBytesFrom: wordAddr // 4 + 1 to: end // 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 |
- self flag: #Dan.
addr := startAddr.
[self oop: addr isLessThan: stopAddr] whileTrue:
[self longAt: addr put: (self byteSwapped: (self longAt: addr)).
addr := addr + BytesPerWord].!
Item was changed:
----- Method: SimpleStackBasedCogit>>doubleExtendedDoAnythingBytecode (in category 'bytecode generators') -----
doubleExtendedDoAnythingBytecode
"Replaces the Blue Book double-extended send [132], in which the first byte was wasted on 8 bits of argument count.
Here we use 3 bits for the operation sub-type (opType), and the remaining 5 bits for argument count where needed.
The last byte give access to 256 instVars or literals.
See also secondExtendedSendBytecode"
| opType |
opType := byte1 >> 5.
opType = 0 ifTrue:
[^self genSend: (self getLiteral: byte2) numArgs: (byte1 bitAnd: 31)].
opType = 1 ifTrue:
[^self genSendSuper: (self getLiteral: byte2) numArgs: (byte1 bitAnd: 31)].
"We need a map entry for this bytecode for correct parsing.
The sends will get an IsSend entry anyway. The other cases need a
fake one. We could of course special case the scanning but that's silly."
opType caseOf: {
+ [2] -> [(coInterpreter isReadMediatedContextInstVarIndex: byte2)
- [2] -> [byte2 <= StackPointerIndex
ifTrue: [self genPushMaybeContextReceiverVariable: byte2]
ifFalse: [self genPushReceiverVariable: byte2]].
[3] -> [self genPushLiteralIndex: byte2].
[4] -> [self genPushLiteralVariable: byte2].
[7] -> [self genStorePop: false LiteralVariable: byte2] }
otherwise: "5 & 6"
+ [(coInterpreter isWriteMediatedContextInstVarIndex: byte2)
- [byte2 <= StackPointerIndex
ifTrue: [self genStorePop: opType = 6 MaybeContextReceiverVariable: byte2]
ifFalse: [self genStorePop: opType = 6 ReceiverVariable: byte2]].
"We need a map entry for this bytecode for correct parsing (if the method builds a frame).
We could of course special case the scanning but that's silly."
needsFrame ifTrue:
[self annotateBytecode: self Label].
^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>genExtPushReceiverVariableBytecode (in category 'bytecode generators') -----
genExtPushReceiverVariableBytecode
"226 11100010 i i i i i i i i Push Receiver Variable #iiiiiiii (+ Extend A * 256)"
| index |
index := byte1 + (extA << 8).
extA := 0.
+ ^(coInterpreter isReadMediatedContextInstVarIndex: index)
+ ifTrue: [self genPushMaybeContextReceiverVariable: index]
+ ifFalse: [self genPushReceiverVariable: index]!
- ^index > StackPointerIndex
- ifTrue: [self genPushReceiverVariable: index]
- ifFalse: [self genPushMaybeContextReceiverVariable: index]!
Item was changed:
----- Method: SimpleStackBasedCogit>>genExtStoreAndPopReceiverVariableBytecode (in category 'bytecode generators') -----
genExtStoreAndPopReceiverVariableBytecode
"235 11101011 i i i i i i i i Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)"
| index |
index := byte1 + (extA << 8).
extA := 0.
+ ^(coInterpreter isWriteMediatedContextInstVarIndex: index)
+ ifTrue: [self genStorePop: true MaybeContextReceiverVariable: index]
+ ifFalse: [self genStorePop: true ReceiverVariable: index]!
- ^index > StackPointerIndex
- ifTrue: [self genStorePop: true ReceiverVariable: index]
- ifFalse: [self genStorePop: true MaybeContextReceiverVariable: index]!
Item was changed:
----- Method: SimpleStackBasedCogit>>genExtStoreReceiverVariableBytecode (in category 'bytecode generators') -----
genExtStoreReceiverVariableBytecode
"232 11101000 i i i i i i i i Store Receiver Variable #iiiiiii (+ Extend A * 256)"
| index |
index := byte1 + (extA << 8).
extA := 0.
+ ^(coInterpreter isWriteMediatedContextInstVarIndex: index)
+ ifTrue: [self genStorePop: false MaybeContextReceiverVariable: index]
+ ifFalse: [self genStorePop: false ReceiverVariable: index]!
- ^index > StackPointerIndex
- ifTrue: [self genStorePop: false ReceiverVariable: index]
- ifFalse: [self genStorePop: false MaybeContextReceiverVariable: index]!
Item was changed:
----- Method: StackInterpreter class>>initializeContextIndices (in category 'initialization') -----
initializeContextIndices
"Class MethodContext"
| contextFixedSizePlusHeader |
SenderIndex := 0.
InstructionPointerIndex := 1.
StackPointerIndex := 2.
MethodIndex := 3.
+ ClosureIndex := 4. "N.B. Called receiverMap in old images, closureOrNil in newer images."
- ClosureIndex := 4. "N.B. Called receiverMap in the image."
ReceiverIndex := 5.
CtxtTempFrameStart := 6.
"Class BlockClosure"
ClosureOuterContextIndex := 0.
ClosureStartPCIndex := 1.
ClosureNumArgsIndex := 2.
ClosureFirstCopiedValueIndex := 3.
ClosureCopiedValuesIndex := 3.
contextFixedSizePlusHeader := CtxtTempFrameStart + 1.
SmallContextSize := contextFixedSizePlusHeader + 16 * BytesPerWord. "16 indexable fields"
+ "Large contexts have 56 indexable fields. Max with single header word."
- "Large contexts have 56 indexable fileds. Max with single header word."
"However note that in 64 bits, for now, large contexts have 3-word headers"
LargeContextSize := contextFixedSizePlusHeader + 56 * BytesPerWord!
Item was changed:
----- Method: StackInterpreter class>>preambleCCode (in category 'translation') -----
preambleCCode
^
+ '/* Disable Intel compiler inlining of warning which is used for breakpoints */
- 'void printCallStack(void);
-
- /* Disable Intel compiler inlining of warning which is used for breakpoints */
#pragma auto_inline off
void
warning(char *s) { /* Print an error message but don''t exit. */
printf("\n%s\n", s);
}
+ void
+ warningat(char *s, int l) { /* ditto with line number. */
+ #if 0
+ printf("\n%s %d\n", s, l);
+ #else /* use alloca to call warning so one does not have to remember to set two breakpoints... */
+ char *sl = alloca(strlen(s) + 16);
+ sprintf(sl, "%s %d", s, l);
+ warning(sl);
+ #endif
+ }
#pragma auto_inline on
void
invalidCompactClassError(char *s) { /* Print a compact class index error message and exit. */
- static sqInt printingStack = true; /* not running at this point */
-
printf("\nClass %s does not have the required compact class index\n", s);
exit(-1);
}
/*
* Define sigsetjmp and siglongjmp to be the most minimal setjmp/longjmp available on the platform.
*/
#if WIN32
# define sigsetjmp(jb,ssmf) setjmp(jb)
# define siglongjmp(jb,v) longjmp(jb,v)
#else
# define sigsetjmp(jb,ssmf) _setjmp(jb)
# define siglongjmp(jb,v) _longjmp(jb,v)
#endif
'!
Item was changed:
----- Method: StackInterpreter>>assertValidExecutionPointe:r:s: (in category 'debug support') -----
assertValidExecutionPointe: lip r: lifp s: lisp
+ <inline: true>
<var: #lip type: #'usqInt'>
<var: #lifp type: #'char *'>
<var: #lisp type: #'char *'>
+ self assertValidExecutionPointe: lip r: lifp s: lisp imbar: (self isMachineCodeFrame: lifp) not line: #'__LINE__'!
- self assertValidExecutionPointe: lip r: lifp s: lisp imbar: (self isMachineCodeFrame: lifp) not!
Item was removed:
- ----- Method: StackInterpreter>>assertValidExecutionPointe:r:s:imbar: (in category 'debug support') -----
- assertValidExecutionPointe: lip r: lfp s: lsp imbar: inInterpreter
- <var: #lip type: #usqInt>
- <var: #lfp type: #'char *'>
- <var: #lsp type: #'char *'>
- self assert: inInterpreter.
- self assert: stackPage = (stackPages stackPageFor: lfp).
- self assert: stackPage = stackPages mostRecentlyUsedPage.
- self assertValidStackLimits.
- self assert: lfp < stackPage baseAddress.
- self assert: lsp < lfp.
- self assert: lfp > lsp.
- self assert: lsp >= (stackPage realStackLimit - self stackLimitOffset).
- self assert: (lfp - lsp) < LargeContextSize.
- self assert: (self validInstructionPointer: lip inFrame: lfp).
- self assert: ((self frameIsBlockActivation: lfp)
- or: [(self pushedReceiverOrClosureOfFrame: lfp) = (self frameReceiver: lfp)]).
- self assert: method = (self frameMethod: lfp).
- self cppIf: MULTIPLEBYTECODESETS
- ifTrue: [self assert: (self methodUsesAlternateBytecodeSet: method) = (bytecodeSetSelector = 256)].!
Item was added:
+ ----- Method: StackInterpreter>>assertValidExecutionPointe:r:s:imbar:line: (in category 'debug support') -----
+ assertValidExecutionPointe: lip r: lfp s: lsp imbar: inInterpreter line: ln
+ <var: #lip type: #usqInt>
+ <var: #lfp type: #'char *'>
+ <var: #lsp type: #'char *'>
+ self assert: inInterpreter l: ln.
+ self assert: stackPage = (stackPages stackPageFor: lfp) l: ln.
+ self assert: stackPage = stackPages mostRecentlyUsedPage l: ln.
+ self assertValidStackLimits: ln.
+ self assert: lfp < stackPage baseAddress l: ln.
+ self assert: lsp < lfp l: ln.
+ self assert: lfp > lsp l: ln.
+ self assert: lsp >= (stackPage realStackLimit - self stackLimitOffset) l: ln.
+ self assert: (lfp - lsp) < LargeContextSize l: ln.
+ self assert: (self validInstructionPointer: lip inFrame: lfp) l: ln.
+ self assert: ((self frameIsBlockActivation: lfp)
+ or: [(self pushedReceiverOrClosureOfFrame: lfp) = (self frameReceiver: lfp)])
+ l: ln.
+ self assert: method = (self frameMethod: lfp) l: ln.
+ self cppIf: MULTIPLEBYTECODESETS
+ ifTrue: [self assert: (self methodUsesAlternateBytecodeSet: method) = (bytecodeSetSelector = 256) l: ln].!
Item was added:
+ ----- Method: StackInterpreter>>assertValidExecutionPointers (in category 'debug support') -----
+ assertValidExecutionPointers
+ <doNotGenerate> "simulator only"
+ self assertValidExecutionPointe: localIP r: localFP s: localSP!
Item was removed:
- ----- Method: StackInterpreter>>assertValidStackLimits (in category 'process primitive support') -----
- assertValidStackLimits
- <returnTypeC: #void>
- "Order in the stackLimit checks is important because stackLimit is smashed by
- interrupts. So always check for unsmashed value first to avoid race condition."
- self assert: (stackLimit = stackPage realStackLimit
- or: [stackLimit = (self cCoerceSimple: -1 signedIntToLong to: 'char *')]).
- self assert: (stackPage stackLimit = stackPage realStackLimit
- or: [stackPage stackLimit = (self cCoerceSimple: -1 signedIntToLong to: 'char *')])!
Item was added:
+ ----- Method: StackInterpreter>>assertValidStackLimits: (in category 'process primitive support') -----
+ assertValidStackLimits: ln
+ <returnTypeC: #void>
+ "Order in the stackLimit checks is important because stackLimit is smashed by
+ interrupts. So always check for unsmashed value first to avoid race condition."
+ self assert: (stackLimit = stackPage realStackLimit
+ or: [stackLimit = (self cCoerceSimple: -1 signedIntToLong to: #'char *')])
+ l: ln.
+ self assert: (stackPage stackLimit = stackPage realStackLimit
+ or: [stackPage stackLimit = (self cCoerceSimple: -1 signedIntToLong to: #'char *')])
+ l: ln!
Item was changed:
----- Method: StackInterpreter>>dispatchFunctionPointer: (in category 'message sending') -----
dispatchFunctionPointer: aFunctionPointer
"In C aFunctionPointer is void (*aFunctionPointer)()"
<cmacro: '(aFunctionPointer) (aFunctionPointer)()'>
+ | result |
(aFunctionPointer isInteger
and: [aFunctionPointer >= 1000]) ifTrue:
+ [result := self callExternalPrimitive: aFunctionPointer.
+ objectMemory checkForLastObjectOverwrite.
+ ^result].
- [^self callExternalPrimitive: aFunctionPointer].
"In Smalltalk aFunctionPointer is a message selector symbol"
+ result := self perform: aFunctionPointer.
+ objectMemory checkForLastObjectOverwrite.
+ ^result!
- ^self perform: aFunctionPointer!
Item was changed:
----- Method: StackInterpreter>>externalSetStackPageAndPointersForSuspendedContextOfProcess: (in category 'frame access') -----
externalSetStackPageAndPointersForSuspendedContextOfProcess: aProcess
+ "Set stackPage, instructionPointer, framePointer and stackPointer for the suspendedContext of
+ aProcess, marrying the context if necessary, and niling the suspendedContext slot. This is used
- "Set stackPage, framePointer and stackPointer for the suspendedContext of aProcess,
- marrying the context if necessary, and niling the suspendedContext slot. This is used
on process switch to ensure a context has a stack frame and so can continue execution."
| newContext theFrame thePage newPage |
<var: #theFrame type: #'char *'>
<var: #thePage type: #'StackPage *'>
<var: #newPage type: #'StackPage *'>
newContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: aProcess.
self assert: (objectMemory isContext: newContext).
(self isMarriedOrWidowedContext: newContext) ifTrue:
[self assert: (self checkIsStillMarriedContext: newContext currentFP: framePointer)].
objectMemory
storePointerUnchecked: SuspendedContextIndex
ofObject: aProcess
withValue: objectMemory nilObject.
(self isStillMarriedContext: newContext)
ifTrue:
[theFrame := self frameOfMarriedContext: newContext.
thePage := stackPages stackPageFor: theFrame.
theFrame ~= thePage headFP ifTrue:
["explicit assignment of suspendedContext can cause switch to interior frame."
newPage := self newStackPage.
self moveFramesIn: thePage
through: (self findFrameAbove: theFrame inPage: thePage)
toPage: newPage.
stackPages markStackPageLeastMostRecentlyUsed: newPage].
self assert: thePage headFP = theFrame]
ifFalse:
[thePage := self makeBaseFrameFor: newContext.
theFrame := thePage baseFP].
self setStackPageAndLimit: thePage.
stackPointer := thePage headSP.
framePointer := thePage headFP.
(self isMachineCodeFrame: framePointer) ifFalse:
+ [self setMethod: (self iframeMethod: framePointer)]..
+ instructionPointer := self popStack.
+ self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer!
- [self setMethod: (self iframeMethod: framePointer)].
- self assertValidExecutionPointe: self stackTop asUnsignedInteger r: framePointer s: stackPointer!
Item was changed:
----- Method: StackInterpreter>>findClassOfMethod:forReceiver: (in category 'debug support') -----
findClassOfMethod: meth forReceiver: rcvr
| rclass |
(objectMemory addressCouldBeOop: rcvr) ifTrue:
[rclass := objectMemory fetchClassOf: rcvr.
(self addressCouldBeClassObj: rclass) ifTrue:
[rclass := self findClassContainingMethod: meth startingAt: rclass.
rclass ~= objectMemory nilObject ifTrue:
[^rclass]]].
+ ((objectMemory addressCouldBeObj: meth)
+ and: [self isCompiledMethod: meth]) ifFalse:
- (objectMemory addressCouldBeObj: meth) ifFalse:
[^objectMemory nilObject].
^self findClassContainingMethod: meth startingAt: (self methodClassOf: meth)!
Item was changed:
----- Method: StackInterpreter>>instVar:ofContext:put: (in category 'frame access') -----
instVar: index ofContext: aMarriedContext put: anOop
| theFP |
"Assign the field of a married context. The important case to optimize is
assigning the sender. We could also consider optimizing assiging the IP but
typically that is followed by an assignment to the stack pointer and we can't
efficiently assign the stack pointer because it involves moving frames around."
<inline: true>
self assert: (self isMarriedOrWidowedContext: aMarriedContext).
self writeBackHeadFramePointers.
(self isStillMarriedContext: aMarriedContext) ifFalse:
[objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop.
index = StackPointerIndex ifTrue:
[self ensureContextIsExecutionSafeAfterAssignToStackPointer: aMarriedContext].
^nil].
theFP := self frameOfMarriedContext: aMarriedContext.
index == SenderIndex ifTrue:
[| thePage onCurrentPage |
thePage := stackPages stackPageFor: theFP.
self assert: stackPage = stackPages mostRecentlyUsedPage.
onCurrentPage := thePage = stackPage.
self storeSenderOfFrame: theFP withValue: anOop.
onCurrentPage
ifTrue:
[localFP := stackPage headFP.
localSP := stackPage headSP]
ifFalse:
[stackPages markStackPageMostRecentlyUsed: stackPage].
^nil].
self externalizeIPandSP.
self externalDivorceFrame: theFP andContext: aMarriedContext.
objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop.
index = StackPointerIndex ifTrue:
[self ensureContextIsExecutionSafeAfterAssignToStackPointer: aMarriedContext].
self internalizeIPandSP.
"Assigning various fields can force a divorce which can change the stackPage."
stackPages markStackPageMostRecentlyUsed: stackPage.
+ self assertValidExecutionPointe: localIP asUnsignedInteger r: localFP s: localSP imbar: true line: #'__LINE__'!
- self assertValidExecutionPointe: localIP asUnsignedInteger r: localFP s: localSP imbar: true!
Item was added:
+ ----- Method: StackInterpreter>>isReadMediatedContextInstVarIndex: (in category 'frame access') -----
+ isReadMediatedContextInstVarIndex: index
+ "Reading the sender, instructionPointer and stackPointer inst vars of a context must take
+ account of potentially married contexts and fetch the state from the frame. method,
+ closureOrNil and receiver can safely be fetched from the context without checking."
+ <api>
+ <inline: true>
+ ^index <= StackPointerIndex!
Item was added:
+ ----- Method: StackInterpreter>>isWriteMediatedContextInstVarIndex: (in category 'frame access') -----
+ isWriteMediatedContextInstVarIndex: index
+ "Wrining any inst vars of a context must take account of potentially married contexts
+ and set the state in the frame. Inst vars in subclasses don't need mediation; subclasses
+ can't marry."
+ <api>
+ <inline: true>
+ ^index <= ReceiverIndex!
Item was changed:
----- Method: StackInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
printFrame: theFP WithSP: theSP
+ <api>
| theMethod numArgs topThing |
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #addr type: #'char *'>
self cCode: '' inSmalltalk: [self transcript ensureCr].
theMethod := self frameMethod: theFP.
numArgs := self frameNumArgs: theFP.
self shortPrintFrame: theFP.
self printFrameOop: 'rcvr/clsr'
at: theFP + FoxCallerSavedIP + ((numArgs + 1) * BytesPerWord).
numArgs to: 1 by: -1 do:
[:i| self printFrameOop: 'arg' at: theFP + FoxCallerSavedIP + (i * BytesPerWord)].
self printFrameThing: 'cllr ip/ctxt' at: theFP + FoxCallerSavedIP.
self printFrameThing: 'saved fp' at: theFP + FoxSavedFP.
self printFrameOop: 'method' at: theFP + FoxMethod.
self printFrameFlagsForFP: theFP.
self printFrameThing: 'context' at: theFP + FoxThisContext.
self printFrameOop: 'receiver' at: theFP + FoxReceiver.
topThing := stackPages longAt: theSP.
(topThing >= theMethod
and: [topThing <= (theMethod + (objectMemory sizeBitsOfSafe: theMethod))])
ifTrue:
[theFP + FoxReceiver - BytesPerWord to: theSP + BytesPerWord by: BytesPerWord negated do:
[:addr|
self printFrameOop: 'temp/stck' at: addr].
self printFrameThing: 'frame ip' at: theSP]
ifFalse:
[theFP + FoxReceiver - BytesPerWord to: theSP by: BytesPerWord negated do:
[:addr|
self printFrameOop: 'temp/stck' at: addr]]!
Item was changed:
----- Method: StackInterpreter>>pushMaybeContextReceiverVariable: (in category 'stack bytecodes') -----
pushMaybeContextReceiverVariable: fieldIndex
"Must trap accesses to married and widowed contexts.
But don't want to check on all inst var accesses. This
method is only used by the long-form bytecodes, evading
the cost. Note that the method, closure and receiver fields
of married contexts are correctly initialized so they don't
need special treatment on read. Only sender, instruction
pointer and stack pointer need to be intercepted on reads."
| rcvr |
<inline: true>
rcvr := self receiver.
+ ((self isReadMediatedContextInstVarIndex: fieldIndex)
- (fieldIndex < MethodIndex
and: [objectMemory isContextNonInt: rcvr])
ifTrue:
[self internalPush: (self instVar: fieldIndex ofContext: rcvr)]
ifFalse:
[self internalPush: (objectMemory fetchPointer: fieldIndex ofObject: rcvr)]!
Item was changed:
----- Method: StackInterpreter>>storeMaybeContextReceiverVariable:withValue: (in category 'stack bytecodes') -----
storeMaybeContextReceiverVariable: fieldIndex withValue: anObject
"Must trap accesses to married and widowed contexts.
But don't want to check on all inst var accesses. This
method is only used by the long-form bytecodes, evading the cost."
| rcvr |
rcvr := self receiver.
+ ((self isWriteMediatedContextInstVarIndex: fieldIndex)
- (fieldIndex <= ReceiverIndex
and: [(objectMemory isContextNonInt: rcvr)
and: [self isMarriedOrWidowedContext: rcvr]])
ifTrue:
[self instVar: fieldIndex ofContext: rcvr put: anObject]
ifFalse:
[objectMemory storePointer: fieldIndex ofObject: rcvr withValue: anObject]
!
Item was changed:
----- Method: StackInterpreter>>transferTo: (in category 'process primitive support') -----
transferTo: newProc
"Record a process to be awoken on the next interpreter cycle."
| activeContext sched oldProc |
<inline: false>
statProcessSwitch := statProcessSwitch + 1.
self push: instructionPointer.
self externalWriteBackHeadFramePointers.
+ self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer.
sched := self schedulerPointer.
oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext.
objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc.
objectMemory storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject.
+ self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc!
- self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc.
- instructionPointer := self popStack!
Item was changed:
----- Method: StackInterpreterPrimitives>>field:ofFrame: (in category 'object access primitives') -----
field: index ofFrame: theFP
"Arrange to answer naked frame pointers for unmarried
senders to avoid reifying contexts in the search."
<var: #theFP type: #'char *'>
<inline: false>
| callerFP |
<var: #callerFP type: #'char *'>
^index caseOf:
{[SenderIndex] -> [callerFP := self frameCallerFP: theFP.
callerFP = 0
ifTrue: [self frameCallerContext: theFP]
ifFalse: [(self frameHasContext: callerFP)
ifTrue: [self assert: (self checkIsStillMarriedContext: (self frameContext: callerFP) currentFP: nil).
self frameContext: callerFP]
+ ifFalse: [callerFP asInteger]]].
- ifFalse: [callerFP]]].
[StackPointerIndex] -> [ConstZero].
[InstructionPointerIndex] -> [ConstZero].
[MethodIndex] -> [self frameMethodObject: theFP].
[ClosureIndex] -> [(self frameIsBlockActivation: theFP)
ifTrue: [self frameStackedReceiver: theFP
numArgs: (self frameNumArgs: theFP)]
ifFalse: [objectMemory nilObject]].
[ReceiverIndex] -> [self frameReceiver: theFP] }
otherwise:
[self assert: (index - CtxtTempFrameStart between: 0 and: (self stackPointerIndexForFrame: theFP)).
self temporary: index - CtxtTempFrameStart in: theFP]!
Item was removed:
- ----- Method: StackInterpreterSimulator>>assertValidExecutionPointers (in category 'testing') -----
- assertValidExecutionPointers
- self assertValidExecutionPointe: localIP r: localFP s: localSP!
Item was removed:
- ----- Method: StackInterpreterSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- objectMemory memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: StackToRegisterMappingCogit>>doubleExtendedDoAnythingBytecode (in category 'bytecode generators') -----
doubleExtendedDoAnythingBytecode
"Replaces the Blue Book double-extended send [132], in which the first byte was wasted on 8 bits of argument count.
Here we use 3 bits for the operation sub-type (opType), and the remaining 5 bits for argument count where needed.
The last byte give access to 256 instVars or literals.
See also secondExtendedSendBytecode"
| opType |
opType := byte1 >> 5.
opType = 0 ifTrue:
[^self genSend: (self getLiteral: byte2) numArgs: (byte1 bitAnd: 31)].
opType = 1 ifTrue:
[^self genSendSuper: (self getLiteral: byte2) numArgs: (byte1 bitAnd: 31)].
"We need a map entry for this bytecode for correct parsing.
The sends will get an IsSend entry anyway. The other cases need a
fake one. We could of course special case the scanning but that's silly."
opType caseOf: {
+ [2] -> [(coInterpreter isReadMediatedContextInstVarIndex: byte2)
- [2] -> [byte2 <= StackPointerIndex
ifTrue: [self genPushMaybeContextReceiverVariable: byte2]
ifFalse: [self genPushReceiverVariable: byte2.
self ssTop annotateUse: true.
^0]].
[3] -> [self genPushLiteralIndex: byte2.
self ssTop annotateUse: true.
^0].
[4] -> [self genPushLiteralVariable: byte2.].
[7] -> [self genStorePop: false LiteralVariable: byte2] }
otherwise: "5 & 6"
+ [(coInterpreter isWriteMediatedContextInstVarIndex: byte2)
- [byte2 <= StackPointerIndex
ifTrue: [self genStorePop: opType = 6 MaybeContextReceiverVariable: byte2]
ifFalse: [self genStorePop: opType = 6 ReceiverVariable: byte2]].
"We need a map entry for this bytecode for correct parsing (if the method builds a frame).
We could of course special case the scanning but that's silly (or is it?)."
self assert: needsFrame.
"genPushMaybeContextInstVar, pushListVar, store & storePop all generate code"
self assert: self prevInstIsPCAnnotated not.
self annotateBytecode: self Label.
^0!
Item was changed:
----- Method: TMethod>>argAssignmentsFor:args:in: (in category 'inlining') -----
argAssignmentsFor: meth args: argList in: aCodeGen
"Return a collection of assignment nodes that assign the given argument expressions to the formal parameter variables of the given method."
"Optimization: If the actual parameters are either constants or local variables in the target method (the receiver), substitute them directly into the body of meth. Note that global variables cannot be subsituted because the inlined method might depend on the exact ordering of side effects to the globals."
| stmtList substitutionDict |
stmtList := OrderedCollection new: 100.
substitutionDict := Dictionary new: 100.
meth args with: argList do:
[ :argName :exprNode |
+ (self isNode: exprNode substitutableFor: argName inMethod: meth in: aCodeGen)
- (self isSubstitutableNode: exprNode intoMethod: meth in: aCodeGen)
ifTrue:
[substitutionDict at: argName put: exprNode.
locals remove: argName]
ifFalse:
[stmtList add: (TAssignmentNode new
setVariable: (TVariableNode new setName: argName)
expression: exprNode copy)]].
meth parseTree: (meth parseTree bindVariablesIn: substitutionDict).
^stmtList!
Item was added:
+ ----- Method: TMethod>>isNode:substitutableFor:inMethod:in: (in category 'inlining') -----
+ isNode: aNode substitutableFor: argName inMethod: targetMeth in: aCodeGen
+ "Answer true if the given parameter node is either a constant, a local variable, or a formal parameter of the receiver. Such parameter nodes may be substituted directly into the body of the method during inlining. Note that global variables cannot be subsituted into methods with possible side effects (i.e., methods that may assign to global variables) because the inlined method might depend on having the value of the global variable captured when it is passed in as an argument."
+
+ | var |
+ aNode isConstant ifTrue: [^true].
+
+ aNode isVariable ifTrue:
+ [var := aNode name.
+ ((locals includes: var) or: [args includes: var]) ifTrue: [^true].
+ (#(self true false nil) includes: var) ifTrue: [^true].
+ "We can substitute any variable provided it is only read in the method being inlined."
+ (targetMeth isComplete
+ and: [targetMeth parseTree noneSatisfy:
+ [:node|
+ node isAssignment and: [node variable name = argName]]]) ifTrue:
+ [^true].
+ (targetMeth maySubstituteGlobal: var in: aCodeGen) ifTrue: [^true]].
+
+ "For now allow literal blocks to be substituted. They better be accessed only
+ with value[:value:*] messages though!!"
+ aNode isStmtList ifTrue: [^true].
+
+ "scan expression tree; must contain only constants, builtin ops, and inlineable vars"
+ aNode nodesDo: [ :node |
+ node isSend ifTrue: [
+ node isBuiltinOperator ifFalse: [^false].
+ ].
+ node isVariable ifTrue: [
+ var := node name.
+ ((locals includes: var) or:
+ [(args includes: var) or:
+ [(#(self true false nil) includes: var) or:
+ [targetMeth maySubstituteGlobal: var in: aCodeGen]]]) ifFalse: [^false].
+ ].
+ (node isConstant or: [node isVariable or: [node isSend]]) ifFalse: [^false].
+ ].
+
+ ^ true!
Item was changed:
----- Method: TMethod>>prepareMethodIn: (in category 'transformations') -----
prepareMethodIn: aCodeGen
"Record sends of builtin operators, map sends of the special selector dispatchOn:in:
with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements.
Note: Only replaces top-level sends of dispatchOn:in: et al and caseOf:[otherwise:].
These must be top-level statements; they cannot appear in expressions.
As a hack also update the types of variables introduced to implement cascades correctly.
This has to be done at teh same time as this is done, so why not piggy back here?"
| replacements |.
cascadeVariableNumber ifNotNil:
[declarations keysAndValuesDo:
[:varName :decl|
decl isBlock ifTrue:
[self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]).
locals add: varName.
self declarationAt: varName
put: (decl value: self value: aCodeGen), ' ', varName]]].
replacements := IdentityDictionary new.
aCodeGen
pushScope: declarations
while:
[parseTree nodesDo:
[:node|
node isSend ifTrue:
+ [(aCodeGen isBuiltinSelector: node selector)
- [(aCodeGen builtin: node selector)
ifTrue:
[node isBuiltinOperator: true.
"If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args"
(node selector = #to:by:do:
and: [node args size = 4]) ifTrue:
[| limitExpr |
limitExpr := node args first.
(limitExpr anySatisfy:
[:subNode|
subNode isSend
+ and: [(aCodeGen isBuiltinSelector: subNode selector) not
- and: [(aCodeGen builtin: subNode selector) not
and: [(subNode isStructSend: aCodeGen) not]]])
ifTrue: [locals add: node args last name]
ifFalse:
[node arguments: node args allButLast]]]
ifFalse:
[(CaseStatements includes: node selector) ifTrue:
[replacements at: node put: (self buildCaseStmt: node)].
(#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
[replacements at: node put: (self buildSwitchStmt: node)]]].
((node isAssignment or: [node isReturn])
and: [node expression isSwitch]) ifTrue:
[replacements at: node put: (self transformSwitchExpression: node)]]].
replacements isEmpty ifFalse:
[parseTree := parseTree replaceNodesIn: replacements]!
Item was changed:
----- Method: TSendNode>>bindVariableUsesIn:andConstantFoldIf:in: (in category 'transformations') -----
bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen
"Answer either the receiver, if it contains no references to the given variables, or a new node with the given variables rebound.
Attempt to constant-fold and answer a constant node commented with the original expression.
Commenting with the original expression is important because it allows us to detect shared cases.
e.g. currentBytecode bitAnd: 15 is the same in case 1 and case 17, but '1 /* 1 bitAnd: 15 */' differs
from '1 /* 17 bitAnd: 15 */', whereas '1 /* currentBytecode bitAnd: 15 */' doesn't change."
| newReceiver newArguments |
newReceiver := receiver bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen.
newArguments := arguments collect: [:a| a bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen].
(newReceiver = receiver
and: [newArguments = arguments]) ifTrue:
[^self].
(constantFold
and: [newReceiver isConstant and: [newReceiver value isInteger]
and: [(newArguments allSatisfy: [:ea| ea isConstant and: [ea value isInteger]])
+ and: [codeGen isBuiltinSelector: selector]]]) ifTrue:
- and: [codeGen builtin: selector]]]) ifTrue:
[| value |
value := [newReceiver value perform: selector withArguments: (newArguments collect: [:ea| ea value])]
on: Error
do: [:ea| nil].
(value isInteger
or: [value == true
or: [value == false]]) ifTrue:
[^TConstantNode new
setValue: value;
"We assume Message prints its keywords and arguments interleaved.
e.g. that (Message selector: #between:and: arguments: #(0 1)) printString = 'between: 0 and: 1'"
comment: (receiver isLeaf
ifTrue: [receiver printString]
ifFalse: ['(', receiver printString, ')']),
' ',
(Message selector: selector arguments: (arguments collect: [:ea| ea value])) printString;
yourself]].
^self shallowCopy
receiver: newReceiver;
arguments: newArguments;
yourself
!
Item was added:
+ ----- Method: VMClass>>assert:l: (in category 'debug support') -----
+ assert: aBooleanExpression l: linenum
+ <doNotGenerate>
+ ^self assert: aBooleanExpression!
Item was added:
+ ----- Method: VMClass>>asserta:l: (in category 'debug support') -----
+ asserta: aBooleanExpression l: linenum
+ <doNotGenerate>
+ ^self asserta: aBooleanExpression!
Item was changed:
----- Method: VMClass>>cppIf:ifTrue: (in category 'translation support') -----
cppIf: conditionBlockOrValue ifTrue: trueExpressionOrBlock
"When translated, produces #if (condition) #else #endif CPP directives.
Example usage:
self cppIf: IMMUTABILITY
ifTrue: [(self internalIsImmutable: obj) ifTrue:
[^self primitiveFailFor: PrimErrNoModification]]"
+ ^self cppIf: conditionBlockOrValue ifTrue: trueExpressionOrBlock ifFalse: nil!
- ^self cppIf: conditionBlockOrValue ifTrue: trueExpressionOrBlock ifFalse: []!
Item was changed:
----- Method: VMClass>>cppIf:ifTrue:ifFalse: (in category 'translation support') -----
+ cppIf: conditionBlockOrSymbolValue ifTrue: trueExpressionOrBlock ifFalse: falseExpressionOrBlockOrNil
- cppIf: conditionBlockOrValue ifTrue: trueExpressionOrBlock ifFalse: falseExpressionOrBlockOrNil
"When translated, produces #if (condition) #else #endif CPP directives.
Example usage:
self cppIf: [BytesPerWord = 8]
ifTrue: [self doSomethingFor64Bit]
ifFalse: [self doSomethingFor32Bit]
self cppIf: BytesPerWord = 8
ifTrue: [self doSomethingFor64Bit]
+ ifFalse: [self doSomethingFor32Bit]
+ self cppIf: #A_GLOBAL
+ ifTrue: [self doSomethingFor64Bit]
ifFalse: [self doSomethingFor32Bit]"
+ ^(conditionBlockOrSymbolValue value
- ^(conditionBlockOrValue value
ifNil: [false]
ifNotNil: [:value|
value isInteger
ifTrue: [value ~= 0]
+ ifFalse:
+ [value isSymbol
+ ifTrue: [(self class bindingOf: value)
+ ifNil: [false]
+ ifNotNil: [:binding| binding value]]
+ ifFalse: [value]]])
- ifFalse: [value]])
ifTrue: trueExpressionOrBlock
ifFalse: falseExpressionOrBlockOrNil!
Item was changed:
----- Method: VMClass>>promptHex: (in category 'simulation support') -----
promptHex: string
<doNotGenerate>
| s |
s := UIManager default request: string, ' (hex)'.
^s notEmpty ifTrue:
+ [(s includes: $r)
+ ifTrue:
+ [Number readFrom: s readStream]
+ ifFalse:
+ [(#('0x' '-0x') detect: [:prefix| s beginsWith: prefix] ifNone: []) ifNotNil:
+ [:prefix|
+ s := s allButFirst: prefix size.
+ prefix first = $- ifTrue: [s := '-', s]].
+ Integer readFrom: s readStream base: 16]]!
- [(#('16r' '-16r' '0x' '-0x') detect: [:prefix| s beginsWith: prefix] ifNone: []) ifNotNil:
- [:prefix|
- s := s allButFirst: prefix size.
- prefix first = $- ifTrue: [s := '-', s]].
- Integer readFrom: s readStream base: 16]!
Item was changed:
----- Method: VMPluginCodeGenerator>>emitCHeaderOn: (in category 'C code generator') -----
emitCHeaderOn: aStream
"Write a C file header onto the given stream."
aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: pluginClass).
aStream cr; cr.
#('<math.h>' '<stdio.h>' '<stdlib.h>' '<string.h>' '<time.h>') reverseDo:
[:hdr| self addHeaderFileFirst: hdr].
"Additional header files; include C library ones first."
self emitHeaderFiles: (headerFiles select: [:hdr| hdr includes: $<]) on: aStream.
aStream cr; nextPutAll:'/* Default EXPORT macro that does nothing (see comment in sq.h): */
#define EXPORT(returnType) returnType
/* Do not include the entire sq.h file but just those parts needed. */
/* The virtual machine proxy definition */
#include "sqVirtualMachine.h"
/* Configuration options */
#include "sqConfig.h"
/* Platform specific definitions */
#include "sqPlatformSpecific.h"
#define true 1
#define false 0
#define null 0 /* using ''null'' because nil is predefined in Think C */
#ifdef SQUEAK_BUILTIN_PLUGIN
#undef EXPORT
// was #undef EXPORT(returnType) but screws NorCroft cc
#define EXPORT(returnType) static returnType
#endif'; cr; cr.
self addHeaderFile: '"sqMemoryAccess.h"'.
"Additional header files; include squeak VM ones last"
self emitHeaderFiles: (headerFiles reject: [:hdr| hdr includes: $<]) on: aStream.
+ self maybePutPreambleFor: pluginClass on: aStream.
- pluginClass preambleCCode ifNotNil:
- [:preamble|
- aStream cr; nextPutAll: preamble].
aStream cr.!
Item was changed:
----- Method: VMPluginCodeGenerator>>pluginFunctionsToClone (in category 'public') -----
pluginFunctionsToClone
"Answer those of the used plugin functions to clone as a sorted collection.
Exclude those that are static to sqVirtualMachine.c and hence always need
to be called through interpreterProxy."
+ ^((pluginFunctionsUsed
+ reject: [:selector| self noteUsedPluginFunction: selector])
+ select: [:selector| InterpreterProxy includesSelector: selector])
+ asSortedCollection!
- ^(pluginFunctionsUsed reject:
- [:selector| self noteUsedPluginFunction: selector])
- asSortedCollection!
Item was added:
+ ----- Method: VMStructType class>>alignedByteSizeOf:forClient: (in category 'simulation only') -----
+ alignedByteSizeOf: objectSymbolOrClass forClient: aVMClass
+ ^objectSymbolOrClass byteSizeForSimulator: aVMClass!
More information about the Vm-dev
mailing list