[Vm-dev] VM Maker: VMMaker.oscog-eem.1596.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Dec 15 18:55:06 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1596.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1596
Author: eem
Time: 15 December 2015, 10:53:18.704 am
UUID: b5172901-ebc3-4132-b421-446d4a1d080f
Ancestors: VMMaker.oscog-rmacnak.1595
64 vs 32 bits. Clarify translation of signedInt[From|To]Long[64]. signedInt[From|To]Long always operates on 32-bits and signedInt[From|To]Long64 always operates on 64-bits; there is no signedInt[From|To]MachineInteger.
Refactor casting -1 as a stack limit into allOnesAsCharStar.
Cogit: Fix regression in x86's register save/restore.
Nuke uses of thirtyTwoBitLiteralBefore: in favour of preexisting literal32BeforeFollowingAddress:.
Slang:
Make sure functional methods that answer char * (allOnesAsCharStar) can be inlined.
Plugins:
Fix the Alien plugins for 64-bits
=============== Diff against VMMaker.oscog-rmacnak.1595 ===============
Item was added:
+ ----- Method: CCodeGenerator>>generateSignedIntFromLong64:on:indent: (in category 'C translation') -----
+ generateSignedIntFromLong64: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ aStream nextPutAll: '((sqLong) '.
+ self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!
Item was changed:
----- Method: CCodeGenerator>>generateSignedIntFromLong:on:indent: (in category 'C translation') -----
generateSignedIntFromLong: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ aStream nextPutAll: '((int) '.
- aStream nextPutAll: '((sqInt) '.
self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!
- aStream nextPut: $)
-
- !
Item was changed:
----- Method: CCodeGenerator>>generateSignedIntFromShort:on:indent: (in category 'C translation') -----
generateSignedIntFromShort: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
aStream nextPutAll: '((short)'.
self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!
- aStream nextPut: $)
-
- !
Item was added:
+ ----- Method: CCodeGenerator>>generateSignedIntToLong64:on:indent: (in category 'C translation') -----
+ generateSignedIntToLong64: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ aStream nextPutAll: '((usqInt) '.
+ self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!
Item was changed:
----- Method: CCodeGenerator>>generateSignedIntToLong:on:indent: (in category 'C translation') -----
generateSignedIntToLong: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
aStream nextPutAll: '((usqInt) '.
+ vmClass objectMemoryClass wordSize = 8 ifTrue:
+ [aStream nextPutAll: '(int)'].
self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!
- aStream nextPut: $)
-
- !
Item was changed:
----- Method: CCodeGenerator>>generateSignedIntToShort:on:indent: (in category 'C translation') -----
generateSignedIntToShort: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
aStream nextPutAll: '((usqInt) (short)'.
self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!
- aStream nextPut: $)
-
- !
Item was changed:
----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation support') -----
initializeCTranslationDictionary
"Initialize the dictionary mapping message names to actions for C code generation."
| pairs |
translationDict := Dictionary new: 200.
pairs := #(
#& #generateAnd:on:indent:
#| #generateOr:on:indent:
#and: #generateSequentialAnd:on:indent:
#or: #generateSequentialOr:on:indent:
#not #generateNot:on:indent:
#+ #generatePlus:on:indent:
#- #generateMinus:on:indent:
#negated #generateNegated:on:indent:
#* #generateTimes:on:indent:
#/ #generateDivide:on:indent:
#// #generateDivide:on:indent:
#\\ #generateModulo:on:indent:
#<< #generateShiftLeft:on:indent:
#>> #generateShiftRight:on:indent:
#>>> #generateSignedShiftRight:on:indent:
#min: #generateMin:on:indent:
#max: #generateMax:on:indent:
#between:and: #generateBetweenAnd:on:indent:
#bitAnd: #generateBitAnd:on:indent:
#bitOr: #generateBitOr:on:indent:
#bitXor: #generateBitXor:on:indent:
#bitShift: #generateBitShift:on:indent:
#signedBitShift: #generateSignedBitShift:on:indent:
#bitInvert32 #generateBitInvert:on:indent:
#bitInvert64 #generateBitInvert:on:indent:
#bitClear: #generateBitClear:on:indent:
#truncateTo: #generateTruncateTo:on:indent:
#rounded #generateRounded:on:indent:
#< #generateLessThan:on:indent:
#<= #generateLessThanOrEqual:on:indent:
#= #generateEqual:on:indent:
#> #generateGreaterThan:on:indent:
#>= #generateGreaterThanOrEqual:on:indent:
#~= #generateNotEqual:on:indent:
#== #generateEqual:on:indent:
#~~ #generateNotEqual:on:indent:
#isNil #generateIsNil:on:indent:
#notNil #generateNotNil:on:indent:
#whileTrue: #generateWhileTrue:on:indent:
#whileFalse: #generateWhileFalse:on:indent:
#whileTrue #generateDoWhileTrue:on:indent:
#whileFalse #generateDoWhileFalse:on:indent:
#to:do: #generateToDo:on:indent:
#to:by:do: #generateToByDo:on:indent:
#repeat #generateRepeat:on:indent:
#timesRepeat: #generateTimesRepeat:on:indent:
#ifTrue: #generateIfTrue:on:indent:
#ifFalse: #generateIfFalse:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent:
#ifNotNil: #generateIfNotNil:on:indent:
#ifNil: #generateIfNil:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent:
#at: #generateAt:on:indent:
#at:put: #generateAtPut:on:indent:
#basicAt: #generateAt:on:indent:
#basicAt:put: #generateAtPut:on:indent:
#integerValueOf: #generateIntegerValueOf:on:indent:
#integerObjectOf: #generateIntegerObjectOf:on:indent:
#isIntegerObject: #generateIsIntegerObject:on:indent:
#cCode: #generateInlineCCode:on:indent:
#cCode:inSmalltalk: #generateInlineCCode:on:indent:
#cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElse:on:indent:
#cCoerce:to: #generateCCoercion:on:indent:
#cCoerceSimple:to: #generateCCoercion:on:indent:
#addressOf: #generateAddressOf:on:indent:
#addressOf:put: #generateAddressOf:on:indent:
#asAddress:put: #generateAsAddress:on:indent:
+ #signedIntFromLong64 #generateSignedIntFromLong64:on:indent:
- #signedIntFromLong64 #generateSignedIntFromLong:on:indent:
#signedIntFromLong #generateSignedIntFromLong:on:indent:
#signedIntFromShort #generateSignedIntFromShort:on:indent:
+ #signedIntToLong64 #generateSignedIntToLong64:on:indent:
- #signedIntToLong64 #generateSignedIntToLong:on:indent:
#signedIntToLong #generateSignedIntToLong:on:indent:
#signedIntToShort #generateSignedIntToShort:on:indent:
#preIncrement #generatePreIncrement:on:indent:
#preDecrement #generatePreDecrement:on:indent:
#inline: #generateInlineDirective:on:indent:
#asFloat #generateAsFloat:on:indent:
#asInteger #generateAsInteger:on:indent:
#asUnsignedInteger #generateAsUnsignedInteger:on:indent:
#asLong #generateAsLong:on:indent:
#asUnsignedLong #generateAsUnsignedLong:on:indent:
#asVoidPointer #generateAsVoidPointer:on:indent:
#asSymbol #generateAsSymbol:on:indent:
#flag: #generateFlag:on:indent:
#anyMask: #generateBitAnd:on:indent:
#noMask: #generateNoMask:on:indent:
#raisedTo: #generateRaisedTo:on:indent:
#touch: #generateTouch:on:indent:
#bytesPerOop #generateBytesPerOop:on:indent:
#bytesPerWord #generateBytesPerWord:on:indent:
#wordSize #generateBytesPerWord:on:indent:
#baseHeaderSize #generateBaseHeaderSize:on:indent:
#minSmallInteger #generateSmallIntegerConstant:on:indent:
#maxSmallInteger #generateSmallIntegerConstant:on:indent:
#sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent:
#perform: #generatePerform:on:indent:
#perform:with: #generatePerform:on:indent:
#perform:with:with: #generatePerform:on:indent:
#perform:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with:with: #generatePerform:on:indent:
#value #generateValue:on:indent:
#value: #generateValue:on:indent:
#value:value: #generateValue:on:indent:
#value:value:value: #generateValue:on:indent:
#value:value:value:value: #generateValue:on:indent:
#deny: #generateDeny:on:indent:
#shouldNotImplement #generateSmalltalkMetaError:on:indent:
#shouldBeImplemented #generateSmalltalkMetaError:on:indent:
#subclassResponsibility #generateSmalltalkMetaError:on:indent:
).
1 to: pairs size by: 2 do: [:i |
translationDict at: (pairs at: i) put: (pairs at: i + 1)].
pairs := #(
#ifTrue: #generateIfTrueAsArgument:on:indent:
#ifFalse: #generateIfFalseAsArgument:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent:
#ifNotNil: #generateIfNotNilAsArgument:on:indent:
#ifNil: #generateIfNilAsArgument:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent:
#cCode: #generateInlineCCodeAsArgument:on:indent:
#cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent:
#value #generateValueAsArgument:on:indent:
#value: #generateValueAsArgument:on:indent:
#value:value: #generateValueAsArgument:on:indent:
).
asArgumentTranslationDict := Dictionary new: 8.
1 to: pairs size by: 2 do: [:i |
asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
!
Item was changed:
StackInterpreterPrimitives subclass: #CoInterpreter
instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase lastCoggableInterpretedBlockMethod reenterInterpreter deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile'
+ classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
- classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
poolDictionaries: 'CogMethodConstants VMStackFrameOffsets'
category: 'VMMaker-JIT'!
!CoInterpreter commentStamp: '<historical>' prior: 0!
I am a variant of the StackInterpreter that can co-exist with the Cog JIT. I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT. See CogMethod class's comment for method interoperability.!
Item was changed:
----- Method: CoInterpreter class>>initializeContextIndices (in category 'initialization') -----
initializeContextIndices
super initializeContextIndices.
+ HasBeenReturnedFromMCPC := -1.
+ HasBeenReturnedFromMCPCOop := self objectMemoryClass basicNew integerObjectOf: HasBeenReturnedFromMCPC!
- HasBeenReturnedFromMCPC := self objectMemoryClass basicNew integerObjectOf: -1!
Item was changed:
----- Method: CoInterpreter>>ceBaseFrameReturn: (in category 'trampolines') -----
ceBaseFrameReturn: returnValue
"Return across a page boundary. The context to return to (which may be married)
is stored in the first word of the stack. We get here when a return instruction jumps
to the ceBaseFrameReturn: address that is the return pc for base frames. A consequence
of this is that the current frame is no longer valid since an interrupt may have overwritten
its state as soon as the stack pointer has been cut-back beyond the return pc. So to have
a context to send the cannotReturn: message to we also store the base frame's context
in the second word of the stack page."
<api>
| contextToReturnTo contextToReturnFrom isAContext thePage newPage frameAbove |
<var: #thePage type: #'StackPage *'>
<var: #newPage type: #'StackPage *'>
<var: #frameAbove type: #'char *'>
self assert: (stackPages stackPageFor: stackPointer) = stackPage.
self assert: stackPages mostRecentlyUsedPage = stackPage.
cogit assertCStackWellAligned.
self assert: framePointer = 0.
self assert: stackPointer <= (stackPage baseAddress - objectMemory wordSize).
self assert: stackPage baseFP + (2 * objectMemory wordSize) < stackPage baseAddress.
"We would like to use the following assert but we can't since the stack pointer will be above the
base frame pointer in the base frame return and hence the 0 a base frame pointer points at could
be overwritten which will cause the isBaseFrame assert in frameCallerContext: to fail."
"self assert: (self frameCallerContext: stackPage baseFP) = (stackPages longAt: stackPage baseAddress)."
self assert: ((objectMemory addressCouldBeObj: (stackPages longAt: stackPage baseAddress - objectMemory wordSize))
and: [objectMemory isContext: (stackPages longAt: stackPage baseAddress - objectMemory wordSize)]).
- self assert: ((objectMemory addressCouldBeObj: (stackPages longAt: stackPage baseAddress))
- and: [objectMemory isContext: (stackPages longAt: stackPage baseAddress)]).
contextToReturnTo := stackPages longAt: stackPage baseAddress.
+ self assert: (objectMemory addressCouldBeObj: contextToReturnTo).
"The stack page is effectively free now, so free it. We must free it to be
correct in determining if contextToReturnTo is still married, and in case
makeBaseFrameFor: cogs a method, which may cause a code compaction,
in which case the frame must be free to avoid the relocation machinery
tracing the dead frame. Since freeing now temporarily violates the page-list
ordering invariant, use the assert-free version."
stackPages freeStackPageNoAssert: stackPage.
isAContext := objectMemory isContext: contextToReturnTo.
(isAContext
and: [self isStillMarriedContext: contextToReturnTo])
ifTrue:
[framePointer := self frameOfMarriedContext: contextToReturnTo.
thePage := stackPages stackPageFor: framePointer.
framePointer = thePage headFP
ifTrue:
[stackPointer := thePage headSP]
ifFalse:
["Returning to some interior frame, presumably because of a sender assignment.
Move the frames above to another page (they may be in use, e.g. via coroutining).
Make the interior frame the top frame."
frameAbove := self findFrameAbove: framePointer inPage: thePage.
"Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
newPage := stackPages newStackPage.
self assert: newPage = stackPage.
self moveFramesIn: thePage through: frameAbove toPage: newPage.
stackPages markStackPageMostRecentlyUsed: newPage.
framePointer := thePage headFP.
stackPointer := thePage headSP]]
ifFalse:
[(isAContext
and: [objectMemory isIntegerObject: (objectMemory fetchPointer: InstructionPointerIndex ofObject: contextToReturnTo)]) ifFalse:
[contextToReturnFrom := stackPages longAt: stackPage baseAddress - objectMemory wordSize.
self tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom
to: contextToReturnTo
returnValue: returnValue.
^self externalCannotReturn: returnValue from: contextToReturnFrom].
"void the instructionPointer to stop it being incorrectly updated in a code
compaction in makeBaseFrameFor:."
instructionPointer := 0.
thePage := self makeBaseFrameFor: contextToReturnTo.
framePointer := thePage headFP.
stackPointer := thePage headSP].
self setStackPageAndLimit: thePage.
self assert: (stackPages stackPageFor: framePointer) = stackPage.
(self isMachineCodeFrame: framePointer) ifTrue:
[self push: returnValue.
cogit ceEnterCogCodePopReceiverReg.
"NOTREACHED"].
instructionPointer := self stackTop.
instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
[instructionPointer := self iframeSavedIP: framePointer].
self setMethod: (self iframeMethod: framePointer).
self stackTopPut: returnValue. "a.k.a. pop saved ip then push result"
self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: framePointer).
self siglong: reenterInterpreter jmp: ReturnToInterpreter.
"NOTREACHED"
^nil!
Item was changed:
----- Method: CoInterpreter>>encodedNativePCOf:cogMethod: (in category 'frame access') -----
encodedNativePCOf: mcpc cogMethod: cogMethod
"Encode the mcpc in cogMethod as a value that can be stashed in a context.
Mapping native pcs to bytecode pcs is quite expensive, requiring a search
through the method map. We mitigate this cost by deferring mapping until
we really have to, which is when a context's instruction pointer is accessed
by Smalltalk code. But to defer mapping we have to be able to distinguish
machine code from bytecode pcs, which we do by using negative values for
machine code pcs.
As a whorish performance hack we also include the block method offset in
the pc of a block. The least significant 16 bits are the native pc and the most
significant 15 bits are the block start, in block alignment units. So when
mapping back we can find the start of the block.
See mustMapMachineCodePC:context: for the code that does the actual mapping."
<var: #cogMethod type: #'CogBlockMethod *'>
| homeMethod blockOffset |
<var: #homeMethod type: #'CogMethod *'>
mcpc = cogit ceCannotResumePC ifTrue:
+ [^HasBeenReturnedFromMCPCOop].
- [^HasBeenReturnedFromMCPC].
cogMethod cmType = CMMethod ifTrue:
[^objectMemory integerObjectOf: cogMethod asInteger - mcpc].
homeMethod := cogMethod cmHomeMethod.
blockOffset := homeMethod asInteger - cogMethod asInteger / cogit blockAlignment.
^objectMemory integerObjectOf: ((blockOffset bitShift: 16) bitOr: (cogMethod asInteger - mcpc bitAnd: 16rFFFF))!
Item was changed:
----- Method: CoInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
makeBaseFrameFor: aContext "<Integer>"
"Marry aContext with the base frame of a new stack page. Build the base
frame to reflect the context's state. Answer the new page. Override to
hold the caller context in a different place, In the StackInterpreter we use
the caller saved ip, but in the Cog VM caller saved ip is the ceBaseReturn:
trampoline. Simply hold the caller context in the first word of the stack."
<returnTypeC: #'StackPage *'>
| page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
<inline: false>
<var: #page type: #'StackPage *'>
<var: #pointer type: #'char *'>
<var: #cogMethod type: #'CogMethod *'>
"theIP must be typed as signed because it is assigned ceCannotResumePC and so maybe implicitly typed as unsigned."
<var: #theIP type: #sqInt>
self assert: (objectMemory isContext: aContext).
self assert: (self isSingleContext: aContext).
self assert: (objectMemory goodContextSize: aContext).
theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
+ self assert: HasBeenReturnedFromMCPC < 0.
- self assert: HasBeenReturnedFromMCPC signedIntFromLong < 0.
theIP := (objectMemory isIntegerObject: theIP)
ifTrue: [objectMemory integerValueOf: theIP]
ifFalse: [HasBeenReturnedFromMCPC].
theMethod := objectMemory followObjField: MethodIndex ofObject: aContext.
page := stackPages newStackPage.
"first word on stack is caller context of base frame"
stackPages
longAt: (pointer := page baseAddress)
put: (objectMemory followObjField: SenderIndex ofObject: aContext).
"second word is the context itself; needed for cannotReturn processing; see ceBaseReturn:."
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: aContext.
rcvr := objectMemory followField: ReceiverIndex ofObject: aContext.
"If the frame is a closure activation then the closure should be on the stack in
+ the pushed receiver position (closures receive the value[:value:] messages).
- the pushed receiver position (closures receiver the value[:value:] messages).
Otherwise it should be the receiver proper."
maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
maybeClosure ~= objectMemory nilObject
ifTrue:
[(objectMemory isForwarded: maybeClosure) ifTrue:
[maybeClosure := objectMemory fixFollowedField: ClosureIndex ofObject: aContext withInitialValue: maybeClosure].
numArgs := self argumentCountOfClosure: maybeClosure.
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: maybeClosure]
ifFalse:
[| header |
header := objectMemory methodHeaderOf: theMethod.
numArgs := self argumentCountOfMethodHeader: header.
"If this is a synthetic context its IP could be pointing at the CallPrimitive opcode. If so, skip it."
+ ((self methodHeaderHasPrimitive: header)
+ and: [theIP = (1 + (objectMemory lastPointerOfMethodHeader: header))]) ifTrue:
- (theIP signedIntFromLong > 0
- and: [(self methodHeaderHasPrimitive: header)
- and: [theIP = (1 + (objectMemory lastPointerOfMethodHeader: header))]]) ifTrue:
[theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)].
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: rcvr].
"Put the arguments on the stack"
1 to: numArgs do:
[:i|
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
"saved caller ip is base return trampoline"
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: cogit ceBaseFrameReturnPC.
"base frame's saved fp is null"
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: 0.
"N.B. Don't set the baseFP, which marks the page as in use, until after
ensureMethodIsCogged: and/or instructionPointer:forContext:frame:. These
can cause a compiled code compaction which, if marked as in use, will
examine this partially initialized page and crash."
page headFP: pointer.
"Create either a machine code frame or an interpreter frame based on the pc. If the pc is -ve
it is a machine code pc and so we produce a machine code frame. If +ve an interpreter frame.
N.B. Do *not* change this to try and map from a bytecode pc to a machine code frame under
any circumstances. See ensureContextIsExecutionSafeAfterAssignToStackPointer:"
+ theIP < 0
- theIP signedIntFromLong < 0
ifTrue:
[| cogMethod |
"Since we would have to generate a machine-code method to be able to map
the native pc anyway we should create a native method and native frame."
cogMethod := self ensureMethodIsCogged: theMethod.
theMethod := cogMethod asInteger.
maybeClosure ~= objectMemory nilObject
ifTrue:
["If the pc is the special HasBeenReturnedFromMCPC pc set the pc
appropriately so that the frame stays in the cannotReturn: state."
+ theIP = HasBeenReturnedFromMCPC
- theIP = HasBeenReturnedFromMCPC signedIntFromLong
ifTrue:
[theMethod := (cogit findMethodForStartBcpc: (self startPCOfClosure: maybeClosure)
inHomeMethod: (self cCoerceSimple: theMethod
to: #'CogMethod *')) asInteger.
theMethod = 0 ifTrue:
[self error: 'cannot find machine code block matching closure''s startpc'].
theIP := cogit ceCannotResumePC]
ifFalse:
[self assert: (theIP signedBitShift: -16) < -1. "See contextInstructionPointer:frame:"
theMethod := theMethod - ((theIP signedBitShift: -16) * cogit blockAlignment).
theIP := theMethod - theIP signedIntFromShort].
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: theMethod + MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag]
ifFalse:
[self assert: (theIP signedBitShift: -16) >= -1.
"If the pc is the special HasBeenReturnedFromMCPC pc set the pc
appropriately so that the frame stays in the cannotReturn: state."
+ theIP := theIP = HasBeenReturnedFromMCPC
- theIP := theIP = HasBeenReturnedFromMCPC signedIntFromLong
ifTrue: [cogit ceCannotResumePC]
ifFalse: [theMethod asInteger - theIP].
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: theMethod + MFMethodFlagHasContextFlag].
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: aContext]
ifFalse:
[stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: theMethod.
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: aContext.
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: 0. "FoxIFSavedIP"
theIP := self iframeInstructionPointerForIndex: theIP method: theMethod].
page baseFP: page headFP.
self assert: (self frameHasContext: page baseFP).
self assert: (self frameNumArgs: page baseFP) == numArgs.
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: rcvr.
stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
numArgs + 1 to: stackPtrIndex do:
[:i|
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
"top of stack is the instruction pointer"
stackPages longAt: (pointer := pointer - objectMemory wordSize) put: theIP.
page headSP: pointer.
self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
"Mark context as married by setting its sender to the frame pointer plus SmallInteger
tags and the InstructionPointer to the saved fp (which ensures correct alignment
w.r.t. the frame when we check for validity) plus SmallInteger tags."
objectMemory storePointerUnchecked: SenderIndex
ofObject: aContext
withValue: (self withSmallIntegerTags: page baseFP).
objectMemory storePointerUnchecked: InstructionPointerIndex
ofObject: aContext
withValue: (self withSmallIntegerTags: 0).
self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
self assert: (self frameOfMarriedContext: aContext) = page baseFP.
self assert: (self validStackPageBaseFrame: page).
^page!
Item was changed:
----- Method: CoInterpreter>>mustMapMachineCodePC:context: (in category 'frame access') -----
mustMapMachineCodePC: theIP context: aOnceMarriedContext
"Map the native pc theIP into a bytecode pc integer object and answer it.
See contextInstructionPointer:frame: for the explanation."
| maybeClosure methodObj cogMethod startBcpc bcpc |
<inline: false>
<var: #cogMethod type: #'CogMethod *'>
+ theIP = HasBeenReturnedFromMCPC ifTrue:
- theIP = HasBeenReturnedFromMCPC signedIntFromLong ifTrue:
[^objectMemory nilObject].
maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aOnceMarriedContext.
methodObj := objectMemory fetchPointer: MethodIndex ofObject: aOnceMarriedContext.
maybeClosure ~= objectMemory nilObject
ifTrue: [self assert: (theIP signedBitShift: -16) < -1.
startBcpc := self startPCOfClosure: maybeClosure]
ifFalse: [self assert: (theIP signedBitShift: -16) = -1.
startBcpc := self startPCOfMethod: methodObj].
cogMethod := self ensureMethodIsCogged: methodObj.
bcpc := self bytecodePCFor: theIP cogMethod: cogMethod startBcpc: startBcpc.
self assert: bcpc >= (self startPCOfMethod: methodObj).
"If there's a CallPrimitive we need to skip it."
(bcpc = startBcpc
and: [maybeClosure = objectMemory nilObject
and: [self methodHeaderHasPrimitive: cogMethod methodHeader]]) ifTrue:
[bcpc := bcpc + (self sizeOfCallPrimitiveBytecode: cogMethod methodHeader)].
^objectMemory integerObjectOf: bcpc + 1!
Item was changed:
----- Method: CoInterpreter>>tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom:to:returnValue: (in category 'return bytecodes') -----
tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom to: contextToReturnTo returnValue: returnValue
"Handle the cannot return response for a base frame return to an invalid context.
Build a new base frame for the context in the cannot resume state ready for the
send of cannotReturn:.
Since we have returned from the base frame of the page the context is effectively widowed.
But its sender needs to be contextToReturnTo, and its pc needs to be the HasBeenReturnedFromMCPC
marker. So bereave it (as a side-effect of isWidowedContext:), assign contextToReturnTo to
sender, and rebuild its frame, which will have the ceCannotResumePC as its pc. Finally push
returnValue and set instructionPointer to ceCannotResumePC in preparation for the send."
| newPage |
<inline: false>
<var: #newPage type: #'StackPage *'>
self assert: (stackPage ~= 0 and: [stackPage isFree]).
self isWidowedContext: contextToReturnFrom.
self assert: (self isMarriedOrWidowedContext: contextToReturnFrom) not.
+ objectMemory
+ storePointer: SenderIndex ofObject: contextToReturnFrom withValue: contextToReturnTo;
+ storePointer: InstructionPointerIndex ofObject: contextToReturnFrom withValue: HasBeenReturnedFromMCPCOop.
- objectMemory storePointer: SenderIndex ofObject: contextToReturnFrom withValue: contextToReturnTo.
- objectMemory storePointer: InstructionPointerIndex ofObject: contextToReturnFrom withValue: HasBeenReturnedFromMCPC.
"void the instructionPointer to stop it being incorrectly updated in a code
compaction in makeBaseFrameFor:."
instructionPointer := 0.
newPage := self makeBaseFrameFor: contextToReturnFrom.
self assert: stackPage = newPage.
self setStackPageAndLimit: newPage.
framePointer := stackPage headFP.
stackPointer := stackPage headSP.
self assert: self stackTop = cogit ceCannotResumePC.
"overwrite the ceSendCannotResumePC on the stack. If ever re-executed
the returnValue will be taken from top-of-stack by ceCannotResume."
self stackTopPut: returnValue.
"Assign it to instructionPointer as externalCannotReturn:from: pushes it."
+ instructionPointer := cogit ceCannotResumePC!
- instructionPointer := cogit ceCannotResumePC
- !
Item was changed:
----- Method: CogIA32Compiler>>genRestoreRegs (in category 'abi') -----
genRestoreRegs
+ EAX to: EDI do:
+ [:reg|
+ (reg between: ESP and: EBP) ifFalse:
+ [cogit PopR: reg]].
- cogit
- PopR: EAX;
- PopR: EBX;
- PopR: ECX;
- PopR: EDX;
- PopR: ESI;
- PopR: EDI.
^0!
Item was changed:
----- Method: CogIA32Compiler>>genSaveRegisters (in category 'abi') -----
genSaveRegisters
"Save the general purpose registers for a trampoline call."
+ self assert: (EDI > EAX and: [EDI - EAX + 1 = 8]).
+ EDI to: EAX by: -1 do:
+ [:reg|
+ (reg between: ESP and: EBP) ifFalse:
+ [cogit PushR: reg]].
- self assert: (EDI > EAX and: [EDI - EAX + 1 = 6]).
- EDI to: EAX by: -1 do: [:reg| cogit PushR: reg].
^0!
Item was changed:
----- Method: CogIA32Compiler>>rewriteCallAt:target: (in category 'inline cacheing') -----
rewriteCallAt: callSiteReturnAddress target: callTargetAddress
"Rewrite a call instruction to call a different target. This variant is used to link PICs
in ceSendMiss et al, and to rewrite cached primitive calls. Answer the extent of
the code change which is used to compute the range of the icache to flush."
<var: #callSiteReturnAddress type: #usqInt>
<var: #callTargetAddress type: #usqInt>
| callDistance |
"self cCode: ''
inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
false
ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
[self error: 'linking callsite to invalid address']].
callDistance := (callTargetAddress - callSiteReturnAddress) signedIntToLong.
objectMemory
byteAt: callSiteReturnAddress - 1 put: (callDistance >> 24 bitAnd: 16rFF);
byteAt: callSiteReturnAddress - 2 put: (callDistance >> 16 bitAnd: 16rFF);
byteAt: callSiteReturnAddress - 3 put: (callDistance >> 8 bitAnd: 16rFF);
byteAt: callSiteReturnAddress - 4 put: (callDistance bitAnd: 16rFF).
+ self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) = callTargetAddress.
- self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
"self cCode: ''
inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
^5!
Item was changed:
----- Method: CogInLineLiteralsX64Compiler>>inlineCacheTagAt: (in category 'inline cacheing') -----
inlineCacheTagAt: callSiteReturnAddress
"Answer the inline cache tag for the return address of a send."
+ ^self literal32BeforeFollowingAddress: callSiteReturnAddress - 5!
- ^self thirtyTwoBitLiteralBefore: callSiteReturnAddress - 5!
Item was changed:
----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the CogVMSimulator when running the interpreter inside Smalltalk. The
primary responsibility of this method is to allocate Smalltalk Arrays for variables
that will be declared as statically-allocated global arrays in the translated code."
super initialize.
transcript := Transcript.
objectMemory ifNil:
[objectMemory := self class objectMemoryClass simulatorClass new].
cogit ifNil:
[cogit := self class cogitClass new setInterpreter: self].
objectMemory coInterpreter: self cogit: cogit.
cogit numRegArgs > 0 ifTrue:
[debugStackDepthDictionary := Dictionary new].
cogThreadManager ifNotNil:
[super initialize].
+ self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
+
- "Note: we must initialize ConstMinusOne & HasBeenReturnedFromMCPC differently
- for simulation, due to the fact that the simulator works only with +ve 32-bit values"
- ConstMinusOne := objectMemory integerObjectOf: -1.
- HasBeenReturnedFromMCPC := objectMemory integerObjectOf: -1.
cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
enableCog := true.
methodCache := Array new: MethodCacheSize.
nsMethodCache := Array new: NSMethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
cogCompiledCodeCompactionCalledFor := false.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
mappedPluginEntries := OrderedCollection new.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[primitiveAccessorDepthTable := Array new: primitiveTable size.
pluginList := {}.
self loadNewPlugin: '']
ifFalse:
[pluginList := {'' -> self }].
desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
"This is initialized on loading the image, but convenient for testing stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := Time totalSeconds * 1000000.
maxLiteralCountForCompile := MaxLiteralCountForCompile.
minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
flagInterpretedMethods := false.
"initialize InterpreterSimulator variables used for debugging"
byteCount := lastPollCount := sendCount := lookupCount := 0.
quitBlock := [^ self].
traceOn := true.
printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
eventQueue := SharedQueue new.
suppressHeartbeatFlag := deferSmash := deferredSmash := false.
systemAttributes := Dictionary new.
primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
primTraceLogIndex := 0.
traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
traceLogIndex := 0.
traceSources := TraceSources.
statCodeCompactionCount := 0.
statCodeCompactionUsecs := 0.
extSemTabSize := 256!
Item was changed:
----- Method: CogX64Compiler>>callTargetFromReturnAddress: (in category 'inline cacheing') -----
callTargetFromReturnAddress: callSiteReturnAddress
"Answer the address the call immediately preceding callSiteReturnAddress will jump to."
| callDistance |
+ callDistance := self literal32BeforeFollowingAddress: callSiteReturnAddress.
- callDistance := self thirtyTwoBitLiteralBefore: callSiteReturnAddress.
^callSiteReturnAddress + callDistance signedIntFromLong!
Item was changed:
----- Method: CogX64Compiler>>rewriteCallAt:target: (in category 'inline cacheing') -----
rewriteCallAt: callSiteReturnAddress target: callTargetAddress
"Rewrite a call instruction to call a different target. This variant is used to link PICs
in ceSendMiss et al, and to rewrite cached primitive calls. Answer the extent of
the code change which is used to compute the range of the icache to flush."
<var: #callSiteReturnAddress type: #usqInt>
<var: #callTargetAddress type: #usqInt>
| callDistance |
"self cCode: ''
inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
false
ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
[self error: 'linking callsite to invalid address']].
callDistance := (callTargetAddress - callSiteReturnAddress) signedIntToLong.
objectMemory
byteAt: callSiteReturnAddress - 1 put: (callDistance >> 24 bitAnd: 16rFF);
byteAt: callSiteReturnAddress - 2 put: (callDistance >> 16 bitAnd: 16rFF);
byteAt: callSiteReturnAddress - 3 put: (callDistance >> 8 bitAnd: 16rFF);
byteAt: callSiteReturnAddress - 4 put: (callDistance bitAnd: 16rFF).
+ self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) = callTargetAddress.
- self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
"self cCode: ''
inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
^5!
Item was removed:
- ----- Method: CogX64Compiler>>thirtyTwoBitLiteralBefore: (in category 'inline cacheing') -----
- thirtyTwoBitLiteralBefore: followingAddress
- <inline: true>
- ^self unalignedLong32At: followingAddress - 4!
Item was changed:
----- Method: IA32ABIPlugin>>primSizeField (in category 'primitives-accessing') -----
primSizeField
"Answer the signed 32- or 64-bit integer comprising the size field (the first 32- or 64-bit field)."
"<Alien> primSizeField ^<Integer>
<primitive: 'primSizeField' error: errorCode module: 'IA32ABI'>"
| rcvr value valueOop |
<export: true>
rcvr := interpreterProxy stackValue: 0.
+ value := self cppIf: interpreterProxy bytesPerOop = 8
+ ifTrue: [(self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong64]
+ ifFalse: [(self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong].
- value := (self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong.
valueOop := self signedMachineIntegerFor: value.
^interpreterProxy methodReturnValue: valueOop!
Item was changed:
----- Method: IA32ABIPlugin>>primSizeFieldPut (in category 'primitives-accessing') -----
primSizeFieldPut
"Store a signed integer into the size field (the first 32 bit field; little endian)."
"<Alien> sizeFieldPut: value <Integer> ^<Integer>
<primitive: 'primSizeFieldPut' error: errorCode module: 'IA32ABI'>"
| rcvr value valueOop |
<export: true>
valueOop := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
value := interpreterProxy signedMachineIntegerValueOf: valueOop.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self cppIf: interpreterProxy bytesPerOop = 8
+ ifTrue: [self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong64]
+ ifFalse: [self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong]).
- self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong.
^interpreterProxy methodReturnValue: valueOop!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin>>primSizeField (in category 'primitives-accessing') -----
primSizeField
"Answer the signed 32- or 64-bit integer comprising the size field (the first 32- or 64-bit field)."
"<Alien> primSizeField ^<Integer>
<primitive: 'primSizeField' error: errorCode module: 'IA32ABI'>"
| rcvr value valueOop |
<export: true>
rcvr := interpreterProxy stackValue: 0.
+ value := self cppIf: interpreterProxy bytesPerOop = 8
+ ifTrue: [(self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong64]
+ ifFalse: [(self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong].
- value := (self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong.
valueOop := self signedMachineIntegerFor: value.
^interpreterProxy methodReturnValue: valueOop!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin>>primSizeFieldPut (in category 'primitives-accessing') -----
primSizeFieldPut
"Store a signed integer into the size field (the first 32 bit field; little endian)."
"<Alien> sizeFieldPut: value <Integer> ^<Integer>
<primitive: 'primSizeFieldPut' error: errorCode module: 'IA32ABI'>"
| rcvr value valueOop |
<export: true>
valueOop := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
value := interpreterProxy signedMachineIntegerValueOf: valueOop.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self cppIf: interpreterProxy bytesPerOop = 8
+ ifTrue: [self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong64]
+ ifFalse: [self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong]).
- (interpreterProxy isOopImmutable: rcvr) ifTrue:
- [^interpreterProxy primitiveFailFor: PrimErrNoModification].
- self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong.
^interpreterProxy methodReturnValue: valueOop!
Item was changed:
----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
initialize
"We can put all initializations that set something to 0 or to false here.
In C all global variables are initialized to 0, and 0 is false."
remapBuffer := Array new: RemapBufferSize.
remapBufferCount := extraRootCount := 0. "see below"
freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
checkForLeaks := 0.
needGCFlag := signalLowSpace := scavengeInProgress := marking := false.
becomeEffectsFlags := 0.
statScavenges := statIncrGCs := statFullGCs := 0.
statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
statGrowMemory := statShrinkMemory := statRootTableCount := statSurvivorCount := 0.
statRootTableOverflows := statMarkCount := statSpecialMarkCount := statCompactPassCount := statCoalesces := 0.
"We can initialize things that are allocated but are lazily initialized."
unscannedEphemerons := SpurContiguousObjStack new.
"we can initialize things that are virtual in C."
scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
segmentManager := SpurSegmentManager new manager: self; yourself.
"We can also initialize here anything that is only for simulation."
heapMap := CogCheck32BitHeapMap new.
"N.B. We *don't* initialize extraRoots because we don't simulate it."
+ maxOldSpaceSize := self class initializationOptions ifNotNil: [:initOpts| initOpts at: #maxOldSpaceSize ifAbsent: [0]]!
- maxOldSpaceSize := self class initializationOptions at: #maxOldSpaceSize ifAbsent: [0]!
Item was added:
+ ----- Method: StackInterpreter>>allOnesAsCharStar (in category 'stack pages') -----
+ allOnesAsCharStar
+ <inline: true>
+ ^(self
+ cCoerceSimple: (objectMemory wordSize = 8
+ ifTrue: [-1 signedIntToLong64]
+ ifFalse: [-1 signedIntToLong])
+ to: #'char *')!
Item was changed:
----- 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 allOnesAsCharStar])
- or: [stackLimit = (self cCoerceSimple: -1 signedIntToLong to: #'char *')])
l: ln.
self assert: (stackPage stackLimit = stackPage realStackLimit
+ or: [stackPage stackLimit = self allOnesAsCharStar])
- or: [stackPage stackLimit = (self cCoerceSimple: -1 signedIntToLong to: #'char *')])
l: ln!
Item was changed:
----- Method: StackInterpreter>>forceInterruptCheck (in category 'process primitive support') -----
forceInterruptCheck
"Force an interrupt check ASAP.
Must set the stack page's limit before stackLimit to avoid
a race condition if this is called from an interrupt handler."
| thePage iccFunc |
<inline: false>
<var: #thePage type: #'StackPage *'>
<var: #iccFunc declareC: 'void (*iccFunc)()'>
"Do _not_ set stackLimit until the stack system has been initialized.
stackLimit is the initialization flag for the stack system."
stackLimit = 0 ifTrue:
[^nil].
thePage := stackPage.
(thePage notNil and: [thePage ~= 0]) ifTrue:
+ [thePage stackLimit: self allOnesAsCharStar].
+ stackLimit := self allOnesAsCharStar.
- [thePage stackLimit: (self cCoerceSimple: -1 signedIntToLong to: #'char *')].
- stackLimit := self cCoerceSimple: -1 signedIntToLong to: #'char *'.
self sqLowLevelMFence.
"There is a race condition if we test the function and then dereference
it a second time to call it. This is called from interrupt code but at the
same time other code could be clearing the interruptCheckChain via
setInterruptCheckChain:."
(iccFunc := interruptCheckChain) notNil ifTrue:
[self perform: iccFunc].
statForceInterruptCheck := statForceInterruptCheck + 1!
Item was changed:
----- Method: StackInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
makeBaseFrameFor: aContext "<Integer>"
"Marry aContext with the base frame of a new stack page. Build the base
frame to reflect the context's state. Answer the new page."
<returnTypeC: #'StackPage *'>
| page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
<inline: false>
<var: #page type: #'StackPage *'>
<var: #pointer type: #'char *'>
self assert: (objectMemory isContext: aContext).
self assert: (self isSingleContext: aContext).
self assert: (objectMemory goodContextSize: aContext).
page := stackPages newStackPage.
pointer := page baseAddress.
theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
theMethod := objectMemory followObjField: MethodIndex ofObject: aContext.
(objectMemory isIntegerObject: theIP) ifFalse:
[self error: 'context is not resumable'].
theIP := objectMemory integerValueOf: theIP.
rcvr := objectMemory followField: ReceiverIndex ofObject: aContext.
"If the frame is a closure activation then the closure should be on the stack in
+ the pushed receiver position (closures receive the value[:value:] messages).
- the pushed receiver position (closures receiver the value[:value:] messages).
Otherwise it should be the receiver proper."
maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
maybeClosure ~= objectMemory nilObject
ifTrue:
[(objectMemory isForwarded: maybeClosure) ifTrue:
[maybeClosure := objectMemory fixFollowedField: ClosureIndex ofObject: aContext withInitialValue: maybeClosure].
numArgs := self argumentCountOfClosure: maybeClosure.
stackPages longAt: pointer put: maybeClosure]
ifFalse:
[| header |
header := objectMemory methodHeaderOf: theMethod.
numArgs := self argumentCountOfMethodHeader: header.
"If this is a synthetic context its IP could be pointing at the CallPrimitive opcode. If so, skip it."
+ ((self methodHeaderHasPrimitive: header)
+ and: [theIP = (1 + (objectMemory lastPointerOfMethodHeader: header))]) ifTrue:
- (theIP signedIntFromLong > 0
- and: [(self methodHeaderHasPrimitive: header)
- and: [theIP = (1 + (objectMemory lastPointerOfMethodHeader: header))]]) ifTrue:
[theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)].
stackPages longAt: pointer put: rcvr].
"Put the arguments on the stack"
1 to: numArgs do:
[:i|
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
"saved caller ip is sender context in base frame"
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: (objectMemory followObjField: SenderIndex ofObject: aContext).
"base frame's saved fp is null"
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: 0.
page baseFP: pointer; headFP: pointer.
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: theMethod.
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
self assert: (self frameHasContext: page baseFP).
self assert: (self frameNumArgs: page baseFP) == numArgs.
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: aContext.
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: rcvr.
stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
numArgs + 1 to: stackPtrIndex do:
[:i|
stackPages
longAt: (pointer := pointer - objectMemory wordSize)
put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
"top of stack is the instruction pointer"
theIP := self iframeInstructionPointerForIndex: theIP method: theMethod.
stackPages longAt: (pointer := pointer - objectMemory wordSize) put: theIP.
page headSP: pointer.
self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
"Mark context as married by setting its sender to the frame pointer plus SmallInteger
tags and the InstructionPointer to the saved fp (which ensures correct alignment
w.r.t. the frame when we check for validity) plus SmallInteger tags."
objectMemory storePointerUnchecked: SenderIndex
ofObject: aContext
withValue: (self withSmallIntegerTags: page baseFP).
objectMemory storePointerUnchecked: InstructionPointerIndex
ofObject: aContext
withValue: (self withSmallIntegerTags: 0).
self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
self assert: (self frameOfMarriedContext: aContext) = page baseFP.
self assert: (self validStackPageBaseFrame: page).
^page!
Item was changed:
----- Method: StackInterpreter>>setStackPageAndLimit: (in category 'stack pages') -----
setStackPageAndLimit: thePage
"Set stackPage to a different page. Set stackLimit unless it has
been smashed. Make the stackPage the most recently used"
<inline: true>
<var: #thePage type: #'StackPage *'>
self assert: thePage ~= 0.
stackPage := thePage.
+ stackLimit ~= self allOnesAsCharStar ifTrue:
- stackLimit ~= (self cCoerceSimple: -1 signedIntToLong to: #'char *') ifTrue:
[stackLimit := stackPage stackLimit].
stackPages markStackPageMostRecentlyUsed: thePage!
Item was changed:
----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the StackInterpreterSimulator when running the interpreter
inside Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
super initialize.
bootstrapping := false.
transcript := Transcript.
objectMemory ifNil:
[objectMemory := self class objectMemoryClass simulatorClass new].
objectMemory coInterpreter: self.
+ self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
- "Note: we must initialize ConstMinusOne differently for simulation,
- due to the fact that the simulator works only with +ve 32-bit values"
- ConstMinusOne := objectMemory integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
nsMethodCache := Array new: NSMethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
mappedPluginEntries := OrderedCollection new.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[primitiveAccessorDepthTable := Array new: primitiveTable size.
pluginList := {}.
self loadNewPlugin: '']
ifFalse:
[pluginList := {'' -> self }].
desiredNumStackPages := desiredEdenBytes := 0.
"This is initialized on loading the image, but convenient for testing stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := Time totalSeconds * 1000000.
"initialize InterpreterSimulator variables used for debugging"
byteCount := sendCount := lookupCount := 0.
quitBlock := [^self].
traceOn := true.
printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
eventQueue := SharedQueue new.
suppressHeartbeatFlag := false.
systemAttributes := Dictionary new.
extSemTabSize := 256.
disableBooleanCheat := false.
assertVEPAES := true. "a flag so the assertValidExecutionPointers can be disabled for simulation speed"!
Item was changed:
----- Method: TMethod>>isFunctional (in category 'inlining') -----
isFunctional
"Answer true if the receiver is a functional method. That is, if it
consists of a single return statement of an expression that contains
no other returns.
Answer false for methods with return types other than the simple
integer types to work around bugs in the inliner."
parseTree statements isEmpty ifTrue:
[^false].
parseTree statements last isReturn ifFalse:
[^false].
parseTree statements size = 1 ifFalse:
[(parseTree statements size = 2
and: [parseTree statements first isSend
and: [parseTree statements first selector == #flag:]]) ifFalse:
[^false]].
parseTree statements last expression nodesDo:
[ :n | n isReturn ifTrue: [^false]].
+ ^#(sqInt usqInt sqLong usqLong #'sqInt *' #'CogMethod *' #'char *') includes: returnType!
- ^#(sqInt usqInt sqLong usqLong #'sqInt *' #'CogMethod *') includes: returnType!
Item was changed:
+ ----- Method: TSendNode>>hasSideEffect (in category 'testing') -----
- ----- Method: TSendNode>>hasSideEffect (in category 'as yet unclassified') -----
hasSideEffect
"Answer if the parse tree rooted at this node has a side-effect or not."
^(#(#+ #- #* #/ #// #\\ #= #== #~= #~~) includes: selector) not!
More information about the Vm-dev
mailing list