Smalltalk › Squeak › Squeak VM

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

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

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

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

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

Name: VMMaker.oscog-eem.134
Author: eem
Time: 19 October 2011, 10:36:08.493 am
UUID: a0d46c48-3d9a-43f9-a769-51f31ce120e9
Ancestors: VMMaker.oscog-eem.133

Fix remaining bug in context access fixes of VMMaker.oscog-eem.119.
stObject:at: and stObject:at:put: need to use stackPointerForMaybeMarriedContext:
not fetchStackPointerOf:, since the context's stack pointer may be stale.

Fix send trace printing. Interpreter sends need also to be printed.
(A better fix is probably to redo sendBreakpoint: but this will serve for now).
N.B. this reassigns the sendtrace flag values.

Add primitiveNotEquivalent with prim # 169.

Merge with VMMaker-oscog-dtl.125/VMMaker-oscog-EstebanLorenzano.124
for the BytesPerWord generation fixes.

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

Item was changed:
----- Method: CCodeGenerator>>emitCConstantsOn: (in category 'C code generator') -----
emitCConstantsOn: aStream
"Store the global variable declarations on the given stream."
| unused constList |
unused := constants keys asSet.
methods do:
[:meth|
meth parseTree nodesDo:
[:n| n isConstant ifTrue: [unused remove: n name ifAbsent: []]]].
unused copy do:
[:const|
(variableDeclarations anySatisfy: [:value| value includesSubString: const]) ifTrue:
[unused remove: const ifAbsent: []]].
"Don't generate any defines for the externally defined constants, STACKVM, COGVM, COGMTVM et al."
(VMClass class>>#initializeMiscConstantsWith:) literalsDo:
[:lit|
lit isVariableBinding ifTrue:
[unused add: lit key]].
+ unused remove: #BytesPerWord ifAbsent: []. "force inclusion of BytesPerWord declaration"
constList := constants keys reject:[:any| unused includes: any].
aStream cr; nextPutAll: '/*** Constants ***/'; cr.
(self sortStrings: constList) do:
[:varName| | node default value |
node := constants at: varName.
node name isEmpty ifFalse:
["Allow the class to provide an alternative definition, either of just the value or the whole shebang"
default := self cLiteralFor: node value name: varName.
value := vmClass
ifNotNil:
[(vmClass specialValueForConstant: node name default: default)
ifNotNil: [:specialDef| specialDef]
ifNil: [default]]
ifNil: [default].
value first ~= $# ifTrue:
[aStream nextPutAll: '#define '; nextPutAll: node name; space].
aStream nextPutAll: value; cr]].
aStream cr!

Item was added:
+ ----- Method: CCodeGenerator>>generateBaseHeaderSize:on:indent: (in category 'C translation') -----
+ generateBaseHeaderSize: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ aStream nextPutAll: 'BaseHeaderSize'
+ !

Item was added:
+ ----- Method: CCodeGenerator>>generateBytesPerWord:on:indent: (in category 'C translation') -----
+ generateBytesPerWord: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ aStream nextPutAll: 'BytesPerWord'!

Item was changed:
----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
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:
#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 #generateBitInvert32:on:indent:
#bitClear: #generateBitClear: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:

#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:
#signedIntFromLong #generateSignedIntFromLong:on:indent:
#signedIntToLong #generateSignedIntToLong:on:indent:
#signedIntFromShort #generateSignedIntFromShort: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:
#asSymbol #generateAsSymbol:on:indent:
#anyMask: #generateBitAnd:on:indent:
#raisedTo: #generateRaisedTo:on:indent:
#touch: #generateTouch:on:indent:

+ #bytesPerWord #generateBytesPerWord:on:indent:
+ #baseHeaderSize #generateBaseHeaderSize: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:

#shouldNotImplement #generateSmalltalkMetaError:on:indent:
#shouldBeImplemented #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:
).

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:
----- Method: CoInterpreter>>ceTraceBlockActivation (in category 'debug support') -----
ceTraceBlockActivation
<api>
<var: #cogMethod type: #'CogMethod *'>
+ cogit recordBlockTrace ifTrue:
- cogit recordSendTrace ifTrue:
[self recordTrace: TraceBlockActivation
thing: (self mframeHomeMethod: framePointer) methodObject
+ source: TraceIsFromMachineCode.
+ cogit printOnTrace ifTrue:
+ [self printActivationNameFor: (self mframeHomeMethod: framePointer) methodObject
+ receiver: (self frameReceiver: framePointer)
+ isBlock: true
+ firstTemporary: nil.
+ self cr]]!
- source: TraceIsFromMachineCode].
- cogit printOnTrace ifTrue:
- [self printActivationNameFor: (self mframeHomeMethod: framePointer) methodObject
- receiver: (self frameReceiver: framePointer)
- isBlock: true
- firstTemporary: nil.
- self cr]!

Item was changed:
----- Method: CoInterpreter>>ceTraceLinkedSend: (in category 'debug support') -----
ceTraceLinkedSend: theReceiver
| cogMethod |
<api>
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: (self stackTop - cogit traceLinkedSendOffset)
to: #'CogMethod *'.
+ "cogit recordSendTrace ifTrue: is implicit; wouldn't compile the call otherwise."
+ self recordTrace: (objectMemory fetchClassOf: theReceiver)
+ thing: cogMethod selector
+ source: TraceIsFromMachineCode.
- cogit recordSendTrace ifTrue:
- [self recordTrace: (objectMemory fetchClassOf: theReceiver) thing: cogMethod selector source: TraceIsFromMachineCode].
cogit printOnTrace ifTrue:
[self printActivationNameFor: cogMethod methodObject
receiver: theReceiver
isBlock: false
firstTemporary: nil;
cr].
self sendBreak: cogMethod selector + BaseHeaderSize
point: (objectMemory lengthOf: cogMethod selector)
receiver: theReceiver!

Item was changed:
----- Method: CoInterpreter>>commonSend (in category 'message sending') -----
commonSend
"Send a message, starting lookup with the receiver's class."
"Assume: messageSelector and argumentCount have been set, and that
the receiver and arguments have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
<sharedCodeNamed: 'commonSend' inCase: 131>
self sendBreak: messageSelector + BaseHeaderSize
point: (objectMemory lengthOf: messageSelector)
receiver: (self internalStackValue: argumentCount).
cogit recordSendTrace ifTrue:
+ [self recordTrace: lkupClass thing: messageSelector source: TraceIsFromInterpreter.
+ cogit printOnTrace ifTrue:
+ [self printActivationNameForSelector: messageSelector startClass: lkupClass; cr]].
- [self recordTrace: lkupClass thing: messageSelector source: TraceIsFromInterpreter].
self internalFindNewMethod.
self internalExecuteNewMethod.
self fetchNextBytecode!

Item was added:
+ ----- Method: CoInterpreter>>printSends (in category 'debug printing') -----
+ printSends
+ <inline: true>
+ ^cogit printOnTrace!

Item was changed:
----- Method: CogVMSimulator>>sendBreak:point:receiver: (in category 'debugging traps') -----
sendBreak: selectorString point: selectorLength receiver: receiverOrNil
"self shortPrintFrameAndCallers: localFP"
| i |
- cogit printOnTrace ifTrue:
- [0 to: selectorLength - 1 do:
- [:si| transcript nextPut: (objectMemory byteAt: selectorString + si) asCharacter].
- transcript cr; flush].
breakSelectorLength = selectorLength ifTrue:
[i := breakSelectorLength.
[i > 0] whileTrue:
[(objectMemory byteAt: selectorString + i - 1) = (breakSelector at: i) asInteger
ifTrue: [(i := i - 1) = 0 ifTrue:
[self changed: #byteCountText.
self halt: 'Send of '
, breakSelector,
(receiverOrNil
ifNotNil: [' to ', (self shortPrint: receiverOrNil)]
ifNil: [''])]]
ifFalse: [i := 0]]]!

Item was changed:
----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
#( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass'
'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
[:simulationVariableNotNeededForRealVM|
aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
NewspeakVM ifFalse:
[#( 'dynSuperEntry' 'dynSuperEntryAlignment' 'dynamicSuperSendTrampolines'
'ceImplicitReceiverTrampoline' 'ceExplicitReceiverTrampoline' 'cmDynSuperEntryOffset') do:
[:variableNotNeededInNormalVM|
aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
aCCodeGenerator
addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
addHeaderFile:'"sqCogStackAlignment.h"';
addHeaderFile:'"cogmethod.h"';
addHeaderFile:'#if COGMTVM';
addHeaderFile:'"cointerpmt.h"';
addHeaderFile:'#else';
addHeaderFile:'"cointerp.h"';
addHeaderFile:'#endif';
addHeaderFile:'"cogit.h"';
addHeaderFile:'"dispdbg.h"'.
aCCodeGenerator
var: #ceGetSP
declareC: 'unsigned long (*ceGetSP)(void)';
var: #ceCaptureCStackPointers
declareC: 'void (*ceCaptureCStackPointers)(void)';
var: #ceEnterCogCodePopReceiverReg
declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
var: #realCEEnterCogCodePopReceiverReg
declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
var: #ceEnterCogCodePopReceiverAndClassRegs
declareC: 'void (*ceEnterCogCodePopReceiverAndClassRegs)(void)';
var: #realCEEnterCogCodePopReceiverAndClassRegs
declareC: 'void (*realCEEnterCogCodePopReceiverAndClassRegs)(void)';
var: #ceFlushICache
declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
var: #ceCheckFeaturesFunction
declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
var: #ceTryLockVMOwner
declareC: 'unsigned long (*ceTryLockVMOwner)(void)';
var: #ceUnlockVMOwner
declareC: 'void (*ceUnlockVMOwner)(void)';
var: #postCompileHook
declareC: 'void (*postCompileHook)(CogMethod *, void *)';
var: #openPICList declareC: 'CogMethod *openPICList = 0';
var: #maxMethodBefore type: #'CogBlockMethod *'.
aCCodeGenerator
declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
var: #backEnd declareC: 'AbstractInstruction *backEnd = &aMethodLabel';
var: #methodLabel declareC: 'AbstractInstruction *methodLabel = &aMethodLabel';
var: #primInvokeLabel type: #'AbstractInstruction *'.
self declareC: #(abstractOpcodes stackCheckLabel
blockEntryLabel blockEntryNoContextSwitch
stackOverflowCall sendMissCall entry noCheckEntry dynSuperEntry
mnuCall interpretCall endCPICCase0 endCPICCase1)
as: #'AbstractInstruction *'
in: aCCodeGenerator.
aCCodeGenerator
declareVar: #annotations type: #'InstructionAnnotation *';
declareVar: #blockStarts type: #'BlockStart *';
declareVar: #fixups type: #'BytecodeFixup *'.
aCCodeGenerator
var: #sendTrampolines
declareC: 'sqInt sendTrampolines[NumSendTrampolines]';
var: #superSendTrampolines
declareC: 'sqInt superSendTrampolines[NumSendTrampolines]';
var: #dynamicSuperSendTrampolines
declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
var: #trampolineAddresses
declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
var: #objectReferencesInRuntime
declareC: 'static sqInt objectReferencesInRuntime[NumObjRefsInRuntime]';
var: #cePositive32BitIntegerTrampoline
declareC: 'static sqInt cePositive32BitIntegerTrampoline';
var: #labelCounter
declareC: 'static int labelCounter';
var: #traceLinkedSends
+ declareC: 'int traceLinkedSends = 8 /* prim trace log on by default */';
- declareC: 'int traceLinkedSends = 2 /* prim trace log on by default */';
var: #cStackAlignment
declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
aCCodeGenerator
declareVar: #CFramePointer type: #'void *';
declareVar: #CStackPointer type: #'void *';
declareVar: #minValidCallAddress type: #'unsigned long';
declareVar: #debugPrimCallStackOffset type: #'unsigned long'.
aCCodeGenerator
var: #generatorTable
declareC: 'BytecodeDescriptor generatorTable[256]'
, (self tableInitializerFor: aCCodeGenerator vmClass generatorTable
in: aCCodeGenerator);
var: #primitiveGeneratorTable
declareC: 'PrimitiveDescriptor primitiveGeneratorTable[MaxCompiledPrimitiveIndex+1]'
, (self tableInitializerFor: aCCodeGenerator vmClass primitiveTable
in: aCCodeGenerator).
"In C the abstract opcode names clash with the Smalltak 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'!

Item was changed:
----- Method: Cogit>>breakOnImplicitReceiver (in category 'debugging') -----
breakOnImplicitReceiver
<api>
+ <cmacro: '() (traceLinkedSends & 32)'>
+ ^(traceLinkedSends bitAnd: 32) ~= 0!
- <cmacro: '() (traceLinkedSends & 16)'>
- ^(traceLinkedSends bitAnd: 16) ~= 0!

Item was changed:
----- Method: Cogit>>compileBlockEntry: (in category 'compile abstract instructions') -----
compileBlockEntry: blockStart
"Compile a block's entry. This looks like a dummy CogBlockMethod header (for frame parsing)
followed by either a frame build, if a frame is required, or nothing. The CogMethodHeader's
objectHeader field is a back pointer to the method, but this can't be filled in until code generation."
<var: #blockStart type: #'BlockStart *'>
self AlignmentNops: (self sizeof: CogBlockMethod).
self assert: (self sizeof: CogBlockMethod) = (2 * BytesPerWord).
blockStart fakeHeader: self Label.
self Fill32: 0. "gets filled in later with the homeOffset and startpc"
self Fill32: 0. "gets filled in later with numArgs et al"
blockStart entryLabel: self Label.
needsFrame
ifTrue:
[self compileBlockFrameBuild: blockStart.
+ self recordBlockTrace ifTrue:
- self recordSendTrace ifTrue:
[self CallRT: ceTraceBlockActivationTrampoline]]
ifFalse:
[self compileBlockFramelessEntry: blockStart]!

Item was changed:
----- Method: Cogit>>printOnTrace (in category 'debugging') -----
printOnTrace
<api>
+ <cmacro: '() (traceLinkedSends & 1)'>
+ ^(traceLinkedSends bitAnd: 1) ~= 0!
- <cmacro: '() (traceLinkedSends & 8)'>
- ^(traceLinkedSends bitAnd: 8) ~= 0!

Item was added:
+ ----- Method: Cogit>>recordBlockTrace (in category 'debugging') -----
+ recordBlockTrace
+ <api>
+ <cmacro: '() (traceLinkedSends & 4)'>
+ ^(traceLinkedSends bitAnd: 4) ~= 0!

Item was changed:
----- Method: Cogit>>recordEventTrace (in category 'debugging') -----
recordEventTrace
<api>
+ <cmacro: '() (traceLinkedSends & 16)'>
+ ^(traceLinkedSends bitAnd: 16) ~= 0!
- <cmacro: '() (traceLinkedSends & 4)'>
- ^(traceLinkedSends bitAnd: 4) ~= 0!

Item was changed:
----- Method: Cogit>>recordPrimTrace (in category 'debugging') -----
recordPrimTrace
<api>
+ <cmacro: '() (traceLinkedSends & 8)'>
+ ^(traceLinkedSends bitAnd: 8) ~= 0!
- <cmacro: '() (traceLinkedSends & 2)'>
- ^(traceLinkedSends bitAnd: 2) ~= 0!

Item was changed:
----- Method: Cogit>>recordSendTrace (in category 'debugging') -----
recordSendTrace
<api>
+ <cmacro: '() (traceLinkedSends & 2)'>
+ ^(traceLinkedSends bitAnd: 2) ~= 0!
- <cmacro: '() (traceLinkedSends & 1)'>
- ^(traceLinkedSends bitAnd: 1) ~= 0!

Item was changed:
----- Method: Cogit>>sendTrace: (in category 'debugging') -----
sendTrace: aBooleanOrInteger
<doNotGenerate>
"traceLinkedSends is a set of flags.
+ 1 => print trace (if somethign below is selected)
+ 2 => trace sends
+ 4 => trace block activations
+ 8 => trace interpreter primitives
+ 16 => trace events (context switches, GCs, etc)
+ 32 => send breakpoint on implicit receiver (Newspeak VM only)"
- 1 => trace sends & block activations
- 2 => trace interpreter primitives
- 4 => trace events (context switches, GCs, etc)
- 8 => print trace"
traceLinkedSends := aBooleanOrInteger isInteger
ifTrue: [aBooleanOrInteger]
ifFalse: [aBooleanOrInteger ifTrue: [1] ifFalse: [0]]!

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"
objectRepresentation := objectMemory objectRepresentationClass for: self.
methodZone := CogMethodZone new.
methodZone setInterpreter: aCoInterpreter
objectRepresentation: objectRepresentation
cogit: self.
generatorTable := self class generatorTable.
primitiveGeneratorTable := self class primitiveTable.
processor := ProcessorClass new.
simulatedAddresses := Dictionary new.
simulatedTrampolines := Dictionary new.
simulatedVariableGetters := Dictionary new.
simulatedVariableSetters := Dictionary new.
traceStores := 0.
+ traceLinkedSends := 8. "record prim trace on by default (see Cogit class>>decareCVarsIn:)"
- traceLinkedSends := 2. "record prim trace on by default (see Cogit class>>decareCVarsIn:)"
debugPrimCallStackOffset := 0.
singleStep := printRegisters := printInstructions := clickConfirm := false.
breakBlock ifNil: [self breakPC: breakPC].
(backEnd := processor abstractInstructionCompilerClass new) cogit: self.
(methodLabel := processor abstractInstructionCompilerClass new) cogit: self.
sendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
superSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
NewspeakVM ifTrue:
[dynamicSuperSendTrampolines := 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.

compilationTrace ifNil: [compilationTrace := 0]!

Item was changed:
----- Method: Interpreter class>>initializePrimitiveTable (in category 'initialization') -----
initializePrimitiveTable
"This table generates a C function address table use in primitiveResponse along with dispatchFunctionPointerOn:in:"

"NOTE: The real limit here is 2047 because of the method header layout but there is no point in going over the needed size"
MaxPrimitiveIndex := 575.
PrimitiveTable := Array new: MaxPrimitiveIndex + 1.
self table: PrimitiveTable from:
#( "Integer Primitives (0-19)"
(0 primitiveFail)
(1 primitiveAdd)
(2 primitiveSubtract)
(3 primitiveLessThan)
(4 primitiveGreaterThan)
(5 primitiveLessOrEqual)
(6 primitiveGreaterOrEqual)
(7 primitiveEqual)
(8 primitiveNotEqual)
(9 primitiveMultiply)
(10 primitiveDivide)
(11 primitiveMod)
(12 primitiveDiv)
(13 primitiveQuo)
(14 primitiveBitAnd)
(15 primitiveBitOr)
(16 primitiveBitXor)
(17 primitiveBitShift)
(18 primitiveMakePoint)
(19 primitiveFail) "Guard primitive for simulation -- *must* fail"

"LargeInteger Primitives (20-39)"
(20 primitiveFail)
(21 primitiveAddLargeIntegers)
(22 primitiveSubtractLargeIntegers)
(23 primitiveLessThanLargeIntegers)
(24 primitiveGreaterThanLargeIntegers)
(25 primitiveLessOrEqualLargeIntegers)
(26 primitiveGreaterOrEqualLargeIntegers)
(27 primitiveEqualLargeIntegers)
(28 primitiveNotEqualLargeIntegers)
(29 primitiveMultiplyLargeIntegers)
(30 primitiveDivideLargeIntegers)
(31 primitiveModLargeIntegers)
(32 primitiveDivLargeIntegers)
(33 primitiveQuoLargeIntegers)
(34 primitiveBitAndLargeIntegers)
(35 primitiveBitOrLargeIntegers)
(36 primitiveBitXorLargeIntegers)
(37 primitiveBitShiftLargeIntegers)
(38 primitiveFail)
(39 primitiveFail)

"Float Primitives (40-59)"
(40 primitiveAsFloat)
(41 primitiveFloatAdd)
(42 primitiveFloatSubtract)
(43 primitiveFloatLessThan)
(44 primitiveFloatGreaterThan)
(45 primitiveFloatLessOrEqual)
(46 primitiveFloatGreaterOrEqual)
(47 primitiveFloatEqual)
(48 primitiveFloatNotEqual)
(49 primitiveFloatMultiply)
(50 primitiveFloatDivide)
(51 primitiveTruncated)
(52 primitiveFractionalPart)
(53 primitiveExponent)
(54 primitiveTimesTwoPower)
(55 primitiveSquareRoot)
(56 primitiveSine)
(57 primitiveArctan)
(58 primitiveLogN)
(59 primitiveExp)

"Subscript and Stream Primitives (60-67)"
(60 primitiveAt)
(61 primitiveAtPut)
(62 primitiveSize)
(63 primitiveStringAt)
(64 primitiveStringAtPut)
(65 primitiveFail) "was primitiveNext which no longer pays its way (normal Smalltalk code is faster)"
(66 primitiveFail) "was primitiveNextPut which no longer pays its way (normal Smalltalk code is faster)"
(67 primitiveFail) "was primitiveAtEnd which no longer pays its way (normal Smalltalk code is faster)"

"StorageManagement Primitives (68-79)"
(68 primitiveObjectAt)
(69 primitiveObjectAtPut)
(70 primitiveNew)
(71 primitiveNewWithArg)
(72 primitiveArrayBecomeOneWay) "Blue Book: primitiveBecome"
(73 primitiveInstVarAt)
(74 primitiveInstVarAtPut)
(75 primitiveAsOop)
(76 primitiveStoreStackp) "Blue Book: primitiveAsObject"
(77 primitiveSomeInstance)
(78 primitiveNextInstance)
(79 primitiveNewMethod)

"Control Primitives (80-89)"
(80 primitiveBlockCopy)
(81 primitiveValue)
(82 primitiveValueWithArgs)
(83 primitivePerform)
(84 primitivePerformWithArgs)
(85 primitiveSignal)
(86 primitiveWait)
(87 primitiveResume)
(88 primitiveSuspend)
(89 primitiveFlushCache)

"Input/Output Primitives (90-109)"
(90 primitiveMousePoint)
(91 primitiveTestDisplayDepth) "Blue Book: primitiveCursorLocPut"
(92 primitiveSetDisplayMode) "Blue Book: primitiveCursorLink"
(93 primitiveInputSemaphore)
(94 primitiveGetNextEvent) "Blue Book: primitiveSampleInterval"
(95 primitiveInputWord)
(96 primitiveFail) "primitiveCopyBits"
(97 primitiveSnapshot)
(98 primitiveStoreImageSegment)
(99 primitiveLoadImageSegment)
(100 primitivePerformInSuperclass) "Blue Book: primitiveSignalAtTick"
(101 primitiveBeCursor)
(102 primitiveBeDisplay)
(103 primitiveScanCharacters)
(104 primitiveFail) "primitiveDrawLoop"
(105 primitiveStringReplace)
(106 primitiveScreenSize)
(107 primitiveMouseButtons)
(108 primitiveKbdNext)
(109 primitiveKbdPeek)

"System Primitives (110-119)"
(110 primitiveEquivalent)
(111 primitiveClass)
(112 primitiveBytesLeft)
(113 primitiveQuit)
(114 primitiveExitToDebugger)
(115 primitiveChangeClass) "Blue Book: primitiveOopsLeft"
(116 primitiveFlushCacheByMethod)
(117 primitiveExternalCall)
(118 primitiveDoPrimitiveWithArgs)
(119 primitiveFlushCacheSelective)
"Squeak 2.2 and earlier use 119. Squeak 2.3 and later use 116.
Both are supported for backward compatibility."

"Miscellaneous Primitives (120-127)"
(120 primitiveCalloutToFFI)
(121 primitiveImageName)
(122 primitiveNoop) "Blue Book: primitiveImageVolume"
(123 primitiveValueUninterruptably) "@@@: Remove this when all VMs have support"
(124 primitiveLowSpaceSemaphore)
(125 primitiveSignalAtBytesLeft)

"Squeak Primitives Start Here"

"Squeak Miscellaneous Primitives (128-149)"
(126 primitiveDeferDisplayUpdates)
(127 primitiveShowDisplayRect)
(128 primitiveArrayBecome)
(129 primitiveSpecialObjectsOop)
(130 primitiveFullGC)
(131 primitiveIncrementalGC)
(132 primitiveObjectPointsTo)
(133 primitiveSetInterruptKey)
(134 primitiveInterruptSemaphore)
(135 primitiveMillisecondClock)
(136 primitiveSignalAtMilliseconds)
(137 primitiveSecondsClock)
(138 primitiveSomeObject)
(139 primitiveNextObject)
(140 primitiveBeep)
(141 primitiveClipboardText)
(142 primitiveVMPath)
(143 primitiveShortAt)
(144 primitiveShortAtPut)
(145 primitiveConstantFill)
"NOTE: When removing the obsolete indexed primitives,
the following two should go become #primitiveIntegerAt / atPut"
(146 primitiveFail) "primitiveReadJoystick"
(147 primitiveFail) "primitiveWarpBits"
(148 primitiveClone)
(149 primitiveGetAttribute)

"File Primitives (150-169) - NO LONGER INDEXED"
(150 159 primitiveFail)
(160 primitiveAdoptInstance)
(161 164 primitiveFail)
(165 primitiveIntegerAt) "hacked in here for now"
(166 primitiveIntegerAtPut)
(167 primitiveYield)
(168 primitiveCopyObject)
+ (169 primitiveNotIdentical)
- (169 primitiveFail)

"Sound Primitives (170-199) - NO LONGER INDEXED"
(170 185 primitiveFail)

"Old closure primitives"
(186 primitiveFail) "was primitiveClosureValue"
(187 primitiveFail) "was primitiveClosureValueWithArgs"

"Perform method directly"
(188 primitiveExecuteMethodArgsArray)
(189 primitiveExecuteMethod)

"Sound Primitives (continued) - NO LONGER INDEXED"
(190 194 primitiveFail)

"Unwind primitives"
(195 primitiveFindNextUnwindContext)
(196 primitiveTerminateTo)
(197 primitiveFindHandlerContext)
(198 primitiveMarkUnwindMethod)
(199 primitiveMarkHandlerMethod)

"new closure primitives (were Networking primitives)"
(200 primitiveClosureCopyWithCopiedValues)
(201 primitiveClosureValue) "value"
(202 primitiveClosureValue) "value:"
(203 primitiveClosureValue) "value:value:"
(204 primitiveClosureValue) "value:value:value:"
(205 primitiveClosureValue) "value:value:value:value:"
(206 primitiveClosureValueWithArgs) "valueWithArguments:"

(207 209 primitiveFail) "reserved for Cog primitives"

(210 primitiveAt) "Compatibility with Cog StackInterpreter Context primitives"
(211 primitiveAtPut) "Compatibility with Cog StackInterpreter Context primitives"
(212 primitiveSize) "Compatibility with Cog StackInterpreter Context primitives"
(213 219 primitiveFail) "reserved for Cog primitives"

(220 primitiveFail) "reserved for Cog primitives"

(221 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch"
(222 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch:"

(223 229 primitiveFail) "reserved for Cog primitives"

(230 primitiveRelinquishProcessor)
(231 primitiveForceDisplayUpdate)
(232 primitiveFormPrint)
(233 primitiveSetFullScreen)
(234 primitiveFail) "primBitmapdecompressfromByteArrayat"
(235 primitiveFail) "primStringcomparewithcollated"
(236 primitiveFail) "primSampledSoundconvert8bitSignedFromto16Bit"
(237 primitiveFail) "primBitmapcompresstoByteArray"
(238 241 primitiveFail) "serial port primitives"
(242 primitiveFail)
(243 primitiveFail) "primStringtranslatefromtotable"
(244 primitiveFail) "primStringfindFirstInStringinSetstartingAt"
(245 primitiveFail) "primStringindexOfAsciiinStringstartingAt"
(246 primitiveFail) "primStringfindSubstringinstartingAtmatchTable"
(247 primitiveSnapshotEmbedded)
(248 primitiveInvokeObjectAsMethod)
(249 primitiveArrayBecomeOneWayCopyHash)

"VM Implementor Primitives (250-255)"
(250 primitiveClearVMProfile)
(251 primitiveControlVMProfiling "primitiveStartVMProfiling")
(252 primitiveVMProfileSamplesInto "primitiveStopVMProfiling")
(253 primitiveFail "primitiveVMProfileInfoInto")
(254 primitiveVMParameter)
(255 primitiveInstVarsPutFromStack) "Never used except in Disney tests. Remove after 2.3 release."

"Quick Push Const Methods"
(256 primitivePushSelf)
(257 primitivePushTrue)
(258 primitivePushFalse)
(259 primitivePushNil)
(260 primitivePushMinusOne)
(261 primitivePushZero)
(262 primitivePushOne)
(263 primitivePushTwo)

"Quick Push Const Methods"
(264 519 primitiveLoadInstVar)

"These ranges used to be used by obsiolete indexed primitives."
(520 529 primitiveFail)
(530 539 primitiveFail)
(540 549 primitiveFail)
(550 559 primitiveFail)
(560 569 primitiveFail)

"External primitive support primitives"
(570 primitiveFlushExternalPrimitives)
(571 primitiveUnloadModule)
(572 primitiveListBuiltinModule)
(573 primitiveListExternalModule)
(574 primitiveFail) "reserved for addl. external support prims"

"Unassigned Primitives"
(575 primitiveFail)).
!

Item was added:
+ ----- Method: Interpreter>>primitiveNotIdentical (in category 'object access primitives') -----
+ primitiveNotIdentical
+ "is the receiver/first argument not the same object as the (last) argument?.
+ pop argumentCount because this can be used as a mirror primitive."
+ | thisObject otherObject |
+ otherObject := self stackValue: 1.
+ thisObject := self stackTop.
+ self pop: argumentCount + 1 thenPushBool: thisObject ~= otherObject!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveNotIdentical (in category 'object access primitives') -----
+ primitiveNotIdentical
+ "is the receiver/first argument not the same object as the (last) argument?.
+ pop argumentCount because this can be used as a mirror primitive."
+ | thisObject otherObject |
+ otherObject := self stackValue: 1.
+ thisObject := self stackTop.
+ self pop: argumentCount + 1 thenPushBool: thisObject ~= otherObject!

Item was changed:
+ ----- Method: InterpreterSimulatorLSB64>>bytesPerWord (in category 'memory access') -----
- ----- Method: InterpreterSimulatorLSB64>>bytesPerWord (in category 'as yet unclassified') -----
bytesPerWord
"overridden for 64-bit images..."

^ 8!

Item was changed:
+ ----- Method: InterpreterSimulatorLSB64>>long32At: (in category 'memory access') -----
- ----- Method: InterpreterSimulatorLSB64>>long32At: (in category 'as yet unclassified') -----
long32At: byteAddress

"Return the 32-bit word at byteAddress which must be 0 mod 4."
| lowBits long |
lowBits := byteAddress bitAnd: 4.
long := self longAt: byteAddress - lowBits.
^ lowBits = 4
ifTrue: [ long bitShift: -32 ]
ifFalse: [ long bitAnd: 16rFFFFFFFF ].
!

Item was changed:
+ ----- Method: InterpreterSimulatorLSB64>>long32At:put: (in category 'memory access') -----
- ----- Method: InterpreterSimulatorLSB64>>long32At:put: (in category 'as yet unclassified') -----
long32At: byteAddress put: a32BitValue
"Store the 32-bit value at byteAddress which must be 0 mod 4."
| lowBits long64 longAddress |
lowBits := byteAddress bitAnd: 4.
lowBits = 0
ifTrue:
[ "storing into LS word"
long64 := self longAt: byteAddress.
self longAt: byteAddress
put: ((long64 bitAnd: 16rFFFFFFFF00000000) bitOr: a32BitValue)
]
ifFalse:
[longAddress := byteAddress - 4.
long64 := self longAt: longAddress.
self longAt: longAddress
put: ((long64 bitAnd: 16rFFFFFFFF) bitOr: (a32BitValue bitShift: 32))
]!

Item was changed:
+ ----- Method: InterpreterSimulatorMSB64>>byteSwapped: (in category 'memory access') -----
- ----- Method: InterpreterSimulatorMSB64>>byteSwapped: (in category 'as yet unclassified') -----
byteSwapped: w
"Return the given integer with its bytes in the reverse order."

^ (super byteSwapped: ((w bitShift: -32) bitAnd: 16rFFFFFFFF)) +
((super byteSwapped: (w bitAnd: 16rFFFFFFFF)) bitShift: 32)!

Item was changed:
+ ----- Method: InterpreterSimulatorMSB64>>bytesPerWord (in category 'memory access') -----
- ----- Method: InterpreterSimulatorMSB64>>bytesPerWord (in category 'as yet unclassified') -----
bytesPerWord
"overridden for 64-bit images..."

^ 8!

Item was changed:
+ ----- Method: InterpreterSimulatorMSB64>>long32At: (in category 'memory access') -----
- ----- Method: InterpreterSimulatorMSB64>>long32At: (in category 'as yet unclassified') -----
long32At: byteAddress
"Return the 32-bit word at byteAddress which must be 0 mod 4."

^ super longAt: byteAddress!

Item was changed:
+ ----- Method: InterpreterSimulatorMSB64>>long32At:put: (in category 'memory access') -----
- ----- Method: InterpreterSimulatorMSB64>>long32At:put: (in category 'as yet unclassified') -----
long32At: byteAddress put: a32BitValue
"Store the 32-bit value at byteAddress which must be 0 mod 4."

super longAt: byteAddress put: a32BitValue!

Item was changed:
+ ----- Method: InterpreterSimulatorMSB64>>longAt: (in category 'memory access') -----
- ----- Method: InterpreterSimulatorMSB64>>longAt: (in category 'as yet unclassified') -----
longAt: byteAddress
"Note: Adjusted for Smalltalk's 1-based array indexing."

^ ((super longAt: byteAddress) bitShift: 32) bitOr: (super longAt: byteAddress + 4)!

Item was changed:
+ ----- Method: InterpreterSimulatorMSB64>>longAt:put: (in category 'memory access') -----
- ----- Method: InterpreterSimulatorMSB64>>longAt:put: (in category 'as yet unclassified') -----
longAt: byteAddress put: a64BitValue
"Note: Adjusted for Smalltalk's 1-based array indexing."

super longAt: byteAddress put: (a64BitValue bitShift: -32).
super longAt: byteAddress + 4 put: (a64BitValue bitAnd: 16rFFFFFFFF).
^ a64BitValue!

Item was removed:
- ----- Method: NewCoObjectMemory>>clone: (in category 'allocation') -----
- clone: obj
- "Return a shallow copy of the given object. May cause GC"
- "Assume: Oop is a real object, not a small integer.
- Override to assert it's not a cogged method"
- self assert: ((self isOopCompiledMethod: obj) not
- or: [(coInterpreter methodHasCogMethod: obj) not]).
- ^super clone: obj!

Item was changed:
----- Method: NewspeakInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
initializePrimitiveTable
"This table generates a C function address table use in primitiveResponse along with dispatchFunctionPointerOn:in:"

"NOTE: The real limit here is 2047 because of the method header layout but there is no point in going over the needed size"
MaxPrimitiveIndex := 575.
MaxQuickPrimitiveIndex := 519.
PrimitiveTable := Array new: MaxPrimitiveIndex + 1.
self table: PrimitiveTable from:
#( "Integer Primitives (0-19)"
(0 primitiveFail)
(1 primitiveAdd)
(2 primitiveSubtract)
(3 primitiveLessThan)
(4 primitiveGreaterThan)
(5 primitiveLessOrEqual)
(6 primitiveGreaterOrEqual)
(7 primitiveEqual)
(8 primitiveNotEqual)
(9 primitiveMultiply)
(10 primitiveDivide)
(11 primitiveMod)
(12 primitiveDiv)
(13 primitiveQuo)
(14 primitiveBitAnd)
(15 primitiveBitOr)
(16 primitiveBitXor)
(17 primitiveBitShift)
(18 primitiveMakePoint)
(19 primitiveFail) "Guard primitive for simulation -- *must* fail"

"LargeInteger Primitives (20-39)"
"32-bit logic is aliased to Integer prims above"
(20 37 primitiveFail)

"Float Primitives (38-59)"
(38 primitiveAt) "for compatibility with Cog's primitiveFloatAt"
(39 primitiveAtPut) "for compatibility with Cog's primitiveFloatAtPut"
(40 primitiveAsFloat)
(41 primitiveFloatAdd)
(42 primitiveFloatSubtract)
(43 primitiveFloatLessThan)
(44 primitiveFloatGreaterThan)
(45 primitiveFloatLessOrEqual)
(46 primitiveFloatGreaterOrEqual)
(47 primitiveFloatEqual)
(48 primitiveFloatNotEqual)
(49 primitiveFloatMultiply)
(50 primitiveFloatDivide)
(51 primitiveTruncated)
(52 primitiveFractionalPart)
(53 primitiveExponent)
(54 primitiveTimesTwoPower)
(55 primitiveSquareRoot)
(56 primitiveSine)
(57 primitiveArctan)
(58 primitiveLogN)
(59 primitiveExp)

"Subscript and Stream Primitives (60-67)"
(60 primitiveAt)
(61 primitiveAtPut)
(62 primitiveSize)
(63 primitiveStringAt)
(64 primitiveStringAtPut)
(65 primitiveNext)
(66 primitiveNextPut)
(67 primitiveAtEnd)

"StorageManagement Primitives (68-79)"
(68 primitiveObjectAt)
(69 primitiveObjectAtPut)
(70 primitiveNew)
(71 primitiveNewWithArg)
(72 primitiveArrayBecomeOneWay) "Blue Book: primitiveBecome"
(73 primitiveInstVarAt)
(74 primitiveInstVarAtPut)
(75 primitiveAsOop)
(76 primitiveStoreStackp) "Blue Book: primitiveAsObject"
(77 primitiveSomeInstance)
(78 primitiveNextInstance)
(79 primitiveNewMethod)

"Control Primitives (80-89)"
(80 primitiveBlockCopy)
(81 primitiveValue)
(82 primitiveValueWithArgs)
(83 primitivePerform)
(84 primitivePerformWithArgs)
(85 primitiveSignal)
(86 primitiveWait)
(87 primitiveResume)
(88 primitiveSuspend)
(89 primitiveFlushCache)

"Input/Output Primitives (90-109)"
(90 primitiveMousePoint)
(91 primitiveTestDisplayDepth) "Blue Book: primitiveCursorLocPut"
(92 primitiveSetDisplayMode) "Blue Book: primitiveCursorLink"
(93 primitiveInputSemaphore)
(94 primitiveGetNextEvent) "Blue Book: primitiveSampleInterval"
(95 primitiveInputWord)
(96 primitiveFail) "was primitiveObsoleteIndexedPrimitive; was primitiveCopyBits"
(97 primitiveSnapshot)
(98 primitiveStoreImageSegment)
(99 primitiveLoadImageSegment)
(100 primitivePerformInSuperclass) "Blue Book: primitiveSignalAtTick"
(101 primitiveBeCursor)
(102 primitiveBeDisplay)
(103 primitiveScanCharacters)
(104 primitiveFail) "was primitiveObsoleteIndexedPrimitive; was primitiveDrawLoop"
(105 primitiveStringReplace)
(106 primitiveScreenSize)
(107 primitiveMouseButtons)
(108 primitiveKbdNext)
(109 primitiveKbdPeek)

"System Primitives (110-119)"
(110 primitiveEquivalent)
(111 primitiveClass)
(112 primitiveBytesLeft)
(113 primitiveQuit)
(114 primitiveExitToDebugger)
(115 primitiveChangeClass) "Blue Book: primitiveOopsLeft"
(116 primitiveFlushCacheByMethod)
(117 primitiveExternalCall)
(118 primitiveDoPrimitiveWithArgs)
(119 primitiveFlushCacheBySelector)
"Squeak 2.2 and earlier use 119. Squeak 2.3 and later use 116.
Both are supported for backward compatibility."

"Miscellaneous Primitives (120-127)"
(120 primitiveCalloutToFFI)
(121 primitiveImageName)
(122 primitiveNoop) "Blue Book: primitiveImageVolume"
(123 primitiveFail) "was primitiveValueUninterruptably"
(124 primitiveLowSpaceSemaphore)
(125 primitiveSignalAtBytesLeft)

"Squeak Primitives Start Here"

"Squeak Miscellaneous Primitives (128-149)"
(126 primitiveDeferDisplayUpdates)
(127 primitiveShowDisplayRect)
(128 primitiveArrayBecome)
(129 primitiveSpecialObjectsOop)
(130 primitiveFullGC)
(131 primitiveIncrementalGC)
(132 primitiveObjectPointsTo)
(133 primitiveSetInterruptKey)
(134 primitiveInterruptSemaphore)
(135 primitiveMillisecondClock)
(136 primitiveSignalAtMilliseconds)
(137 primitiveSecondsClock)
(138 primitiveSomeObject)
(139 primitiveNextObject)
(140 primitiveBeep)
(141 primitiveClipboardText)
(142 primitiveVMPath)
(143 primitiveShortAt)
(144 primitiveShortAtPut)
(145 primitiveConstantFill)
"NOTE: When removing the obsolete indexed primitives,
the following two should go become #primitiveIntegerAt / atPut"
(146 primitiveFail) "primitiveReadJoystick"
(147 primitiveFail) "primitiveWarpBits"
(148 primitiveClone)
(149 primitiveGetAttribute)

"File Primitives (150-169) - NO LONGER INDEXED"
(150 159 primitiveFail)
(160 primitiveAdoptInstance)
(161 primitiveArrayBecomeOneWayForceImmutables)
(162 primitiveArrayBecomeForceImmutables)
(163 primitiveGetImmutability)
(164 primitiveSetImmutability)
(165 primitiveIntegerAt) "hacked in here for now"
(166 primitiveIntegerAtPut)
(167 primitiveYield)
(168 primitiveCopyObject)
+ (169 primitiveNotIdentical)
- (169 primitiveFail)

"Sound Primitives (170-199) - NO LONGER INDEXED"
(170 185 primitiveFail)

"Old closure primitives"
(186 primitiveFail) "was primitiveClosureValue"
(187 primitiveFail) "was primitiveClosureValueWithArgs"

"Perform method directly"
(188 primitiveExecuteMethodArgsArray)
(189 primitiveExecuteMethod)

"Sound Primitives (continued) - NO LONGER INDEXED"
(190 194 primitiveFail)

"Unwind primitives"
(195 primitiveFindNextUnwindContext)
(196 primitiveTerminateTo)
(197 primitiveFindHandlerContext)
(198 primitiveMarkUnwindMethod)
(199 primitiveMarkHandlerMethod)

"new closure primitives (were Networking primitives)"
(200 primitiveClosureCopyWithCopiedValues)
(201 primitiveClosureValue) "value"
(202 primitiveClosureValue) "value:"
(203 primitiveClosureValue) "value:value:"
(204 primitiveClosureValue) "value:value:value:"
(205 primitiveClosureValue) "value:value:value:value:"
(206 primitiveClosureValueWithArgs) "valueWithArguments:"

(207 209 primitiveFail) "reserved for Cog primitives"

(210 primitiveAt) "Compatibility with Cog StackInterpreter Context primitives"
(211 primitiveAtPut) "Compatibility with Cog StackInterpreter Context primitives"
(212 primitiveSize) "Compatibility with Cog StackInterpreter Context primitives"
(213 219 primitiveFail) "reserved for Cog primitives"

(220 primitiveFail) "reserved for Cog primitives"

(221 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch"
(222 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch:"

(223 225 primitiveFail) "reserved for Cog primitives"

"Newsqueak debug primitives"
(226 primitiveHeaderWords)

"Used to encode protected access"
(227 primitiveFail)

"Other Primitives (228-249)"
(228 primitiveFail)
(229 primitiveFail)
(230 primitiveRelinquishProcessor)
(231 primitiveForceDisplayUpdate)
(232 primitiveFormPrint)
(233 primitiveSetFullScreen)
(234 primitiveFail) "primBitmapdecompressfromByteArrayat"
(235 primitiveFail) "primStringcomparewithcollated"
(236 primitiveFail) "primSampledSoundconvert8bitSignedFromto16Bit"
(237 primitiveFail) "primBitmapcompresstoByteArray"
(238 241 primitiveFail) "serial port primitives"
(242 primitiveFail)
(243 primitiveFail) "primStringtranslatefromtotable"
(244 primitiveFail) "primStringfindFirstInStringinSetstartingAt"
(245 primitiveFail) "primStringindexOfAsciiinStringstartingAt"
(246 primitiveFail) "primStringfindSubstringinstartingAtmatchTable"
(247 primitiveSnapshotEmbedded)
(248 primitiveInvokeObjectAsMethod)
(249 primitiveArrayBecomeOneWayCopyHash)

"VM Implementor Primitives (250-255)"
(250 primitiveClearVMProfile)
(251 primitiveControlVMProfiling "primitiveStartVMProfiling")
(252 primitiveVMProfileSamplesInto "primitiveStopVMProfiling")
(253 primitiveFail "N.B. primitiveCollectCogCodeConstituents in CoInterpreter below")
(254 primitiveVMParameter)
(255 primitiveFail)

"Quick Push Const Methods"
(256 nil) "primitivePushSelf"
(257 nil) "primitivePushTrue"
(258 nil) "primitivePushFalse"
(259 nil) "primitivePushNil"
(260 nil) "primitivePushMinusOne"
(261 nil) "primitivePushZero"
(262 nil) "primitivePushOne"
(263 nil) "primitivePushTwo"

"Quick Push Const Methods"
(264 519 nil) "primitiveLoadInstVar"

(520 primitiveFail)
"MIDI Primitives (521-539) - NO LONGER INDEXED"
(521 529 primitiveFail)
(530 539 primitiveFail) "reserved for extended MIDI primitives"

"Experimental Asynchrous File Primitives - NO LONGER INDEXED"
(540 545 primitiveFail)

"Used to encode private access"
(546 primitiveFail)

(547 primitiveFail)

"Pen Tablet Primitives - NO LONGER INDEXED"
(548 549 primitiveFail)

"Sound Codec Primitives - NO LONGER INDEXED"
(550 569 primitiveFail)

"External primitive support primitives"
(570 primitiveFlushExternalPrimitives)
(571 primitiveUnloadModule)
(572 primitiveListBuiltinModule)
(573 primitiveListExternalModule)
(574 primitiveFail) "reserved for addl. external support prims"

"Unassigned Primitives"
(575 primitiveFail)).
!

Item was added:
+ ----- Method: NewspeakInterpreter>>primitiveNotIdentical (in category 'object access primitives') -----
+ primitiveNotIdentical
+ "is the receiver/first argument not the same object as the (last) argument?.
+ pop argumentCount because this can be used as a mirror primitive."
+ | thisObject otherObject |
+ otherObject := self stackValue: 1.
+ thisObject := self stackTop.
+ self pop: argumentCount + 1 thenPushBool: thisObject ~= otherObject!

Item was changed:
----- Method: SimpleStackBasedCogit class>>initializePrimitiveTableForSqueakV3 (in category 'class initialization') -----
initializePrimitiveTableForSqueakV3
"Initialize the table of primitive generators. This does not include normal primitives implemened in the coInterpreter."
"SimpleStackBasedCogit initializePrimitiveTableForSqueakV3"
MaxCompiledPrimitiveIndex := 222.
primitiveTable := CArrayAccessor on: (Array new: MaxCompiledPrimitiveIndex + 1).
self table: primitiveTable from:
#( "Integer Primitives (0-19)"
(1 genPrimitiveAdd 1)
(2 genPrimitiveSubtract 1)
(3 genPrimitiveLessThan 1)
(4 genPrimitiveGreaterThan 1)
(5 genPrimitiveLessOrEqual 1)
(6 genPrimitiveGreaterOrEqual 1)
(7 genPrimitiveEqual 1)
(8 genPrimitiveNotEqual 1)
(9 genPrimitiveMultiply 1 processorHasMultiply:)
(10 genPrimitiveDivide 1 processorHasDivQuoRem:)
(11 genPrimitiveMod 1 processorHasDivQuoRem:)
(12 genPrimitiveDiv 1 processorHasDivQuoRem:)
(13 genPrimitiveQuo 1 processorHasDivQuoRem:)
(14 genPrimitiveBitAnd 1)
(15 genPrimitiveBitOr 1)
(16 genPrimitiveBitXor 1)
(17 genPrimitiveBitShift 1)
"(18 primitiveMakePoint)"
"(19 primitiveFail)" "Guard primitive for simulation -- *must* fail"

"LargeInteger Primitives (20-39)"
"(20 primitiveFail)"
"(21 primitiveAddLargeIntegers)"
"(22 primitiveSubtractLargeIntegers)"
"(23 primitiveLessThanLargeIntegers)"
"(24 primitiveGreaterThanLargeIntegers)"
"(25 primitiveLessOrEqualLargeIntegers)"
"(26 primitiveGreaterOrEqualLargeIntegers)"
"(27 primitiveEqualLargeIntegers)"
"(28 primitiveNotEqualLargeIntegers)"
"(29 primitiveMultiplyLargeIntegers)"
"(30 primitiveDivideLargeIntegers)"
"(31 primitiveModLargeIntegers)"
"(32 primitiveDivLargeIntegers)"
"(33 primitiveQuoLargeIntegers)"
"(34 primitiveBitAndLargeIntegers)"
"(35 primitiveBitOrLargeIntegers)"
"(36 primitiveBitXorLargeIntegers)"
"(37 primitiveBitShiftLargeIntegers)"

"Float Primitives (38-59)"
"(38 primitiveFloatAt)"
"(39 primitiveFloatAtPut)"
(40 genPrimitiveAsFloat 0 processorHasDoublePrecisionFloatingPointSupport:)
(41 genPrimitiveFloatAdd 1 processorHasDoublePrecisionFloatingPointSupport:)
(42 genPrimitiveFloatSubtract 1 processorHasDoublePrecisionFloatingPointSupport:)
(43 genPrimitiveFloatLessThan 1 processorHasDoublePrecisionFloatingPointSupport:)
(44 genPrimitiveFloatGreaterThan 1 processorHasDoublePrecisionFloatingPointSupport:)
(45 genPrimitiveFloatLessOrEqual 1 processorHasDoublePrecisionFloatingPointSupport:)
(46 genPrimitiveFloatGreaterOrEqual 1 processorHasDoublePrecisionFloatingPointSupport:)
(47 genPrimitiveFloatEqual 1 processorHasDoublePrecisionFloatingPointSupport:)
(48 genPrimitiveFloatNotEqual 1 processorHasDoublePrecisionFloatingPointSupport:)
(49 genPrimitiveFloatMultiply 1 processorHasDoublePrecisionFloatingPointSupport:)
(50 genPrimitiveFloatDivide 1 processorHasDoublePrecisionFloatingPointSupport:)
"(51 primitiveTruncated)"
"(52 primitiveFractionalPart)"
"(53 primitiveExponent)"
"(54 primitiveTimesTwoPower)"
(55 genPrimitiveFloatSquareRoot 0 processorHasDoublePrecisionFloatingPointSupport:)
"(56 primitiveSine)"
"(57 primitiveArctan)"
"(58 primitiveLogN)"
"(59 primitiveExp)"

"Subscript and Stream Primitives (60-67)"
(60 genPrimitiveAt 1)
"(61 primitiveAtPut)"
(62 genPrimitiveSize 0)
(63 genPrimitiveStringAt 1)
"(64 primitiveStringAtPut)"
"The stream primitives no longer pay their way; normal Smalltalk code is faster."
"(65 primitiveFail)""was primitiveNext"
"(66 primitiveFail)" "was primitiveNextPut"
"(67 primitiveFail)" "was primitiveAtEnd"

"StorageManagement Primitives (68-79)"
"(68 primitiveObjectAt)"
"(69 primitiveObjectAtPut)"
"(70 primitiveNew)"
"(71 primitiveNewWithArg)"
"(72 primitiveArrayBecomeOneWay)" "Blue Book: primitiveBecome"
"(73 primitiveInstVarAt)"
"(74 primitiveInstVarAtPut)"
(75 genPrimitiveIdentityHash 0)
"(76 primitiveStoreStackp)" "Blue Book: primitiveAsObject"
"(77 primitiveSomeInstance)"
"(78 primitiveNextInstance)"
"(79 primitiveNewMethod)"

"Control Primitives (80-89)"
"(80 primitiveFail)" "Blue Book: primitiveBlockCopy"
"(81 primitiveFail)" "Blue Book: primitiveValue"
"(82 primitiveFail)" "Blue Book: primitiveValueWithArgs"
"(83 primitivePerform)"
"(84 primitivePerformWithArgs)"
"(85 primitiveSignal)"
"(86 primitiveWait)"
"(87 primitiveResume)"
"(88 primitiveSuspend)"
"(89 primitiveFlushCache)"

"Input/Output Primitives (90-109); We won't compile any of these"

"System Primitives (110-119)"
(110 genPrimitiveEquivalent 1)
"(111 genPrimitiveClass)"
"(112 primitiveBytesLeft)"
"(113 primitiveQuit)"
"(114 primitiveExitToDebugger)"
"(115 primitiveChangeClass)" "Blue Book: primitiveOopsLeft"
"(116 primitiveFlushCacheByMethod)"
"(117 primitiveExternalCall)"
"(118 primitiveDoPrimitiveWithArgs)"
"(119 primitiveFlushCacheSelective)"
"Squeak 2.2 and earlier use 119. Squeak 2.3 and later use 116.
Both are supported for backward compatibility."

"Miscellaneous Primitives (120-127); We won't compile any of these"

"Squeak Primitives Start Here"

"Squeak Miscellaneous Primitives (128-149); We won't compile any of these"

"File Primitives (150-169) - NO LONGER INDEXED; We won't compile any of these"
+ (169 genPrimitiveNotEquivalent 1)

"Sound Primitives (170-199) - NO LONGER INDEXED; We won't compile any of these"

"Old closure primitives"
"(186 primitiveFail)" "was primitiveClosureValue"
"(187 primitiveFail)" "was primitiveClosureValueWithArgs"

"Perform method directly"
"(188 primitiveExecuteMethodArgsArray)"
"(189 primitiveExecuteMethod)"

"Sound Primitives (continued) - NO LONGER INDEXED; We won't compile any of these"
"(190 194 primitiveFail)"

"Unwind primitives"
"(195 primitiveFindNextUnwindContext)"
"(196 primitiveTerminateTo)"
"(197 primitiveFindHandlerContext)"
(198 genFastPrimFail "primitiveMarkUnwindMethod")
(199 genFastPrimFail "primitiveMarkHandlerMethod")

"new closure primitives (were Networking primitives)"
"(200 primitiveClosureCopyWithCopiedValues)"
(201 genPrimitiveClosureValue) "value"
(202 genPrimitiveClosureValue) "value:"
(203 genPrimitiveClosureValue) "value:value:"
(204 genPrimitiveClosureValue) "value:value:value:"
(205 genPrimitiveClosureValue) "value:value:value:value:"
"(206 genPrimitiveClosureValueWithArgs)" "valueWithArguments:"

"(207 209 primitiveFail)" "reserved for Cog primitives"

"(210 primitiveContextAt)"
"(211 primitiveContextAtPut)"
"(212 primitiveContextSize)"
"(213 217 primitiveFail)" "reserved for Cog primitives"
"(218 primitiveDoNamedPrimitiveWithArgs)"
"(219 primitiveFail)" "reserved for Cog primitives"

"(220 primitiveFail)" "reserved for Cog primitives"

(221 genPrimitiveClosureValue) "valueNoContextSwitch"
(222 genPrimitiveClosureValue) "valueNoContextSwitch:"

"(223 229 primitiveFail)" "reserved for Cog primitives"
)!

Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveEquivalent (in category 'primitive generators') -----
genPrimitiveEquivalent
"Stack looks like
receiver (also in ResultReceiverReg)
arg
return address"
| jumpFalse |
<var: #jumpFalse type: #'AbstractInstruction *'>
self MoveMw: BytesPerWord r: SPReg R: TempReg.
self CmpR: TempReg R: ReceiverResultReg.
jumpFalse := self JumpNonZero: 0.
self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
objRef: objectMemory trueObject.
self flag: 'currently caller pushes result'.
self RetN: BytesPerWord * 2.
+ jumpFalse jmpTarget: (self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
+ objRef: objectMemory falseObject).
- jumpFalse jmpTarget: (self
- annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
- objRef: objectMemory falseObject).
self RetN: BytesPerWord * 2.
^0!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genPrimitiveNotEquivalent (in category 'primitive generators') -----
+ genPrimitiveNotEquivalent
+ "Stack looks like
+ receiver (also in ResultReceiverReg)
+ arg
+ return address"
+ | jumpFalse |
+ <var: #jumpFalse type: #'AbstractInstruction *'>
+ self MoveMw: BytesPerWord r: SPReg R: TempReg.
+ self CmpR: TempReg R: ReceiverResultReg.
+ jumpFalse := self JumpZero: 0.
+ self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
+ objRef: objectMemory trueObject.
+ self flag: 'currently caller pushes result'.
+ self RetN: BytesPerWord * 2.
+ jumpFalse jmpTarget: (self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
+ objRef: objectMemory falseObject).
+ self RetN: BytesPerWord * 2.
+ ^0!

Item was changed:
----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)

Item was changed:
----- Method: StackInterpreter>>commonSend (in category 'message sending') -----
commonSend
"Send a message, starting lookup with the receiver's class."
"Assume: messageSelector and argumentCount have been set, and that
the receiver and arguments have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
<sharedCodeNamed: 'commonSend' inCase: 131>
self sendBreak: messageSelector + BaseHeaderSize
point: (objectMemory lengthOf: messageSelector)
receiver: (self internalStackValue: argumentCount).
+ self printSends ifTrue:
+ [self printActivationNameForSelector: messageSelector startClass: lkupClass; cr].
self internalFindNewMethod.
self internalExecuteNewMethod.
self fetchNextBytecode!

Item was added:
+ ----- Method: StackInterpreter>>findClassForSelector:lookupClass:do: (in category 'debug support') -----
+ findClassForSelector: aSelector lookupClass: startClass do: unaryBlock
+ "Search startClass' class hierarchy looking for aSelector and if found, evaluate unaryBlock
+ with the class where the selector is found. Otherwise evaluate unaryBlock with nil."
+ | currClass classDict classDictSize i |
+ currClass := startClass.
+ [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass.
+ classDictSize := objectMemory fetchWordLengthOf: classDict.
+ i := SelectorStart.
+ [i < classDictSize] whileTrue:
+ [aSelector = (objectMemory fetchPointer: i ofObject: classDict) ifTrue:
+ [^unaryBlock value: currClass].
+ i := i + 1].
+ currClass := self superclassOf: currClass.
+ currClass = objectMemory nilObject] whileFalse.
+ ^unaryBlock value: nil "selector not found in superclass chain"
+ !

Item was added:
+ ----- Method: StackInterpreter>>findSelectorAndClassForMethod:lookupClass:do: (in category 'debug support') -----
+ findSelectorAndClassForMethod: meth lookupClass: startClass do: binaryBlock
+ "Search startClass' class hierarchy searching for method and if found, evaluate aBinaryBlock
+ with the selector and class where the method is found. Otherwise evaluate aBinaryBlock
+ with doesNotUnderstand: and nil."
+ | currClass classDict classDictSize methodArray i |
+ currClass := startClass.
+ [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass.
+ classDictSize := objectMemory fetchWordLengthOf: classDict.
+ methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
+ i := 0.
+ [i <= (classDictSize - SelectorStart)] whileTrue:
+ [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue:
+ [^binaryBlock
+ value: (objectMemory fetchPointer: i + SelectorStart ofObject: classDict)
+ value: currClass].
+ i := i + 1].
+ currClass := self superclassOf: currClass.
+ currClass = objectMemory nilObject] whileFalse.
+ ^binaryBlock "method not found in superclass chain"
+ value: (objectMemory splObj: SelectorDoesNotUnderstand)
+ value: nil!

Item was changed:
----- Method: StackInterpreter>>primitiveObject:perform:withArguments:lookedUpIn: (in category 'control primitives') -----
primitiveObject: actualReceiver perform: selector withArguments: argumentArray lookedUpIn: lookupClass
"Common routine used by perform:withArgs:, perform:withArgs:inSuperclass:,
object:perform:withArgs:inClass: et al. Answer nil on success.

NOTE: The case of doesNotUnderstand: is not a failure to perform.
The only failures are arg types and consistency of argumentCount.

Since we're in the stack VM we can assume there is space to push the arguments
provided they are within limits (max argument count is 15). We can therefore deal
with the arbitrary amount of state to remove from the stack (lookup class, selector,
mirror receiver) and arbitrary argument orders by deferring popping anything until
we know whether the send has succeeded. So on failure we merely have to remove
the actual receiver and arguments pushed, and on success we have to slide the actual
receiver and arguments down to replace the original ones."

| arraySize performArgCount delta |
(objectMemory isArray: argumentArray) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].

"Check if number of arguments is reasonable; MaxNumArgs isn't available
so just use LargeContextSize"
arraySize := objectMemory fetchWordLengthOf: argumentArray.
arraySize > (LargeContextSize / BytesPerWord) ifTrue:
[^self primitiveFailFor: PrimErrBadNumArgs].

performArgCount := argumentCount.
"Push newMethod to save it in case of failure,
then push the actual receiver and args out of the array."
self push: newMethod.
self push: actualReceiver.
"Copy the arguments to the stack, and execute"
1 to: arraySize do:
[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
argumentCount := arraySize.
messageSelector := selector.
self sendBreak: messageSelector + BaseHeaderSize
point: (objectMemory lengthOf: messageSelector)
receiver: actualReceiver.
+ self printSends ifTrue:
+ [self printActivationNameForSelector: messageSelector startClass: lookupClass; cr].
self findNewMethodInClass: lookupClass.

"Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances"
((objectMemory isOopCompiledMethod: newMethod)
and: [(self argumentCountOf: newMethod) ~= argumentCount]) ifTrue:
["Restore the state by popping all those array entries and pushing back the selector and array, and fail"
self pop: arraySize + 1.
newMethod := self popStack.
^self primitiveFailFor: PrimErrBadNumArgs].

"Cannot fail this primitive from here-on. Slide the actual receiver and arguments down
to replace the perform arguments and saved newMethod and then execute the new
method. Use argumentCount not arraySize because an MNU may have changed it."
delta := BytesPerWord * (performArgCount + 2). "+2 = receiver + saved newMethod"
argumentCount * BytesPerWord to: 0 by: BytesPerWord negated do:
[:offset|
stackPages
longAt: stackPointer + offset + delta
put: (stackPages longAt: stackPointer + offset)].
self pop: performArgCount + 2.
self executeNewMethod.
self initPrimCall. "Recursive xeq affects primErrorCode"
^nil!

Item was added:
+ ----- Method: StackInterpreter>>printActivationNameForMethod:startClass:isBlock:firstTemporary: (in category 'debug printing') -----
+ printActivationNameForMethod: aMethod startClass: startClass isBlock: isBlock firstTemporary: maybeMessage
+ | methClass methodSel |
+ <inline: false>
+ isBlock ifTrue:
+ [self print: '[] in '].
+ self findSelectorAndClassForMethod: aMethod
+ lookupClass: startClass
+ do: [:sel :class|
+ methodSel := sel.
+ methClass := class].
+ ((self addressCouldBeOop: startClass) and: [methClass notNil])
+ ifTrue:
+ [startClass = methClass
+ ifTrue: [self printNameOfClass: methClass count: 5]
+ ifFalse:
+ [self printNameOfClass: startClass count: 5.
+ self printChar: $(.
+ self printNameOfClass: methClass count: 5.
+ self printChar: $)]]
+ ifFalse: [self print: 'INVALID CLASS'].
+ self printChar: $>.
+ (objectMemory addressCouldBeOop: methodSel)
+ ifTrue:
+ [(objectMemory isBytes: methodSel)
+ ifTrue: [self printStringOf: methodSel]
+ ifFalse: [self printOopShort: methodSel]]
+ ifFalse: [self print: 'INVALID SELECTOR'].
+ (methodSel = (objectMemory splObj: SelectorDoesNotUnderstand)
+ and: [(objectMemory addressCouldBeObj: maybeMessage)
+ and: [(objectMemory fetchClassOfNonInt: maybeMessage) = (objectMemory splObj: ClassMessage)]]) ifTrue:
+ ["print arg message selector"
+ methodSel := objectMemory fetchPointer: MessageSelectorIndex ofObject: maybeMessage.
+ self print: ' '.
+ self printStringOf: methodSel]!

Item was added:
+ ----- Method: StackInterpreter>>printActivationNameForSelector:startClass: (in category 'debug printing') -----
+ printActivationNameForSelector: aSelector startClass: startClass
+ | methClass |
+ <inline: false>
+ (objectMemory addressCouldBeObj: startClass)
+ ifTrue:
+ [self findClassForSelector: aSelector
+ lookupClass: startClass
+ do: [:class| methClass := class].
+ (methClass isNil or: [startClass = methClass])
+ ifTrue:
+ [self printNameOfClass: methClass count: 5..
+ self printChar: $>.
+ methClass ifNil:
+ [self printStringOf: (objectMemory splObj: SelectorDoesNotUnderstand).
+ self print: ' ']]
+ ifFalse:
+ [self printNameOfClass: startClass count: 5.
+ self printChar: $(.
+ self printNameOfClass: methClass count: 5.
+ self printChar: $).
+ self printChar: $>]]
+ ifFalse: [self print: 'INVALID CLASS'].
+ (objectMemory addressCouldBeOop: aSelector)
+ ifTrue:
+ [(objectMemory isBytes: aSelector)
+ ifTrue: [self printStringOf: aSelector]
+ ifFalse: [self printOopShort: aSelector]]
+ ifFalse: [self print: 'INVALID SELECTOR']!

Item was added:
+ ----- Method: StackInterpreter>>printSends (in category 'debug printing') -----
+ printSends
+ ^false!

Item was changed:
----- Method: StackInterpreter>>stObject:at: (in category 'indexing primitive support') -----
stObject: array at: index
"Return what ST would return for <obj> at: index."

| hdr fmt totalLength fixedFields stSize |
<inline: false>
hdr := objectMemory baseHeader: array.
fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: array baseHeader: hdr format: fmt.
fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength.
(fmt = 3 and: [objectMemory isContextHeader: hdr])
ifTrue:
+ [stSize := self stackPointerForMaybeMarriedContext: array.
- [stSize := self fetchStackPointerOf: array.
((self oop: index isGreaterThanOrEqualTo: 1)
and: [(self oop: index isLessThanOrEqualTo: stSize)
and: [self isStillMarriedContext: array]]) ifTrue:
[^self noInlineTemporary: index - 1 in: (self frameOfMarriedContext: array)]]
ifFalse: [stSize := totalLength - fixedFields].
((self oop: index isGreaterThanOrEqualTo: 1)
and: [self oop: index isLessThanOrEqualTo: stSize])
ifTrue: [^self subscript: array with: (index + fixedFields) format: fmt]
ifFalse: [self primitiveFailFor: PrimErrBadIndex. ^ 0]!

Item was changed:
----- Method: StackInterpreter>>stObject:at:put: (in category 'indexing primitive support') -----
stObject: array at: index put: value
"Do what ST would return for <obj> at: index put: value."
| hdr fmt totalLength fixedFields stSize |
<inline: false>
hdr := objectMemory baseHeader: array.
fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: array baseHeader: hdr format: fmt.
fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength.
(fmt = 3
and: [objectMemory isContextHeader: hdr])
ifTrue:
+ [stSize := self stackPointerForMaybeMarriedContext: array.
- [stSize := self fetchStackPointerOf: array.
((self oop: index isGreaterThanOrEqualTo: 1)
and: [(self oop: index isLessThanOrEqualTo: stSize)
and: [self isStillMarriedContext: array]]) ifTrue:
[self noInlineTemporary: index - 1 in: (self frameOfMarriedContext: array) put: value.
^self]]
ifFalse: [stSize := totalLength - fixedFields].
((self oop: index isGreaterThanOrEqualTo: 1)
and: [self oop: index isLessThanOrEqualTo: stSize])
ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
ifFalse: [self primitiveFailFor: PrimErrBadIndex]!

Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveContextAt (in category 'indexing primitives') -----
primitiveContextAt
"Special version of primitiveAt for accessing contexts.
Written to be varargs for use from mirror primitives."
| index value aContext spouseFP hdr fmt totalLength fixedFields stSize |
<inline: false>
<var: #spouseFP type: #'char *'>
index := self stackTop.
(objectMemory isIntegerObject: index) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
index := objectMemory integerValueOf: index.
aContext := self stackValue: 1.
"Duplicating much of stObject:at:put: here allows stObject:at:put: to omit tests for contexts."
hdr := objectMemory baseHeader: aContext.
(objectMemory isContextHeader: hdr) ifFalse: "might be an instance of a subclass"
[value := self stObject: aContext at: index.
^self pop: argumentCount thenPush: value].
self externalWriteBackHeadFramePointers.
(self isStillMarriedContext: aContext) ifFalse:
[fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: aContext baseHeader: hdr format: fmt.
fixedFields := objectMemory fixedFieldsOf: aContext format: fmt length: totalLength.
+ stSize := self fetchStackPointerOf: aContext.
- stSize := self stackPointerForMaybeMarriedContext: aContext.
(index between: 1 and: stSize) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
value := self subscript: aContext with: (index + fixedFields) format: fmt.
^self pop: argumentCount + 1 thenPush: value].
spouseFP := self frameOfMarriedContext: aContext.
(index between: 1 and: (self stackPointerIndexForFrame: spouseFP)) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
value := self temporary: index - 1 in: spouseFP.
self pop: argumentCount + 1 thenPush: value!

Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveContextAtPut (in category 'indexing primitives') -----
primitiveContextAtPut
"Special version of primitiveAtPut for accessing contexts.
Written to be varargs for use from mirror primitives."
| index value aContext spouseFP hdr fmt totalLength fixedFields stSize |
<inline: false>
<var: #spouseFP type: #'char *'>
value := self stackTop.
index := self stackValue: 1.
aContext := self stackValue: 2.
(objectMemory isIntegerObject: index) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
"Duplicating much of stObject:at:put: here allows stObject:at:put: to omit tests for contexts."
hdr := objectMemory baseHeader: aContext.
index := objectMemory integerValueOf: index.
(objectMemory isContextHeader: hdr) ifFalse: "might be an instance of a subclass"
[self stObject: aContext at: index put: value.
^self pop: argumentCount + 1 thenPush: value].
self externalWriteBackHeadFramePointers.
(self isStillMarriedContext: aContext) ifFalse:
[fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: aContext baseHeader: hdr format: fmt.
fixedFields := objectMemory fixedFieldsOf: aContext format: fmt length: totalLength.
+ stSize := self fetchStackPointerOf: aContext.
- stSize := self stackPointerForMaybeMarriedContext: aContext.
(index between: 1 and: stSize) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
self subscript: aContext with: (index + fixedFields) storing: value format: fmt.
^self pop: argumentCount + 1 thenPush: value].
spouseFP := self frameOfMarriedContext: aContext.
(index between: 1 and: (self stackPointerIndexForFrame: spouseFP)) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
self temporary: index - 1 in: spouseFP put: value.
^self pop: argumentCount + 1 thenPush: value!

Item was changed:
----- Method: StackInterpreterPrimitives>>primitivePerform (in category 'control primitives') -----
primitivePerform
<returnTypeC: #void>
| performSelector newReceiver lookupClass performMethod |
performSelector := messageSelector.
performMethod := newMethod.
messageSelector := self stackValue: argumentCount - 1.
newReceiver := self stackValue: argumentCount.

"NOTE: the following lookup may fail and be converted to #doesNotUnderstand:,
so we must adjust argumentCount and slide args now, so that will work."

"Slide arguments down over selector"
argumentCount := argumentCount - 1.
argumentCount to: 1 by: -1 do:
[:i|
stackPages
longAt: stackPointer + (i * BytesPerWord)
put: (stackPages longAt: stackPointer + ((i - 1) * BytesPerWord))].
self pop: 1.
lookupClass := objectMemory fetchClassOf: newReceiver.
self sendBreak: messageSelector + BaseHeaderSize
point: (objectMemory lengthOf: messageSelector)
receiver: newReceiver.
+ self printSends ifTrue:
+ [self printActivationNameForSelector: messageSelector startClass: lookupClass; cr].
self findNewMethodInClass: lookupClass.

"Only test CompiledMethods for argument count - other objects will have to take their chances"
((objectMemory isOopCompiledMethod: newMethod)
and: [(self argumentCountOf: newMethod) = argumentCount]) ifFalse:
["Slide the args back up (sigh) and re-insert the selector."
self unPop: 1.
1 to: argumentCount by: 1 do:
[:i |
stackPages longAt: stackPointer + ((i - 1) * BytesPerWord)
put: (stackPages longAt: stackPointer + (i * BytesPerWord))].
stackPages longAt: stackPointer + (argumentCount * BytesPerWord) put: messageSelector.
argumentCount := argumentCount + 1.
newMethod := performMethod.
messageSelector := performSelector.
^self primitiveFail].

self executeNewMethod.
"Recursive xeq affects primErrorCode"
self initPrimCall!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genPrimitiveNotEquivalent (in category 'primitive generators') -----
+ genPrimitiveNotEquivalent
+ "Receiver and arg in registers.
+ Stack looks like
+ return address"
+ | jumpFalse |
+ <var: #jumpFalse type: #'AbstractInstruction *'>
+ self CmpR: Arg0Reg R: ReceiverResultReg.
+ jumpFalse := self JumpZero: 0.
+ self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
+ objRef: objectMemory trueObject.
+ self RetN: 0.
+ jumpFalse jmpTarget: (self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
+ objRef: objectMemory falseObject).
+ self RetN: 0.
+ ^0!