Smalltalk › Squeak › Squeak VM

VM Maker: VMMaker.oscog-eem.2729.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

VM Maker: VMMaker.oscog-eem.2729.mcz

Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2729.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.2729
Author: eem
Time: 18 March 2020, 8:11:20.738684 pm
UUID: b57f3688-aef5-4b14-9b59-ee1fd0fd6d53
Ancestors: VMMaker.oscog-eem.2728

Interpreters: rip out the check alloc filler support in the interests of simplicity. Though useful in theory, this faclity has never been used successfully to find a bug in all the years it's been available (and we can always put it back).
Rip out the debugPrimCallStackOffset support. I can't remember what this was supposed to do. It is confusing.

Spur: Don't update become effect flags for identical oops that will later be filtered out in the loops oiver the arrays. Don't queue a WeakArray for finalization more than once (i.e. if its already in the queue there's no point adding it again).

Cogit: fix genExternalizePointersForPrimitiveCall & genLoadCStackPointersForPrimCall for the SPReg ~= NativeSPReg regime.
Localise code to the primitive generator invocation block in compilePrimitive

Slang: rewrite TAssignmentNode>>emitValueExpansionOn:level:generator: in the same style as the recent rewrite of TReturnNode>>emitValueExpansionOn:level:generator:

Simulation:
Fix simulating leaf calls in teh context of a primitive invocation. ARMv8 has generated cache flushing code which is executed potentilly during a become primitive. Making simulateLeafCallOf: restore stack,frame,and link registers prevents this breaking asserts in handleCallOrJumpSimulationTrap:.

Don't bother to print endless zeros on the rump C stack.

Allow settingt a break block either in teh coInterpreter or the cogit (so processor et al are in scope).

Fix receiver in canBeImmutable:.

Fix strncpy:_:_: for CArray receivers. Correctly simulate getModuleName in e.g. LargeIntegersPlugin.

Most of the above advance productizing the ARMv8 JIT.

=============== Diff against VMMaker.oscog-eem.2728 ===============

Item was changed:
----- Method: CoInterpreter class>>initializeMiscConstants (in category 'initialization') -----
initializeMiscConstants

super initializeMiscConstants.
COGVM := true.

MinBackwardJumpCountForCompile := 40.

MaxNumArgs := 15.
PrimCallNeedsNewMethod := 1.
PrimCallNeedsPrimitiveFunction := 2.
PrimCallMayCallBack := 4.
PrimCallOnSmalltalkStack := 8.
PrimCallCollectsProfileSamples := 16.
+ "CheckAllocationFillerAfterPrimCall := 32. this has never been successfully used in all the years we've had it; nuking it"
- CheckAllocationFillerAfterPrimCall := 32.
PrimCallDoNotJIT := 64.

PrimTraceLogSize := 256. "Room for 256 selectors. Must be 256 because we use a byte to hold the index"
TraceBufferSize := 256 * 3. "Room for 256 events"
TraceContextSwitch := self objectMemoryClass basicNew integerObjectOf: 1.
TraceBlockActivation := self objectMemoryClass basicNew integerObjectOf: 2.
TraceBlockCreation := self objectMemoryClass basicNew integerObjectOf: 3.
TraceIncrementalGC := self objectMemoryClass basicNew integerObjectOf: 4.
TraceFullGC := self objectMemoryClass basicNew integerObjectOf: 5.
TraceCodeCompaction := self objectMemoryClass basicNew integerObjectOf: 6.
TraceOwnVM := self objectMemoryClass basicNew integerObjectOf: 7.
TraceDisownVM := self objectMemoryClass basicNew integerObjectOf: 8.
TraceThreadSwitch := self objectMemoryClass basicNew integerObjectOf: 9.
TracePreemptDisowningThread := self objectMemoryClass basicNew integerObjectOf: 10.
TraceVMCallback := self objectMemoryClass basicNew integerObjectOf: 11.
TraceVMCallbackReturn := self objectMemoryClass basicNew integerObjectOf: 12.
TraceStackOverflow := self objectMemoryClass basicNew integerObjectOf: 13.
TracePrimitiveFailure := self objectMemoryClass basicNew integerObjectOf: 14.
TracePrimitiveRetry := self objectMemoryClass basicNew integerObjectOf: 15.

TraceIsFromMachineCode := 1.
TraceIsFromInterpreter := 2.
CSCallbackEnter := 3.
CSCallbackLeave := 4.
CSEnterCriticalSection := 5.
CSExitCriticalSection := 6.
CSResume := 7.
CSSignal := 8.
CSSuspend := 9.
CSWait := 10.
CSYield := 11.
CSCheckEvents := 12.
CSThreadSchedulingLoop := 13.
CSOwnVM := 14.
CSThreadBind := 15.
CSSwitchIfNeccessary := 16.

TraceSources := CArrayAccessor on: #('?' 'm' 'i' 'callbackEnter' 'callbackLeave' 'enterCritical' 'exitCritical' 'resume' 'signal' 'suspend' 'wait' 'yield' 'eventcheck' 'threadsched' 'ownVM' 'bindToThread' 'switchIfNecessary').

"this is simulation only"
RumpCStackSize := 4096!

Item was removed:
- ----- Method: CoInterpreter>>getCheckAllocFiller (in category 'cog jit support') -----
- getCheckAllocFiller
- <api>
- ^checkAllocFiller!

Item was changed:
----- Method: CoInterpreter>>primitivePropertyFlagsForSpur: (in category 'cog jit support') -----
primitivePropertyFlagsForSpur: primIndex
<inline: true>
"Answer any special requirements of the given primitive. Spur always needs to set
primitiveFunctionPointer and newMethod so primitives can retry on failure due to forwarders."
| baseFlags |
self cCode: [] inSmalltalk: [#(mcprimHashMultiply: primitiveExternalCall primitiveCalloutToFFI)]. "For senders..."
primIndex = PrimNumberHashMultiply ifTrue:
[^PrimCallOnSmalltalkStack].
baseFlags := PrimCallNeedsPrimitiveFunction + PrimCallNeedsNewMethod.
profileSemaphore ~= objectMemory nilObject ifTrue:
[baseFlags := baseFlags bitOr: PrimCallCollectsProfileSamples].

(primIndex = PrimNumberExternalCall "#primitiveExternalCall"
or: [primIndex = PrimNumberFFICall "#primitiveCalloutToFFI"]) ifTrue: "For callbacks"
+ [baseFlags := baseFlags bitOr: PrimCallMayCallBack].
- [baseFlags := baseFlags bitOr: PrimCallMayCallBack.
- checkAllocFiller ifTrue:
- [baseFlags := baseFlags bitOr: CheckAllocationFillerAfterPrimCall]].

^baseFlags!

Item was changed:
SharedPool subclass: #CogMethodConstants
instanceVariableNames: ''
+ classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallDoNotJIT PrimCallMayCallBack PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction PrimCallOnSmalltalkStack ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
- classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CheckAllocationFillerAfterPrimCall CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallDoNotJIT PrimCallMayCallBack PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction PrimCallOnSmalltalkStack ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
poolDictionaries: ''
category: 'VMMaker-JIT'!

Item was changed:
----- Method: CogVMSimulator>>primitiveExecuteMethodArgsArray (in category 'control primitives') -----
primitiveExecuteMethodArgsArray
+ (InitializationOptions at: #haltOnExecuteMethod ifAbsent: [true]) ifTrue:
+ [self halt: thisContext selector].
- self halt: thisContext selector.
^super primitiveExecuteMethodArgsArray!

Item was changed:
----- Method: CogVMSimulator>>printRumpCStackTo: (in category 'rump c stack') -----
printRumpCStackTo: address
+ | start |
self assert: (self isOnRumpCStack: address).
+ start := heapBase - self rumpCStackSize.
+ [start < address and: [(objectMemory longAt: start) = 0]] whileTrue:
+ [start := start + objectMemory wordSize].
+ start := start - (3 * objectMemory wordSize) max: heapBase - self rumpCStackSize.
address
+ to: start
- to: heapBase - self rumpCStackSize
by: objectMemory wordSize negated
do: [:addr| | label |
self printHex: addr.
addr = cogit processor sp ifTrue: [label := ' sp'].
addr = cogit processor fp ifTrue: [label := (label ifNil: [''] ifNotNil: [label, ',']), 'fp'].
addr = CStackPointer ifTrue: [label := (label ifNil: [''] ifNotNil: [label, ',']), 'CSP'].
addr = CFramePointer ifTrue: [label := (label ifNil: [''] ifNotNil: [label, ',']), 'CFP'].
label ifNil: [self tab] ifNotNil: [self print: ' ', label, '->'].
+ self tab; printHex: (objectMemory longAt: addr); cr].
+ heapBase - self rumpCStackSize < start ifTrue:
+ [self print: 'zeros...'; cr]!
- self tab; printHex: (objectMemory longAt: addr); cr]!

Item was removed:
- ----- Method: CogVMSimulator>>setBreakBlockFromString: (in category 'UI') -----
- setBreakBlockFromString: aString
- | bString block |
- bString := aString withBlanksTrimmed.
- bString first = $- ifTrue:
- [^cogit breakBlock: nil].
- bString first ~= $[ ifTrue:
- [bString := '[:_address|', bString, ']'].
- block := [Compiler evaluate: bString for: self logged: false]
- on: Error
- do: [:ex|
- UIManager default warn: ex messageText.
- ^self].
- cogit breakBlock: block!

Item was added:
+ ----- Method: CogVMSimulator>>setBreakBlockFromString:for: (in category 'UI') -----
+ setBreakBlockFromString: aString for: coInterpreterOrCogit
+ | bString block |
+ bString := aString withBlanksTrimmed.
+ bString first = $- ifTrue:
+ [^cogit breakBlock: nil].
+ bString first ~= $[ ifTrue:
+ [bString := '[:_address|', bString, ']'].
+ block := [Compiler evaluate: bString for: coInterpreterOrCogit logged: false]
+ on: Error
+ do: [:ex|
+ UIManager default warn: ex messageText.
+ ^self].
+ cogit breakBlock: block.
+ (atEachStepBlock notNil and: [atEachStepBlock home selector == #useCogitBreakBlockIfNone]) ifTrue:
+ [atEachStepBlock := nil]!

Item was changed:
----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
| backEnd |
backEnd := CogCompilerClass basicNew.
#( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
'processorFrameValid' 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
[:simulationVariableNotNeededForRealVM|
aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
NewspeakVM ifFalse:
[#( 'selfSendTrampolines' 'dynamicSuperSendTrampolines'
'implicitReceiverSendTrampolines' 'outerSendTrampolines'
'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do:
[:variableNotNeededInNormalVM|
aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
aCCodeGenerator
addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
addHeaderFile:'"sqCogStackAlignment.h"';
addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
addHeaderFile:'"cogmethod.h"'.
NewspeakVM ifTrue:
[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
aCCodeGenerator
addHeaderFile:'#if COGMTVM';
addHeaderFile:'"cointerpmt.h"';
addHeaderFile:'#else';
addHeaderFile:'"cointerp.h"';
addHeaderFile:'#endif';
addHeaderFile:'"cogit.h"'.
aCCodeGenerator
var: #ceGetFP
declareC: 'usqIntptr_t (*ceGetFP)(void)';
var: #ceGetSP
declareC: 'usqIntptr_t (*ceGetSP)(void)';
var: #ceCaptureCStackPointers
declareC: 'void (*ceCaptureCStackPointers)(void)';
var: #ceEnterCogCodePopReceiverReg
declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
var: #realCEEnterCogCodePopReceiverReg
declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
var: #ceCallCogCodePopReceiverReg
declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
var: #realCECallCogCodePopReceiverReg
declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
var: #ceCallCogCodePopReceiverAndClassRegs
declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
var: #realCECallCogCodePopReceiverAndClassRegs
declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
var: #postCompileHook
declareC: 'void (*postCompileHook)(CogMethod *)';
var: #openPICList declareC: 'CogMethod *openPICList = 0';
var: #maxMethodBefore type: #'CogBlockMethod *';
var: 'enumeratingCogMethod' type: #'CogMethod *'.

aCCodeGenerator
var: #ceTryLockVMOwner
declareC: '#if COGMTVM\usqIntptr_t (*ceTryLockVMOwner)(void)';
var: #ceUnlockVMOwner
declareC: 'void (*ceUnlockVMOwner)(void)\#endif /* COGMTVM */'.

backEnd numCheckLZCNTOpcodes > 0 ifTrue:
[aCCodeGenerator
var: #ceCheckLZCNTFunction
declareC: 'static usqIntptr_t (*ceCheckLZCNTFunction)(void)'].
backEnd numCheckFeaturesOpcodes > 0 ifTrue:
[aCCodeGenerator
var: #ceCheckFeaturesFunction
declareC: 'static usqIntptr_t (*ceCheckFeaturesFunction)(void)'].
backEnd numICacheFlushOpcodes > 0 ifTrue:
[aCCodeGenerator
var: #ceFlushICache
declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)'].
aCCodeGenerator
var: #ceFlushDCache
declareC: '#if DUAL_MAPPED_CODE_ZONE\static void (*ceFlushDCache)(usqIntptr_t from, usqIntptr_t to)\#endif';
var: #codeToDataDelta
declareC: '#if DUAL_MAPPED_CODE_ZONE\static sqInt codeToDataDelta\#else\# define codeToDataDelta 0\#endif'.

aCCodeGenerator
declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'.
self declareC: #(abstractOpcodes stackCheckLabel
blockEntryLabel blockEntryNoContextSwitch
stackOverflowCall sendMiss
entry noCheckEntry selfSendEntry dynSuperEntry
fullBlockNoContextSwitchEntry fullBlockEntry
picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 cPICEndOfCodeLabel)
as: #'AbstractInstruction *'
in: aCCodeGenerator.
aCCodeGenerator
declareVar: #cPICPrototype type: #'CogMethod *';
declareVar: #blockStarts type: #'BlockStart *';
declareVar: #fixups type: #'BytecodeFixup *';
declareVar: #methodZoneBase type: #usqInt.
aCCodeGenerator
var: #ordinarySendTrampolines
declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
var: #superSendTrampolines
declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'.
BytecodeSetHasDirectedSuperSend ifTrue:
[aCCodeGenerator
var: #directedSuperSendTrampolines
declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]';
var: #directedSuperBindingSendTrampolines
declareC: 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]'].
NewspeakVM ifTrue:
[aCCodeGenerator
var: #selfSendTrampolines
declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
var: #dynamicSuperSendTrampolines
declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
var: #implicitReceiverSendTrampolines
declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
var: #outerSendTrampolines
declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]'].
aCCodeGenerator
var: #trampolineAddresses
declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
var: #objectReferencesInRuntime
declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]';
var: #labelCounter
type: #int;
var: #traceFlags
declareC: 'int traceFlags = 8 /* prim trace log on by default */';
var: #cStackAlignment
declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
aCCodeGenerator
+ declareVar: #minValidCallAddress type: #'usqIntptr_t'.
- declareVar: #minValidCallAddress type: #'usqIntptr_t';
- declareVar: #debugPrimCallStackOffset type: #'usqIntptr_t'.
aCCodeGenerator vmClass generatorTable ifNotNil:
[:bytecodeGenTable|
aCCodeGenerator
var: #generatorTable
declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']',
(self tableInitializerFor: bytecodeGenTable
in: aCCodeGenerator)].
"In C the abstract opcode names clash with the Smalltalk generator syntactic sugar.
Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic
sugar to avoid the clash."
(self organization listAtCategoryNamed: #'abstract instructions') do:
[:s|
aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'.
self declareFlagVarsAsByteIn: aCCodeGenerator!

Item was changed:
----- Method: Cogit class>>mustBeGlobal: (in category 'translation') -----
mustBeGlobal: var
"Answer if a variable must be global and exported. Used for inst vars that are
accessed from VM support code."
^#('ceBaseFrameReturnTrampoline' 'ceCaptureCStackPointers' 'ceCheckForInterruptTrampoline'
ceEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverReg
ceCallCogCodePopReceiverReg realCECallCogCodePopReceiverReg
ceCallCogCodePopReceiverAndClassRegs realCECallCogCodePopReceiverAndClassRegs
'ceReturnToInterpreterTrampoline' 'ceCannotResumeTrampoline'
ceTryLockVMOwner ceUnlockVMOwner
'cmEntryOffset' 'cmNoCheckEntryOffset' 'cmDynSuperEntryOffset' 'cmSelfSendEntryOffset'
'missOffset' 'cbEntryOffset' 'cbNoSwitchEntryOffset' 'blockNoContextSwitchOffset' breakPC
ceGetFP ceGetSP cFramePointerInUse
+ traceFlags traceStores)
- traceFlags traceStores debugPrimCallStackOffset)
includes: var!

Item was changed:
----- Method: Cogit>>codeMemmove:_:_: (in category 'generate machine code - dual mapped zone support') -----
codeMemmove: dest _: src _: bytes
"Move memory (copy allowing for overlap), applying the codeToDataDelta.
This is used for code compaction and so works on readable addresses (delta is required)."
"production uses the macro..."
+ <cmacro: '(dest,src,bytes) memmove((char *)(dest)+codeToDataDelta,src,bytes)'>
- <cmacro: '(dest,src,bytes) memmove((dest)+codeToDataDelta,src,bytes)'>
self codeWriteBreakpoint: dest.
"simulation writes twice if simulating dual mapping..."
codeToDataDelta ~= 0 ifTrue:
[objectMemory memmove: dest asUnsignedInteger + codeToDataDelta _: src _: bytes].
+ objectMemory memmove: dest _: src _: bytes.
+ "and as a convenience, relocate the breakPC if it is in this method"
+ (breakPC notNil and: [breakPC between: src and: src + bytes - 1]) ifTrue:
+ [breakPC := breakPC - (src - dest)]!
- objectMemory memmove: dest _: src _: bytes!

Item was changed:
----- Method: Cogit>>genExternalizePointersForPrimitiveCall (in category 'trampoline support') -----
genExternalizePointersForPrimitiveCall
- self MoveR: FPReg Aw: coInterpreter framePointerAddress.
backEnd hasLinkRegister
ifTrue:
+ [self MoveR: LinkReg Aw: coInterpreter instructionPointerAddress]
+ ifFalse: "Set coInterpreter stackPointer to the topmost argument, skipping the return address."
- ["Set coInterpreter stackPointer to the topmost argument, skipping the return address."
- self MoveR: SPReg Aw: coInterpreter stackPointerAddress.
- self MoveR: LinkReg Aw: coInterpreter instructionPointerAddress]
- ifFalse:
[self PopR: TempReg. "get retpc"
+ self MoveR: TempReg Aw: coInterpreter instructionPointerAddress].
+ ^backEnd genSaveStackPointers!
- self MoveR: TempReg Aw: coInterpreter instructionPointerAddress.
- "Set coInterpreter stackPointer to the topmost argument, skipping the return address."
- self MoveR: SPReg Aw: coInterpreter stackPointerAddress].
- ^0!

Item was changed:
----- Method: Cogit>>genLoadCStackPointersForPrimCall (in category 'trampoline support') -----
genLoadCStackPointersForPrimCall
+ <inline: #always>
+ cFramePointerInUse
+ ifTrue: [backEnd genLoadCStackPointers]
+ ifFalse: [backEnd genLoadCStackPointer]!
- debugPrimCallStackOffset = 0
- ifTrue:
- [self MoveAw: self cStackPointerAddress R: SPReg]
- ifFalse:
- [self MoveAw: self cStackPointerAddress R: TempReg.
- self SubCq: debugPrimCallStackOffset R: TempReg.
- self MoveR: TempReg R: SPReg].
- cFramePointerInUse ifTrue:
- [self MoveAw: self cFramePointerAddress R: FPReg].
- ^0!

Item was changed:
----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
<doNotGenerate>
| evaluable function memory result savedFramePointer savedStackPointer savedArgumentCount leaf retpc |
evaluable := simulatedTrampolines
at: aProcessorSimulationTrap address
ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
in: simulatedTrampolines].
function := evaluable isBlock
ifTrue: ['aBlock; probably some plugin primitive']
ifFalse:
[evaluable receiver == backEnd ifTrue:
[^self handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable].
evaluable selector].
function ~~ #ceBaseFrameReturn: ifTrue:
[coInterpreter assertValidExternalStackPointers].
(backEnd wantsNearAddressFor: function) ifTrue:
[^self perform: function with: aProcessorSimulationTrap].
memory := coInterpreter memory.
aProcessorSimulationTrap type == #call
ifTrue:
[(leaf := coInterpreter mcprims includes: function)
ifTrue:
[processor
simulateLeafCallOf: aProcessorSimulationTrap address
nextpc: aProcessorSimulationTrap nextpc
memory: memory.
retpc := processor leafRetpcIn: memory]
ifFalse:
[processor
simulateCallOf: aProcessorSimulationTrap address
nextpc: aProcessorSimulationTrap nextpc
memory: memory.
retpc := processor retpcIn: memory].
self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}]
ifFalse:
[leaf := false.
processor
simulateJumpCallOf: aProcessorSimulationTrap address
memory: memory.
retpc := processor retpcIn: memory. "sideways call; the primitive has pushed a return address."
self recordInstruction: {'(simulated jump to '. aProcessorSimulationTrap address. '/'. function. ')'}].
savedFramePointer := coInterpreter framePointer.
savedStackPointer := coInterpreter stackPointer.
savedArgumentCount := coInterpreter argumentCount.
result := ["self halt: evaluable selector."
clickConfirm ifTrue:
[(self confirm: 'skip run-time call?') ifFalse:
[clickConfirm := false. self halt]].
evaluable valueWithArguments: (processor
postCallArgumentsNumArgs: evaluable numArgs
in: 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:
+ [coInterpreter primFailCode = 0
- [coInterpreter checkForLastObjectOverwrite.
- coInterpreter primFailCode = 0
ifTrue: [(#( primitiveClosureValue primitiveClosureValueWithArgs primitiveClosureValueNoContextSwitch
primitiveFullClosureValue primitiveFullClosureValueWithArgs primitiveFullClosureValueNoContextSwitch
primitiveSignal primitiveWait primitiveResume primitiveSuspend primitiveYield
primitiveExecuteMethodArgsArray primitiveExecuteMethod
primitivePerform primitivePerformWithArgs primitivePerformInSuperclass
primitiveTerminateTo primitiveStoreStackp primitiveDoPrimitiveWithArgs)
includes: function) ifFalse:
["This is a rare case (e.g. in Scorch where a married context's sender is set to nil on trapTrpped and hence the stack layout is altered."
(function == #primitiveSlotAtPut and: [objectMemory isContext: (coInterpreter frameReceiver: coInterpreter framePointer)]) ifFalse:
[self assert: savedFramePointer = coInterpreter framePointer.
self assert: savedStackPointer + (savedArgumentCount * objectMemory wordSize)
= coInterpreter stackPointer]]]
ifFalse:
[self assert: savedFramePointer = coInterpreter framePointer.
self assert: savedStackPointer = coInterpreter stackPointer]].
result ~~ #continueNoReturn ifTrue:
[self recordInstruction: {'(simulated return to '. processor retpcIn: memory. ')'}.
leaf
ifTrue: [processor simulateLeafReturnIn: memory]
ifFalse: [processor simulateReturnIn: memory].
self assert: processor pc = retpc.
processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize in: 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>>setInterpreter: (in category 'initialization') -----
setInterpreter: aCoInterpreter
"Initialization of the code generator in the simulator.
These objects already exist in the generated C VM
or are used only in the simulation."
<doNotGenerate>
coInterpreter := aCoInterpreter.
objectMemory := aCoInterpreter objectMemory.
threadManager := aCoInterpreter threadManager. "N.B. may be nil"
methodZone := self class methodZoneClass new.
objectRepresentation := objectMemory objectRepresentationClass
forCogit: self methodZone: methodZone.
methodZone setInterpreter: aCoInterpreter
objectRepresentation: objectRepresentation
cogit: self.
generatorTable := self class generatorTable.
processor := ProcessorClass new.
simulatedAddresses := Dictionary new.
coInterpreter class clusteredVariableNames do:
[:cvn| self simulatedAddressFor: (cvn first = $C ifTrue: ['get', cvn] ifFalse: [cvn]) asSymbol].
simulatedTrampolines := Dictionary new.
simulatedVariableGetters := Dictionary new.
simulatedVariableSetters := Dictionary new.
traceStores := 0.
traceFlags := (self class initializationOptions at: #recordPrimTrace ifAbsent: [true])
ifTrue: [8] "record prim trace on by default (see Cogit class>>decareCVarsIn:)"
ifFalse: [0].
- debugPrimCallStackOffset := 0.
singleStep := printRegisters := printInstructions := clickConfirm := false.
backEnd := CogCompilerClass for: self.
methodLabel := CogCompilerClass for: self.
(literalsManager := backEnd class literalsManagerClass new) cogit: self.
ordinarySendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
superSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
BytecodeSetHasDirectedSuperSend ifTrue:
[directedSuperSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
directedSuperBindingSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
directedSendUsesBinding := false].
NewspeakVM ifTrue:
[selfSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
dynamicSuperSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
implicitReceiverSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
outerSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines)].
"debug metadata"
objectReferencesInRuntime := CArrayAccessor on: (Array new: NumObjRefsInRuntime).
runtimeObjectRefIndex := 0.
"debug metadata"
trampolineAddresses := CArrayAccessor on: (Array new: NumTrampolines * 2).
trampolineTableIndex := 0.

extA := numExtB := extB := 0.

compilationTrace ifNil: [compilationTrace := self class initializationOptions at: #compilationTrace ifAbsent: [0]].
debugOpcodeIndices := self class initializationOptions at: #debugOpcodeIndices ifAbsent: [Set new].
debugBytecodePointers := self class initializationOptions at: #debugBytecodePointers ifAbsent: [Set new].
self class initializationOptions at: #breakPC ifPresent: [:pc| breakPC := pc]!

Item was changed:
----- Method: Cogit>>simulateLeafCallOf: (in category 'simulation only') -----
simulateLeafCallOf: someFunction
"Simulate execution of machine code that leaf-calls someFunction,
answering the result returned by someFunction."
"CogProcessorAlienInspector openFor: coInterpreter"
<doNotGenerate>
+ | priorSP priorPC priorLR spOnEntry bogusRetPC |
- | priorSP priorPC spOnEntry bogusRetPC |
self recordRegisters.
priorSP := processor sp.
priorPC := processor pc.
+ priorLR := backEnd hasLinkRegister ifTrue: [processor lr].
processor
setFramePointer: coInterpreter getCFramePointer stackPointer: coInterpreter getCStackPointer;
simulateLeafCallOf: someFunction
nextpc: (bogusRetPC := 16rBADF00D5 roundTo: backEnd codeGranularity)
memory: coInterpreter memory.
spOnEntry := processor sp.
self recordInstruction: {'(simulated call of '. someFunction. ')'}.
+ [[processor pc between: 0 and: methodZone zoneEnd] whileTrue:
- [processor pc between: 0 and: methodZone zoneEnd] whileTrue:
[[singleStep
ifTrue: [self recordProcessing.
self maybeBreakAt: processor pc.
processor
singleStepIn: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd]
ifFalse: [processor
runInMemory: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd]]
on: ProcessorSimulationTrap, Error
do: [:ex| | retpc |
processor pc = bogusRetPC ifTrue:
[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}.
^processor cResultRegister].
ex class == ProcessorSimulationTrap ifTrue:
[ex type == #read ifTrue:
[self handleReadSimulationTrap: ex. ex resume: processor].
ex type == #write ifTrue:
[self handleWriteSimulationTrap: ex. ex resume: processor].
ex type == #return ifTrue:
[retpc := processor leafRetpcIn: coInterpreter memory.
self assert: retpc = bogusRetPC.
processor simulateLeafReturnIn: coInterpreter memory.
self recordInstruction: {'(simulated return to '. retpc. ')'}.
^processor cResultRegister]].
ex pass]].
processor pc = bogusRetPC ifTrue:
[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}].
+ ^processor cResultRegister]
+ ensure:
+ [processor sp: priorSP.
+ processor pc: priorPC.
+ priorLR ifNotNil: [:lr| processor lr: lr]]!
- ^processor cResultRegister!

Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>getCheckAllocFiller (in category 'cog jit support') -----
- getCheckAllocFiller
- ^coInterpreter getCheckAllocFiller ifNil: [false]!

Item was removed:
- ----- Method: ImageLeakChecker>>checkAllocFiller (in category 'no-op overrides') -----
- checkAllocFiller
- <inline: #always>
- ^false!

Item was changed:
----- Method: InterpreterPlugin>>getModuleName (in category 'initialize') -----
getModuleName
"Note: This is hardcoded so it can be run from Squeak.
The module name is used for validating a module *after*
it is loaded to check if it does really contain the module
we're thinking it contains. This is important!!"
<returnTypeC:'const char*'>
<export: true>
^self cCode: [moduleName]
inSmalltalk:
+ [| string index |
+ string := ((self class codeGeneratorClass new pluginClass: self class) variableDeclarationStringsForVariable: 'moduleName') first.
+ index := (string indexOfSubCollection: 'moduleName = "') + 14.
+ (string copyFrom: index to: (string indexOf: $" startingAt: index + 1) - 1), '(i)']!
- [self class codeGeneratorClass new pluginClass: self class]!

Item was changed:
----- Method: InterpreterPrimitives>>canBeImmutable: (in category 'object access primitives') -----
canBeImmutable: oop
<option: #IMMUTABILITY>
| scheduler processLists |

self assert: (objectMemory isNonImmediate: oop).

"For now we fail the primitive for contexts to we ensure there are no immutable contexts.
Later we can consider having immutable contexts and send cannotReturn callback
when returning to an immutable context. That would mean that setting a context
to immutable would require a divorce and returns to immutable context are
necessarily across stack pages"
(objectMemory isContext: oop) ifTrue: [ ^ false ].

"Weak structures can't be immutable"
(objectMemory isEphemeron: oop) ifTrue: [^ false].
(objectMemory isWeakNonImm: oop) ifTrue: [^ false].

"No clue what is going on for semaphores so they can't be immutable"
(objectMemory isSemaphoreObj: oop) ifTrue: [^ false].

"Simple version of process management: we forbid Process and LinkedList instances to be immutable
as well as the Processor and the array of activeProcess"
+ scheduler := self fetchPointer: ValueIndex ofObject: (objectMemory splObj: SchedulerAssociation).
- scheduler := self fetchPointer: ValueIndex ofObject: (self splObj: SchedulerAssociation).
processLists := objectMemory fetchPointer: ProcessListsIndex ofObject: scheduler.
oop = scheduler ifTrue: [ ^ false ].
oop = processLists ifTrue: [ ^ false ].
"Is it a linkedList ?"
(objectMemory classIndexOf: (objectMemory fetchPointer: 1 ofObject: processLists)) = (objectMemory classIndexOf: oop) ifTrue: [ ^ false ].
"is it a Process ?"
(objectMemory classIndexOf: (objectMemory fetchPointer: ActiveProcessIndex ofObject: scheduler)) = (objectMemory classIndexOf: oop) ifTrue: [ ^ false ].

"The rest of the code is relative to process management: the Processor (the active
process scheduler) can't be immutable, as well as all the objects relative to Process management "
"scheduler := self fetchPointer: ValueIndex ofObject: (self splObj: SchedulerAssociation).
processLists := objectMemory fetchPointer: ProcessListsIndex ofObject: scheduler.
((objectMemory formatOf: oop) = objectMemory nonIndexablePointerFormat)
ifFalse:
[ (objectMemory isArrayNonImm: oop) ifFalse: [ ^ true ].
^ (oop = processLists) not ].
(objectMemory numSlotsOf: oop) >= 2 ifFalse: [ ^ true ].
""is the oop the scheduler itself ?""
oop = scheduler ifTrue: [ ^ false ].
1 to: (objectMemory numSlotsOf: processLists) do: [ :i |
""is the oop one of the linked lists ?""
(list := processLists at: i) = oop ifTrue: [^ false].
""is the oop one of the runnable process ?""
first := objectMemory fetchPointer: FirstLinkIndex ofObject: list.
first = objectMemory nilObject ifFalse:
[ last := objectMemory fetchPointer: LastLinkIndex ofObject: list.
link := first.
[ link = last ] whileFalse:
[ link = oop ifTrue: [ ^ false ].
link := objectMemory fetchPointer: NextLinkIndex ofObject: link. ] ] ]."
^ true!

Item was changed:
----- Method: NewObjectMemory>>allInstancesOf: (in category 'primitive support') -----
allInstancesOf: aBehavior
"Attempt to answer all instances of aBehavior, failing if there is not enough room."
| count container fillPointer obj byteSize afterPreAllocatedObject |
"Allocate a large header Array of sufficient size to require a large header.
Reset its size later."
container := self instantiateClass: (self splObj: ClassArray) indexableSize: self minLargeHeaderSize.
self sizeHeader: container putBodySize: 0.
afterPreAllocatedObject := freeStart.
freeStart := fillPointer := (self firstFixedField: container) asInteger.
count := 0.
obj := self firstObject.
[self oop: obj isLessThan: container] whileTrue:
[(self isFreeObject: obj) ifFalse:
[(self fetchClassOfNonImm: obj) = aBehavior ifTrue:
[count := count + 1.
fillPointer < reserveStart ifTrue:
[self longAt: fillPointer put: obj.
fillPointer := fillPointer + self bytesPerOop]]].
obj := self accessibleObjectAfter: obj].
+ fillPointer >= reserveStart ifTrue: "didn't fit; answer instance count so large enough container can be allocated."
+ [^self integerObjectOf: count].
- fillPointer >= reserveStart ifTrue: "didn't fit. refill with allocation check pattern and answer count."
- [self maybeFillWithAllocationCheckFillerFrom: freeStart to: fillPointer.
- ^self integerObjectOf: count].
byteSize := fillPointer - (self firstFixedField: container) asInteger.
self sizeHeader: container putBodySize: byteSize.
- "Need to refill with the allocation check pattern if we shortened the object."
- fillPointer < afterPreAllocatedObject ifTrue:
- [self maybeFillWithAllocationCheckFillerFrom: fillPointer to: afterPreAllocatedObject].
freeStart := fillPointer.
^container!

Item was removed:
- ----- Method: NewObjectMemory>>checkAllocFiller (in category 'allocation') -----
- checkAllocFiller
- <doNotGenerate>
- "in the Spur bootstrap coInterpreter may not be initialized..."
- ^coInterpreter notNil and: [coInterpreter checkAllocFiller]!

Item was changed:
----- Method: NewObjectMemory>>initializeMemoryFirstFree: (in category 'initialization') -----
initializeMemoryFirstFree: firstFree
"Initialize endOfMemory to the top of oop storage space, reserving some space
for forwarding blocks, and set freeStart from which space is allocated."
"Note: The amount of space reserved for forwarding blocks should be chosen to
ensure that incremental compactions can usually be done in a single pass.
However, there should be enough forwarding blocks so a full compaction can be done
in a reasonable number of passes, say ten. (A full compaction requires N object-moving
passes, where N = number of non-garbage objects / number of forwarding blocks).

di 11/18/2000 Re totalObjectCount: Provide a margin of one byte per object to be
used for forwarding pointers at GC time. Since fwd blocks are 8 bytes, this means
an absolute worst case of 8 passes to compact memory. In most cases it will be
adequate to do compaction in a single pass. "
| fwdBlockBytes totalReserve |
"reserve space for forwarding blocks and the interpreter. We can sacrifice
forwarding block space at the cost of slower compactions but we cannot
safely sacrifice interpreter allocation headroom."
fwdBlockBytes := totalObjectCount bitAnd: WordMask - self wordSize + 1.
totalReserve := fwdBlockBytes + coInterpreter interpreterAllocationReserveBytes.
(self oop: memoryLimit - totalReserve isLessThan: firstFree + self baseHeaderSize) ifTrue:
["reserve enough space for a minimal free block of BaseHeaderSize bytes.
We are apparently in an emergency situation here because we have no space
for reserve and forwarding blocks. But a full GC will occur immediately in
sufficientSpaceAfterGC: which will grow memory and restore the reserve."
fwdBlockBytes := memoryLimit - (firstFree + self baseHeaderSize)].

"set endOfMemory reserveStart and freeStart"
self setEndOfMemory: memoryLimit - fwdBlockBytes.
reserveStart := endOfMemory - coInterpreter interpreterAllocationReserveBytes.
freeStart := firstFree. "bytes available for oops"
scavengeThreshold := freeStart + edenBytes min: reserveStart.
- self maybeFillWithAllocationCheckFillerFrom: freeStart to: scavengeThreshold.

self assert: (self oop: freeStart isLessThan: reserveStart).
"We would like to assert this but can't because in GC situations it may be false. It is
established by sufficientSpaceToAllocate: and sufficientSpaceAfterGC:"
false ifTrue: [self assert: (self oop: reserveStart isLessThan: endOfMemory)].
self assert: (self oop: endOfMemory isLessThan: memoryLimit)!

Item was removed:
- ----- Method: NewObjectMemory>>maybeFillWithAllocationCheckFillerFrom:to: (in category 'allocation') -----
- maybeFillWithAllocationCheckFillerFrom: start to: end
- "Fill free memory with a bit pattern for checking if the last object has been overwritten."
- <inline: true>
- <var: 'start' type: #usqInt>
- <var: 'end' type: #usqInt>
- <var: 'p' type: #usqInt>
- self checkAllocFiller ifTrue:
- [start to: end by: self wordSize do:
- [:p| self longAt: p put: p]]!

Item was changed:
----- Method: NewObjectMemory>>shorten:toIndexableSize: (in category 'allocation') -----
shorten: obj toIndexableSize: nSlots
"Reduce the number of indexable fields in obj, a pointer object, to nSlots. Convert the
unused residual to a free chunk. Word and byte indexable objects are not changed.
Answer the number of bytes returned to free memory, which may be zero if no change
was possible."
| deltaBytes desiredLength fixedFields fmt hdr totalLength
indexableFields |
<api>
(self isPointersNonImm: obj) ifFalse: [^0].
nSlots > 0
ifFalse: [^0]. "no change if nSlots is zero, error if nSlots is negative"
hdr := self baseHeader: obj.
fmt := self formatOfHeader: hdr.
totalLength := self lengthOf: obj baseHeader: hdr format: fmt.
fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength.
indexableFields := totalLength - fixedFields.
nSlots >= indexableFields
ifTrue: [^0]. "no change, or error if attempting to increase size into next chunk"
desiredLength := fixedFields + nSlots.
deltaBytes := (totalLength - desiredLength) * self wordSize.
obj + self baseHeaderSize + (totalLength * self wordSize) = freeStart
ifTrue: "Shortening the last object. Need to reduce freeStart."
+ [freeStart := obj + self baseHeaderSize + (desiredLength * self wordSize)]
- [self maybeFillWithAllocationCheckFillerFrom: obj + self baseHeaderSize + (desiredLength * self wordSize) to: freeStart.
- freeStart := obj + self baseHeaderSize + (desiredLength * self wordSize)]
ifFalse: "Shortening some interior object. Need to create a free block."
[self setSizeOfFree: obj + self baseHeaderSize + (desiredLength * self wordSize)
to: deltaBytes].
(self headerType: obj) caseOf: {
[HeaderTypeSizeAndClass] ->
[self longAt: (obj - (self baseHeaderSize * 2)) put: (self sizeHeader: obj) - deltaBytes].
[HeaderTypeClass] ->
[self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)].
[HeaderTypeShort] ->
[self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)] }.
^deltaBytes!

Item was changed:
----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive:flags: (in category 'primitive generators') -----
compileInterpreterPrimitive: primitiveRoutine flags: flags
"Compile a call to an interpreter primitive. Call the C routine with the
usual stack-switching dance, test the primFailCode and then either
return on success or continue to the method body."
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
| jmp jmpSamplePrim continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim |
<var: #jmp type: #'AbstractInstruction *'>
<var: #jmpSamplePrim type: #'AbstractInstruction *'>
<var: #jmpSampleNonPrim type: #'AbstractInstruction *'>
<var: #continuePostSamplePrim type: #'AbstractInstruction *'>
<var: #continuePostSampleNonPrim type: #'AbstractInstruction *'>

"Save processor fp, sp and return pc in the interpreter's frame stack and instruction pointers"
self genExternalizePointersForPrimitiveCall.
"Switch to the C stack."
self genLoadCStackPointersForPrimCall.

(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
["Test nextProfileTick for being non-zero and call checkProfileTick if so"
objectMemory wordSize = 4
ifTrue:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
self OrR: TempReg R: ClassReg]
ifFalse:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self CmpCq: 0 R: TempReg].
"If set, jump to record sample call."
jmpSampleNonPrim := self JumpNonZero: 0.
continuePostSampleNonPrim := self Label].

"Old full prim trace is in VMMaker-eem.550 and prior"
self recordPrimTrace ifTrue:
[self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].

"Clear the primFailCode and set argumentCount"
self MoveCq: 0 R: TempReg.
self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
methodOrBlockNumArgs ~= 0 ifTrue:
[self MoveCq: methodOrBlockNumArgs R: TempReg].
self MoveR: TempReg Aw: coInterpreter argumentCountAddress.

"If required, set primitiveFunctionPointer and newMethod"
(flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue:
[self MoveCw: primitiveRoutine asInteger R: TempReg.
primSetFunctionLabel :=
self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress].
(flags anyMask: PrimCallNeedsNewMethod+PrimCallMayCallBack) ifTrue:
["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
(flags anyMask: PrimCallMayCallBack) ifTrue:
[needsFrame := true].
methodLabel addDependent:
(self annotateAbsolutePCRef:
(self MoveCw: methodLabel asInteger R: ClassReg)).
self MoveMw: (self offset: CogMethod of: #methodObject) r: ClassReg R: TempReg.
self MoveR: TempReg Aw: coInterpreter newMethodAddress].

"Invoke the primitive"
self PrefetchAw: coInterpreter primFailCodeAddress.
(flags anyMask: PrimCallMayCallBack)
ifTrue: "Sideways call the C primitive routine so that we return through cePrimReturnEnterCogCode."
["On Spur ceActivateFailingPrimitiveMethod: would like to retry if forwarders
are found. So insist on PrimCallNeedsPrimitiveFunction being set too."
self assert: (flags anyMask: PrimCallNeedsPrimitiveFunction).
backEnd
+ genMarshallNArgs: 0 arg: nil arg: nil arg: nil arg: nil;
- genMarshallNArgs: 0 arg: 0 arg: 0 arg: 0 arg: 0;
genSubstituteReturnAddress:
((flags anyMask: PrimCallCollectsProfileSamples)
ifTrue: [cePrimReturnEnterCogCodeProfiling]
ifFalse: [cePrimReturnEnterCogCode]).
primInvokeInstruction := self JumpFullRT: primitiveRoutine asInteger.
jmp := jmpSamplePrim := continuePostSamplePrim := nil]
ifFalse:
["Call the C primitive routine."
backEnd genMarshallNArgs: 0 arg: 0 arg: 0 arg: 0 arg: 0.
primInvokeInstruction := self CallFullRT: primitiveRoutine asInteger.
backEnd genRemoveNArgsFromStack: 0.
(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
[self assert: (flags anyMask: PrimCallNeedsNewMethod).
"Test nextProfileTick for being non-zero and call checkProfileTick if so"
objectMemory wordSize = 4
ifTrue:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
self OrR: TempReg R: ClassReg]
ifFalse:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self CmpCq: 0 R: TempReg].
"If set, jump to record sample call."
jmpSamplePrim := self JumpNonZero: 0.
continuePostSamplePrim := self Label].
objectRepresentation maybeCompileRetryOnPrimitiveFail: primitiveIndex.
- self maybeCompileAllocFillerCheck.
"Switch back to the Smalltalk stack. Stack better be in either of these two states:
success: stackPointer -> result (was receiver)
arg1
...
argN
return pc
failure: receiver
arg1
...
stackPointer -> argN
return pc
In either case we can push the instructionPointer or load it into the LinkRegister to reestablish the return pc"
self MoveAw: coInterpreter instructionPointerAddress
R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
backEnd genLoadStackPointers.
"Test primitive failure"
self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
backEnd hasLinkRegister ifFalse: [self PushR: ClassReg]. "Restore return pc on CISCs"
self flag: 'ask concrete code gen if move sets condition codes?'.
self CmpCq: 0 R: TempReg.
jmp := self JumpNonZero: 0.
"Fetch result from stack"
self MoveMw: (backEnd hasLinkRegister ifTrue: [0] ifFalse: [objectMemory wordSize])
r: SPReg
R: ReceiverResultReg.
self RetN: objectMemory wordSize]. "return to caller, popping receiver"

(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
["The sample is collected by cePrimReturnEnterCogCode for external calls"
jmpSamplePrim ifNotNil:
["Call ceCheckProfileTick: to record sample and then continue."
jmpSamplePrim jmpTarget: self Label.
self assert: (flags anyMask: PrimCallNeedsNewMethod).
self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedIntegerPtr]
inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
"reenter the post-primitive call flow"
self Jump: continuePostSamplePrim].
"Null newMethod and call ceCheckProfileTick: to record sample and then continue.
ceCheckProfileTick will map null/0 to coInterpreter nilObject"
jmpSampleNonPrim jmpTarget: self Label.
self MoveCq: 0 R: TempReg.
self MoveR: TempReg Aw: coInterpreter newMethodAddress.
self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedIntegerPtr]
inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
"reenter the post-primitive call flow"
self Jump: continuePostSampleNonPrim].

jmp ifNotNil:
["Jump to restore of receiver reg and proceed to frame build for failure."
jmp jmpTarget: self Label.
"Restore receiver reg from stack. If on RISCs ret pc is in LinkReg, if on CISCs ret pc is on stack."
self MoveMw: objectMemory wordSize * (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1]))
r: SPReg
R: ReceiverResultReg].
^0!

Item was changed:
----- Method: SimpleStackBasedCogit>>compilePrimitive (in category 'primitive generators') -----
compilePrimitive
"Compile a primitive. If possible, performance-critical primtiives will
be generated by their own routines (primitiveGenerator). Otherwise,
if there is a primitive at all, we call the C routine with the usual
stack-switching dance, test the primFailCode and then either return
on success or continue to the method body."
<inline: false>
+ | primitiveDescriptor primitiveRoutine flags |
- | code opcodeIndexAtPrimitive primitiveDescriptor primitiveRoutine flags |
<var: #primitiveDescriptor type: #'PrimitiveDescriptor *'>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
primitiveIndex = 0 ifTrue: [^0].
- code := 0.
- "Note opcodeIndex so that compileFallbackToInterpreterPrimitive:
- can discard arg load instructions for unimplemented primitives."
- opcodeIndexAtPrimitive := opcodeIndex.
"If a descriptor specifies an argument count (by numArgs >= 0) then it must match
for the generated code to be correct. For example for speed many primitives use
ResultReceiverReg instead of accessing the stack, so the receiver better be at
numArgs down the stack. Use the interpreter version if not."
((primitiveDescriptor := self primitiveGeneratorOrNil) notNil
and: [primitiveDescriptor primitiveGenerator notNil
+ and: [(primitiveDescriptor primNumArgs < 0 "means generator doesn't care"
- and: [(primitiveDescriptor primNumArgs < 0 "means don't care"
or: [primitiveDescriptor primNumArgs = (coInterpreter argumentCountOf: methodObj)])]]) ifTrue:
+ [| opcodeIndexAtPrimitive code |
+ "Note opcodeIndex so that any arg load instructions
+ for unimplemented primitives can be discarded."
+ opcodeIndexAtPrimitive := opcodeIndex.
+ code := objectRepresentation perform: primitiveDescriptor primitiveGenerator.
- [code := objectRepresentation perform: primitiveDescriptor primitiveGenerator].
- (code < 0 and: [code ~= UnimplementedPrimitive]) ifTrue: "Generator failed, so no point continuing..."
- [^code].
- code = UnfailingPrimitive ifTrue:
- [^0].
- "If the machine code verison handles all cases the only reason to call the interpreter
- primitive is to reap the primitive error code. Don't bother if it isn't used."
- (code = CompletePrimitive
- and: [(self methodUsesPrimitiveErrorCode: methodObj header: methodHeader) not]) ifTrue:
- [^0].
- "Discard any arg load code generated by the primitive generator."
- code = UnimplementedPrimitive ifTrue:
- [opcodeIndex := opcodeIndexAtPrimitive].

+ (code < 0 and: [code ~= UnimplementedPrimitive]) ifTrue: "Generator failed, so no point continuing..."
+ [^code].
+ "If the primitive can never fail then there is nothing more that needs to be done."
+ code = UnfailingPrimitive ifTrue:
+ [^0].
+ "If the machine code version handles all cases the only reason to call the interpreter
+ primitive is to reap the primitive error code. Don't bother if it isn't used."
+ (code = CompletePrimitive
+ and: [(self methodUsesPrimitiveErrorCode: methodObj header: methodHeader) not]) ifTrue:
+ [^0].
+ "Discard any arg load code generated by the primitive generator."
+ code = UnimplementedPrimitive ifTrue:
+ [opcodeIndex := opcodeIndexAtPrimitive]].
+
flags := coInterpreter primitivePropertyFlags: primitiveIndex.
(flags anyMask: PrimCallDoNotJIT) ifTrue:
[^ShouldNotJIT].

(flags anyMask: PrimCallOnSmalltalkStack) ifTrue:
[self assert: flags = PrimCallOnSmalltalkStack.
^self compileMachineCodeInterpreterPrimitive: (self cCoerceSimple: (coInterpreter mcprimFunctionForPrimitiveIndex: primitiveIndex)
to: 'void (*)(void)')].

((primitiveRoutine := coInterpreter
functionPointerForCompiledMethod: methodObj
primitiveIndex: primitiveIndex) = 0 "no primitive"
or: [primitiveRoutine = (self cCoerceSimple: #primitiveFail to: 'void (*)(void)')]) ifTrue:
[^self genFastPrimFail].
minValidCallAddress := minValidCallAddress min: primitiveRoutine asUnsignedInteger.
^self compileInterpreterPrimitive: primitiveRoutine flags: flags!

Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimReturnEnterCogCodeEnilopmart: (in category 'initialization') -----
genPrimReturnEnterCogCodeEnilopmart: profiling
"Generate the substitute return code for an external or FFI primitive call.
On success simply return, extracting numArgs from newMethod.
On primitive failure call ceActivateFailingPrimitiveMethod: newMethod."
| jmpSample continuePostSample jmpFail |
<var: #jmpSample type: #'AbstractInstruction *'>
<var: #continuePostSample type: #'AbstractInstruction *'>
<var: #jmpFail type: #'AbstractInstruction *'>
self zeroOpcodeIndex.
backEnd hasVarBaseRegister ifTrue:
[self MoveCq: self varBaseAddress R: VarBaseReg]. "Must happen sometime"

profiling ifTrue:
["Test nextProfileTick for being non-zero and call checkProfileTick: if so.
N.B. nextProfileTick is 64-bits so 32-bit systems need to test both halves."
objectMemory wordSize = 4
ifTrue:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
self OrR: TempReg R: ClassReg]
ifFalse:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self CmpCq: 0 R: TempReg].
"If set, jump to record sample call."
jmpSample := self JumpNonZero: 0.
continuePostSample := self Label].

- self maybeCompileAllocFillerCheck.
-
"Test primitive failure"
self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
self flag: 'ask concrete code gen if move sets condition codes?'.
self CmpCq: 0 R: TempReg.
jmpFail := self JumpNonZero: 0.

"Switch back to the Smalltalk stack. Stack better be in either of these two states:
success: stackPointer -> result (was receiver)
arg1
...
argN
return pc
failure: receiver
arg1
...
stackPointer -> argN
return pc
We push the instructionPointer to reestablish the return pc in the success case,
but leave it to ceActivateFailingPrimitiveMethod: to do so in the failure case."

backEnd hasLinkRegister
ifTrue:
[backEnd genLoadStackPointers. "Switch back to Smalltalk stack."
backEnd hasPCRegister
ifTrue:
[self PopR: ReceiverResultReg. "Pop result from stack"
self MoveAw: coInterpreter instructionPointerAddress R: PCReg] "Return"
ifFalse:
[self MoveMw: 0 r: SPReg R: ReceiverResultReg. "Fetch result from stack"
self MoveAw: coInterpreter instructionPointerAddress R: LinkReg. "Get ret pc"
self RetN: objectMemory wordSize]] "Return, popping result from stack"
ifFalse:
[self MoveAw: coInterpreter instructionPointerAddress R: ClassReg. "Get return pc"
backEnd genLoadStackPointers. "Switch back to Smalltalk stack."
self MoveMw: 0 r: SPReg R: ReceiverResultReg. "Fetch result from stack"
self MoveR: ClassReg Mw: 0 r: SPReg. "Restore return pc"
self RetN: 0]. "Return, popping result from stack"

"Primitive failed. Invoke C code to build the frame and continue."
jmpFail jmpTarget: (self MoveAw: coInterpreter newMethodAddress R: SendNumArgsReg).
"Reload sp with CStackPointer; easier than popping args of checkProfileTick."
self MoveAw: self cStackPointerAddress R: SPReg.
self
compileCallFor: #ceActivateFailingPrimitiveMethod:
numArgs: 1
arg: SendNumArgsReg
arg: nil
arg: nil
arg: nil
resultReg: NoReg
regsToSave: self emptyRegisterMask.

"On Spur ceActivateFailingPrimitiveMethod: may retry the primitive and return if successful.
So continue by returning to the caller.
Switch back to the Smalltalk stack. Stack should be in this state:
success: stackPointer -> result (was receiver)
arg1
...
argN
return pc
We can push the instructionPointer or load it into the LinkRegister to reestablish the return pc"
self MoveAw: coInterpreter instructionPointerAddress
R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
backEnd genLoadStackPointers.
backEnd hasLinkRegister
ifTrue:
[self MoveMw: 0 r: SPReg R: ReceiverResultReg] "Fetch result from stack"
ifFalse:
[self MoveMw: objectMemory wordSize r: SPReg R: ReceiverResultReg. "Fetch result from stack"
self PushR: ClassReg]. "Restore return pc on CISCs"
self RetN: objectMemory wordSize. "return to caller, popping receiver"

profiling ifTrue:
["Call ceCheckProfileTick: to record sample and then continue. newMethod
should be up-to-date. Need to save and restore the link reg around this call."
jmpSample jmpTarget: self Label.
backEnd saveAndRestoreLinkRegAround:
[self CallFullRT: (self cCode: '(usqIntptr_t)ceCheckProfileTick'
inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick])].
self Jump: continuePostSample]!

Item was removed:
- ----- Method: SimpleStackBasedCogit>>maybeCompileAllocFillerCheck (in category 'primitive generators') -----
- maybeCompileAllocFillerCheck
- "If allocCheckFiller is true, words in newSpace from freeStart to scavengeThreshold
- are filled with their address, and after each call of a plugin primitive, the VM checks
- that freeStart points to a word containing the value of freeStart. This is a simple
- check for primitives overwriting the ends of an object."
- | jmpOk |
- <var: #jmpOk type: #'AbstractInstruction *'>
- coInterpreter getCheckAllocFiller ifTrue:
- [self MoveAw: objectMemory freeStartAddress R: ClassReg.
- self MoveMw: 0 r: ClassReg R: TempReg.
- self CmpR: ClassReg R: TempReg.
- jmpOk := self JumpZero: 0.
- self MoveCq: PrimErrWritePastObject R: TempReg.
- self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
- jmpOk jmpTarget: self Label]!

Item was changed:
----- Method: SpurGenerationScavenger>>newSpaceStart:newSpaceBytes:survivorBytes: (in category 'initialization') -----
newSpaceStart: startAddress newSpaceBytes: totalBytes survivorBytes: requestedSurvivorBytes
| actualEdenBytes survivorBytes |
survivorBytes := requestedSurvivorBytes truncateTo: manager allocationUnit.
actualEdenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
self assert: totalBytes - actualEdenBytes - survivorBytes - survivorBytes < manager allocationUnit.

"for tenuring we require older objects below younger objects. since allocation
grows up this means that the survivor spaces must precede eden."

pastSpace start: startAddress; limit: startAddress + survivorBytes.
futureSpace start: pastSpace limit; limit: pastSpace limit + survivorBytes.
eden start: futureSpace limit; limit: startAddress + totalBytes.

self assert: self futureSpace limit <= (startAddress + totalBytes).
self assert: self eden start \\ manager allocationUnit
+ (self eden limit \\ manager allocationUnit) = 0.
self assert: self pastSpace start \\ manager allocationUnit
+ (self pastSpace limit \\ manager allocationUnit) = 0.
self assert: self futureSpace start \\ manager allocationUnit
+ (self futureSpace limit \\ manager allocationUnit) = 0.

self initFutureSpaceStart.
- manager initSpaceForAllocationCheck: (self addressOf: eden) limit: eden limit.

tenuringProportion := 0.9!

Item was removed:
- ----- Method: SpurMemoryManager>>checkAllocFiller (in category 'allocation') -----
- checkAllocFiller
- <doNotGenerate>
- "in the Spur bootstrap coInterpreter may not be initialized..."
- ^coInterpreter notNil and: [coInterpreter checkAllocFiller]!

Item was changed:
----- Method: SpurMemoryManager>>containsOnlyValidBecomeObjects:and:twoWay:copyHash: (in category 'become implementation') -----
containsOnlyValidBecomeObjects: array1 and: array2 twoWay: isTwoWay copyHash: copyHash
"Answer 0 if neither array contains an object inappropriate for the become operation.
Otherwise answer an informative error code for the first offending object found:
Can't become: immediates => PrimErrInappropriate
Shouldn't become pinned objects => PrimErrObjectIsPinned.
Shouldn't become immutable objects => PrimErrNoModification.
Can't copy hash into immediates => PrimErrInappropriate.
Two-way become may require memory to create copies => PrimErrNoMemory.
As a side-effect unforward any forwarders in the two arrays if answering 0."
<inline: true>
| fieldOffset effectsFlags oop1 oop2 size |
fieldOffset := self lastPointerOf: array1.
effectsFlags := size := 0.
"array1 is known to be the same size as array2"
[fieldOffset >= self baseHeaderSize] whileTrue:
[oop1 := self longAt: array1 + fieldOffset.
(self isOopForwarded: oop1) ifTrue:
[oop1 := self followForwarded: oop1.
self longAt: array1 + fieldOffset put: oop1].
self ifOopInvalidForBecome: oop1 errorCodeInto: [:errCode| ^errCode].
- effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop1).
oop2 := self longAt: array2 + fieldOffset.
(self isOopForwarded: oop2) ifTrue:
[oop2 := self followForwarded: oop2.
self longAt: array2 + fieldOffset put: oop2].
isTwoWay
ifTrue:
[self ifOopInvalidForBecome: oop2 errorCodeInto: [:errCode| ^errCode].
+ oop1 ~= oop2 ifTrue:
+ [size := size + (self bytesInObject: oop1) + (self bytesInObject: oop2).
+ effectsFlags := (effectsFlags
+ bitOr: (self becomeEffectFlagsFor: oop1))
+ bitOr: (self becomeEffectFlagsFor: oop2)]]
- size := size + (self bytesInObject: oop1) + (self bytesInObject: oop2).
- effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop2)]
ifFalse:
[(copyHash and: [(self isImmediate: oop2) or: [self isImmutable: oop2]]) ifTrue:
+ [^PrimErrInappropriate].
+ oop1 ~= oop2 ifTrue:
+ [effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop1)]].
- [^PrimErrInappropriate]].
fieldOffset := fieldOffset - self bytesPerOop].
size >= (totalFreeOldSpace + (scavengeThreshold - freeStart)) ifTrue:
[^PrimErrNoMemory].
"only set flags after checking all args."
becomeEffectsFlags := effectsFlags.
^0!

Item was changed:
----- Method: SpurMemoryManager>>doScavenge: (in category 'gc - scavenging') -----
doScavenge: tenuringCriterion
"The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it."
<inline: false>
self doAllocationAccountingForScavenge.
gcPhaseInProgress := ScavengeInProgress.
pastSpaceStart := scavenger scavenge: tenuringCriterion.
self assert: (self
oop: pastSpaceStart
isGreaterThanOrEqualTo: scavenger pastSpace start
andLessThanOrEqualTo: scavenger pastSpace limit).
freeStart := scavenger eden start.
- self initSpaceForAllocationCheck: (self addressOf: scavenger eden) limit: scavengeThreshold.
gcPhaseInProgress := 0.
self resetAllocationAccountingAfterGC!

Item was removed:
- ----- Method: SpurMemoryManager>>initSpaceForAllocationCheck:limit: (in category 'allocation') -----
- initSpaceForAllocationCheck: aNewSpace limit: limit
- <var: 'aNewSpace' type: #'SpurNewSpaceSpace *'>
- <var: 'limit' type: #usqInt>
- memory ifNotNil:
- [self checkAllocFiller ifTrue:
- [aNewSpace start
- to: limit - 1
- by: self wordSize
- do: [:p| self longAt: p put: p]]]!

Item was changed:
----- Method: SpurMemoryManager>>initializeNewSpaceVariables (in category 'gc - scavenging') -----
initializeNewSpaceVariables
<inline: #never>
freeStart := scavenger eden start.
pastSpaceStart := scavenger pastSpace start.
scavengeThreshold := scavenger eden limit
- (scavenger edenBytes // 64)
- coInterpreter interpreterAllocationReserveBytes.
newSpaceStart := scavenger pastSpace start min: scavenger futureSpace start.
+ self assert: newSpaceStart < scavenger eden start!
- self assert: newSpaceStart < scavenger eden start.
- self initSpaceForAllocationCheck: (self addressOf: scavenger eden) limit: scavengeThreshold!

Item was changed:
----- Method: SpurMemoryManager>>queueMourner: (in category 'weakness and ephemerality') -----
queueMourner: anEphemeronOrWeakArray
+ "Add the ephemeron or weak array to the queue."
- "Add the ephemeron to the queue and make it non-ephemeral, to avoid subsequent firing.
- Alas this means that other ephemerons on the same object not identified in this sccavenge
- or GC will not fire until later. But that's life."
self assert: ((self isNonImmediate: anEphemeronOrWeakArray)
and: [(self formatOf: anEphemeronOrWeakArray) = self ephemeronFormat
or: [(self formatOf: anEphemeronOrWeakArray) = self weakArrayFormat]]).
self deny: ((self formatOf: anEphemeronOrWeakArray) = self ephemeronFormat
and: [self is: anEphemeronOrWeakArray onObjStack: mournQueue]).
self ensureRoomOnObjStackAt: MournQueueRootIndex.
+ "There is no point queueing weak arrays more than once. Note that it should be impossible
+ for ephemerons to be enqueued more than once since they are turned into non-ephemerons
+ in the relevant sender. Alas this means that other ephemerons on the same object not
+ identified in this scavenge or GC will not fire until later. But that's life."
+ (self isEphemeron: anEphemeronOrWeakArray) ifFalse:
+ [(self is: anEphemeronOrWeakArray onObjStack: mournQueue) ifTrue:
+ [^self]].
self push: anEphemeronOrWeakArray onObjStack: mournQueue!

Item was changed:
InterpreterPrimitives subclass: #StackInterpreter
(excessive size, no diff calculated)

Item was changed:
----- Method: StackInterpreter>>callExternalPrimitive: (in category 'plugin primitive support') -----
callExternalPrimitive: functionID
"Call the external plugin function identified. In the VM this is an address;
see StackInterpreterSimulator for its version."

<var: #functionID declareC: 'void (*functionID)()'>
"Spur needs the primitiveFunctionPointer to be set correctly
for accurate following of forwarders on primitive failure."
objectMemory hasSpurMemoryManagerAPI ifTrue:
[primitiveFunctionPointer := functionID].
+ self dispatchFunctionPointer: functionID!
- self dispatchFunctionPointer: functionID.
- self maybeFailForLastObjectOverwrite.!

Item was removed:
- ----- Method: StackInterpreter>>checkAllocFiller (in category 'primitive support') -----
- checkAllocFiller
- "If allocCheckFiller is true, words in newSpace from freeStart to scavengeThreshold
- are filled with their address, and after each call of a plugin primitive, the VM checks
- that freeStart points to a word containing the value of freeStart. This is a simple
- check for primitives overwriting the ends of an object."
- <cmacro: '() GIV(checkAllocFiller)'>
- ^checkAllocFiller!

Item was removed:
- ----- Method: StackInterpreter>>checkForLastObjectOverwrite (in category 'simulation') -----
- checkForLastObjectOverwrite
- <doNotGenerate>
- | freeStart |
- checkAllocFiller ifTrue:
- [self assert: ((freeStart := objectMemory freeStart) >= objectMemory scavengeThreshold
- or: [(objectMemory longAt: freeStart) = freeStart])]!

Item was changed:
----- Method: StackInterpreter>>initialize (in category 'initialization') -----
initialize
"Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated."
super initialize.
primitiveDoMixedArithmetic := true. "whether we authorize primitives to perform mixed arithmetic or not"
- checkAllocFiller := false. "must precede initializeObjectMemory:"
stackLimit := 0. "This is also the initialization flag for the stack system."
stackPage := overflowedPage := 0.
extraFramesToMoveOnOverflow := 0.
bytecodeSetSelector := 0.
highestRunnableProcessPriority := 0.
nextPollUsecs := 0.
nextWakeupUsecs := 0.
tempOop := tempOop2 := theUnknownShort := 0.
interruptPending := false.
inIOProcessEvents := 0.
fullScreenFlag := 0.
sendWheelEvents := deferDisplayUpdates := false.
displayBits := displayWidth := displayHeight := displayDepth := 0.
pendingFinalizationSignals := statPendingFinalizationSignals := 0.
globalSessionID := 0.
jmpDepth := 0.
longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
maxExtSemTabSizeSet := false.
debugCallbackInvokes := debugCallbackPath := debugCallbackReturns := 0.
statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
statProcessSwitch := statIOProcessEvents := statStackPageDivorce :=
statIdleUsecs := 0!

Item was removed:
- ----- Method: StackInterpreter>>maybeFailForLastObjectOverwrite (in category 'primitive support') -----
- maybeFailForLastObjectOverwrite
- <inline: true>
- checkAllocFiller ifTrue:
- [(objectMemory freeStart < objectMemory scavengeThreshold
- and: [(objectMemory longAt: objectMemory freeStart) ~= objectMemory freeStart]) ifTrue:
- [self primitiveFailFor: PrimErrWritePastObject]]!

Item was removed:
- ----- Method: StackInterpreter>>setCheckAllocFiller: (in category 'primitive support') -----
- setCheckAllocFiller: aBool
- "If allocCheckFiller is true, words in newSpace from freeStart to scavengeThreshold
- are filled with their address, and after each call of a plugin primitive, the VM checks
- that freeStart points to a word containing the value of freeStart. This is a simple
- check for primitives overwriting the ends of an object."
- checkAllocFiller := aBool!

Item was changed:
----- Method: StackInterpreter>>slowPrimitiveResponse (in category 'primitive support') -----
slowPrimitiveResponse
"Invoke a normal (non-quick) primitive.
Called under the assumption that primFunctionPointer has been preloaded."
| nArgs savedFramePointer savedStackPointer |
<inline: true>
<var: #savedFramePointer type: #'char *'>
<var: #savedStackPointer type: #'char *'>
self assert: (objectMemory isOopForwarded: (self stackValue: argumentCount)) not.
self assert: objectMemory remapBufferCount = 0.
FailImbalancedPrimitives ifTrue:
[nArgs := argumentCount.
savedStackPointer := stackPointer.
savedFramePointer := framePointer].
self initPrimCall.
self dispatchFunctionPointer: primitiveFunctionPointer.
self assert: (self maybeLeakCheckExternalPrimCall: newMethod).
self maybeRetryPrimitiveOnFailure.
- self maybeFailForLastObjectOverwrite.
(FailImbalancedPrimitives
and: [self successful
and: [framePointer = savedFramePointer
and: [(self isMachineCodeFrame: framePointer) not]]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:"
[stackPointer ~= (savedStackPointer + (nArgs * objectMemory wordSize)) ifTrue:
[self flag: 'Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context'.
"This is necessary but insufficient; the result may still have been written to the stack.
At least we'll know something is wrong."
self failUnbalancedPrimitive.
stackPointer := savedStackPointer]].
"If we are profiling, take accurate primitive measures"
nextProfileTick > 0 ifTrue:
[self checkProfileTick: newMethod].
^self successful!

Item was changed:
----- Method: TAssignmentNode>>emitValueExpansionOn:level:generator: (in category 'C code generation') -----
emitValueExpansionOn: aStream level: level generator: aCodeGen
+ | stmtList lastStmt copiedStatements |
- | stmtList lastStmt copy |
self assert: (expression isSend and: [expression isValueExpansion]).
stmtList := expression receiver.
lastStmt := stmtList statements last.
lastStmt = variable ifTrue:
[^expression emitCCodeOn: aStream level: level generator: aCodeGen].
+ copiedStatements := stmtList copy.
+ copiedStatements statements
- copy := stmtList copy.
- copy statements
at: stmtList statements size
put: (TAssignmentNode new
setVariable: variable
expression: lastStmt).
+ expression copy
+ receiver: copiedStatements;
+ emitCCodeOn: aStream level: level generator: aCodeGen!
- (TSendNode new
- setSelector: expression selector
- receiver: copy
- arguments: expression args)
- emitCCodeOn: aStream level: level generator: aCodeGen.!

Item was changed:
----- Method: VMClass>>strncpy:_:_: (in category 'C library simulation') -----
strncpy: dest _: src _: n
<doNotGenerate>
"implementation of strncpy(3).
See e.g. https://manpages.debian.org/stretch/manpages-dev/strncpy.3.en.html
The C version always takes an address; the simulation allows a String, ByteArray,
CArray or address within the simulation object memory (Positive Integer)"
| getBlock setBlock count |
count := n.
"Determine the source and destination access blocks based on the parameter type"
getBlock := src isCollection
ifTrue:
[count := count min: src size.
src isString
ifTrue: [[ :idx | src basicAt: idx]] "basicAt: answers integers"
ifFalse:
[src class == ByteArray ifTrue:
[[ :idx | src at: idx]]]]
ifFalse:
[src isInteger
ifTrue: [[ :idx | self byteAt: src + idx - 1]]
ifFalse:
[src isCArray ifTrue:
[[ :idx | src at: idx - 1]]]].
getBlock ifNil: [self error: 'unhandled type of source string'].
setBlock := dest isCollection
ifTrue:
[dest isString
ifTrue: [[ :idx | dest basicAt: idx put: (getBlock value: idx)]] "basicAt:put: stores integers"
ifFalse:
[dest class == ByteArray ifTrue:
[[ :idx | dest at: idx put: (getBlock value: idx)]]]]
ifFalse:
[dest isInteger ifTrue:
+ [[ :idx | self byteAt: dest + idx - 1 put: (getBlock value: idx)]]
+ ifFalse:
+ [dest isCArray ifTrue:
+ [[ :idx | dest at: idx - 1 put: (getBlock value: idx)]]]].
- [[ :idx | self byteAt: dest + idx - 1 put: (getBlock value: idx)]]].
setBlock ifNil: [self error: 'unhandled type of destination string'].
1 to: count do: setBlock.
"SVr4, 4.3BSD, C89, C99 require the remainder of the buffer be filled with nulls"
getBlock := [:idx| 0].
count + 1 to: n do: setBlock.
^dest!