[Vm-dev] VM Maker: VMMaker-oscog-EstebanLorenzano.233.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Feb 21 11:08:10 UTC 2013
Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-oscog-EstebanLorenzano.233.mcz
==================== Summary ====================
Name: VMMaker-oscog-EstebanLorenzano.233
Author: EstebanLorenzano
Time: 21 February 2013, 12:04:23.993 pm
UUID: 5ad9f706-8aa4-4220-9b40-7ac77621a6e2
Ancestors: VMMaker-oscog-EstebanLorenzano.232, VMMaker.oscog-eem.266
- merged with Eliot's 266
- it tries to fix a recurrent crash of cog when becoming objects
=============== Diff against VMMaker-oscog-EstebanLorenzano.232 ===============
Item was added:
+ ----- Method: CCodeGenerator>>generateAsLong:on:indent: (in category 'C translation') -----
+ generateAsLong: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ aStream nextPutAll:'((long)'.
+ self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!
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:
+ #asLong #generateAsLong:on:indent:
#asUnsignedLong #generateAsUnsignedLong:on:indent:
#asSymbol #generateAsSymbol:on:indent:
#flag: #generateFlag: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>>rawHeaderOf:put: (in category 'compiled methods') -----
rawHeaderOf: methodOop put: cogMethodOrMethodHeader
<api>
+ "Since methods may be updated while forwarding during become, make the assert accomodate this."
+ self assert: (objectMemory isCompiledMethodHeader: (objectMemory headerWhileForwardingOf: methodOop)).
- self assert: (objectMemory isCompiledMethod: methodOop).
objectMemory
storePointerUnchecked: HeaderIndex
ofObject: methodOop
withValue: cogMethodOrMethodHeader!
Item was changed:
----- Method: CoInterpreter>>reportMinimumUnusedHeadroom (in category 'debug support') -----
reportMinimumUnusedHeadroom
"Report the stack page size and minimum unused headroom to stdout."
<api>
self cCode:
[self pri: 'stack page bytes %ld available headroom %ld minimum unused headroom %ld\n'
+ n: self stackPageByteSize asLong
+ t: (self stackPageByteSize - self stackLimitBytes - self stackLimitOffset) asLong
+ f: self minimumUnusedHeadroom asLong]
- n: self stackPageByteSize
- t: self stackPageByteSize - self stackLimitBytes - self stackLimitOffset
- f: self minimumUnusedHeadroom]
inSmalltalk:
["CogVMSimulator new initStackPagesForTests reportMinimumUnusedHeadroom"
self print: 'stack page bytes '; printNum: self stackPageByteSize;
print: ' available headroom '; printNum: self stackPageByteSize - self stackLimitBytes - self stackLimitOffset;
print: ' minimum unused headroom '; printNum: self minimumUnusedHeadroom;
cr]!
Item was changed:
CoInterpreterMT subclass: #CogVMSimulator
instanceVariableNames: 'enableCog byteCount lastPollCount lastExtPC sendCount printSends traceOn myBitBlt displayForm imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-JITSimulation'!
+ !CogVMSimulator commentStamp: 'eem 2/13/2013 15:33' prior: 0!
+ This class defines basic memory access and primitive simulation so that the CoInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory. Remember that you can test the Cogit using its class-side in-image compilation facilities.
- !CogVMSimulator commentStamp: '<historical>' prior: 0!
- This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.
To see the thing actually run, you could (after backing up this image and changes), execute
(CogVMSimulator new openOn: Smalltalk imageName) test
+ and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image.
+
+ Here's an example to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff:
+
+ | opts |
+ CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)).
+ CogVMSimulator chooseAndInitCogitClassWithOpts: opts.
+ CogVMSimulator new
+ desiredNumStackPages: 8;
+ openAsMorph;
+ run
+
+ Here's a hairier example that I (Eliot) actually use in daily development with some of the breakpoint facilities commented out.
+
+ | cos proc opts |
+ CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)).
+ CogVMSimulator chooseAndInitCogitClassWithOpts: opts.
+ cos := CogVMSimulator new.
+ "cos initializeThreadSupport." "to test the multi-threaded VM"
+ cos desiredNumStackPages: 8. "to set the size of the stack zone"
+ "cos desiredCogCodeSize: 8 * 1024 * 1024." "to set the size of the Cogit's code zone"
+ cos openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. "choose your favourite image"
+ "cos setBreakSelector: 'r:degrees:'." "set a breakpoint at a specific selector"
+ proc := cos cogit processor.
+ "cos cogit sendTrace: 7." "turn on tracing"
+ "set a complex breakpoint at a specific point in machine code"
+ "cos cogit singleStep: true; breakPC: 16r56af; breakBlock: [:cg| cos framePointer > 16r101F3C and: [(cos longAt: cos framePointer - 4) = 16r2479A and: [(cos longAt: 16r101F30) = (cos longAt: 16r101F3C) or: [(cos longAt: 16r101F2C) = (cos longAt: 16r101F3C)]]]]; sendTrace: 1".
+ "[cos cogit compilationTrace: -1] on: MessageNotUnderstood do: [:ex|]." "turn on compilation tracing in the StackToRegisterMappingCogit"
+ "cos cogit setBreakMethod: 16rB38880."
+ cos
+ openAsMorph;
+ "toggleTranscript;" "toggleTranscript will send output to the Transcript instead of the morph's rather small window"
+ halt;
+ run!
- and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image. You will probably have more luck using InterpreteSimulatorLSB or InterpreterSimulatorMSB as befits your machine.!
Item was changed:
CogClass subclass: #Cogit
instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMissCall missOffset entryPointMask checkedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxMethodBefore ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceStoreCheckTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceClosureCopyTrampoline ceCreateNewArrayTrampoline ceEnterCogCodePopReceiverReg ceEnterCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceActiveContextTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline cePositive32BitIntegerTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB'
classVariableNames: 'AltBlockCreationBytecodeSize AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxUnitDisplacement MaxUnreportableError MaxX2NDisplacement NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass YoungSelectorInPIC'
poolDictionaries: 'CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices VMStackFrameOffsets'
category: 'VMMaker-JIT'!
Cogit class
instanceVariableNames: 'generatorTable primitiveTable'!
+ !Cogit commentStamp: 'eem 2/13/2013 15:37' prior: 0!
+ I am the code generator for the Cog VM. My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance. I can be tested in the current image using my class-side in-image compilation facilities. e.g. try
- !Cogit commentStamp: '<historical>' prior: 0!
- I am the code generator for the Cog VM. My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance.
+ StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib)
+
+ I have concrete subclasses that implement different levels of optimization:
+ SimpleStackBasedCogit is the simplest code generator.
+
+ StackToRegisterMappingCogit is the current production code generator It defers pushing operands
+ to the stack until necessary and implements a register-based calling convention for low-arity sends.
+
+ StackToRegisterMappingCogit is an experimental code generator with support for counting
+ conditional branches, intended to support adaptive optimization.
+
coInterpreter <CoInterpreterSimulator>
the VM's interpreter with which I cooperate
methodZoneManager <CogMethodZoneManager>
the manager of the machine code zone
objectRepresentation <CogObjectRepresentation>
the object used to generate object accesses
processor <BochsIA32Alien|?>
the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk
simulatedTrampolines <Dictionary of Integer -> MessageSend>
the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time.
simulatedVariableGetters <Dictionary of Integer -> MessageSend>
the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time.
simulatedVariableSetters <Dictionary of Integer -> MessageSend>
the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time.
printRegisters printInstructions clickConfirm <Boolean>
flags controlling debug printing and code simulation
breakPC <Integer>
machine code pc breakpoint
cFramePointer cStackPointer <Integer>
the variables representing the C stack & frame pointers, which must change on FFI callback and return
selectorOop <sqInt>
the oop of the methodObj being compiled
methodObj <sqInt>
the bytecode method being compiled
initialPC endPC <Integer>
the start and end pcs of the methodObj being compiled
methodOrBlockNumArgs <Integer>
argument count of current method or block being compiled
needsFrame <Boolean>
whether methodObj or block needs a frame to execute
primitiveIndex <Integer>
primitive index of current method being compiled
methodLabel <CogAbstractOpcode>
label for the method header
blockEntryLabel <CogAbstractOpcode>
label for the start of the block dispatch code
stackOverflowCall <CogAbstractOpcode>
label for the call of ceStackOverflow in the method prolog
sendMissCall <CogAbstractOpcode>
label for the call of ceSICMiss in the method prolog
entryOffset <Integer>
offset of method entry code from start (header) of method
entry <CogAbstractOpcode>
label for the first instruction of the method entry code
noCheckEntryOffset <Integer>
offset of the start of a method proper (after the method entry code) from start (header) of method
noCheckEntry <CogAbstractOpcode>
label for the first instruction of start of a method proper
fixups <Array of <AbstractOpcode Label | nil>>
the labels for forward jumps that will be fixed up when reaching the relevant bytecode. fixup shas one element per byte in methodObj's bytecode
abstractOpcodes <Array of <AbstractOpcode>>
the code generated when compiling methodObj
byte0 byte1 byte2 byte3 <Integer>
individual bytes of current bytecode being compiled in methodObj
bytecodePointer <Integer>
bytecode pc (same as Smalltalk) of the current bytecode being compiled
opcodeIndex <Integer>
the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist)
numAbstractOpcodes <Integer>
the number of elements in abstractOpcocdes
blockStarts <Array of <BlockStart>>
the starts of blocks in the current method
blockCount
the index into blockStarts as they are being noted, and hence eventuakly teh total number of blocks in the current method
labelCounter <Integer>
a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about
ceStackOverflowTrampoline <Integer>
ceSend0ArgsTrampoline <Integer>
ceSend1ArgsTrampoline <Integer>
ceSend2ArgsTrampoline <Integer>
ceSendNArgsTrampoline <Integer>
ceSendSuper0ArgsTrampoline <Integer>
ceSendSuper1ArgsTrampoline <Integer>
ceSendSuper2ArgsTrampoline <Integer>
ceSendSuperNArgsTrampoline <Integer>
ceSICMissTrampoline <Integer>
ceCPICMissTrampoline <Integer>
ceStoreCheckTrampoline <Integer>
ceReturnToInterpreterTrampoline <Integer>
ceBaseFrameReturnTrampoline <Integer>
ceSendMustBeBooleanTrampoline <Integer>
ceClosureCopyTrampoline <Integer>
the various trampolines (system-call-like jumps from machine code to the run-time).
See Cogit>>generateTrampolines for the mapping from trampoline to run-time
routine and then read the run-time routine for a funcitonal description.
ceEnterCogCodePopReceiverReg <Integer>
the enilopmart (jump from run-time to machine-code)
methodZoneBase <Integer>
!
Cogit class
instanceVariableNames: 'generatorTable primitiveTable'!
Item was changed:
----- Method: Cogit>>bcpcsAndDescriptorsFor:do: (in category 'tests-method map') -----
bcpcsAndDescriptorsFor: aMethod do: trinaryBlock
<doNotGenerate>
| bsOffset nExts byte descriptor endpc latestContinuation pc primIdx |
((primIdx := coInterpreter primitiveIndexOf: aMethod) > 0
and: [coInterpreter isQuickPrimitiveIndex: primIdx]) ifTrue:
[^self].
latestContinuation := pc := coInterpreter startPCOfMethod: aMethod.
trinaryBlock value: pc value: nil value: nil. "stackCheck/entry pc"
bsOffset := self bytecodeSetOffsetFor: aMethod.
nExts := 0.
+ endpc := objectMemory byteLengthOf: aMethod.
- endpc := objectMemory byteSizeOf: aMethod.
[pc <= endpc] whileTrue:
[byte := objectMemory fetchByte: pc ofObject: aMethod.
descriptor := self generatorAt: byte + bsOffset.
trinaryBlock value: pc value: byte value: descriptor.
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[endpc := pc].
(descriptor isBranch
or: [descriptor isBlockCreation]) ifTrue:
[| targetPC |
descriptor isBlockCreation ifTrue:
[trinaryBlock value: pc + descriptor numBytes value: nil value: nil]. "stackCheck/entry pc"
targetPC := self latestContinuationPCFor: descriptor at: pc exts: nExts in: aMethod.
self assert: targetPC < endpc.
latestContinuation := latestContinuation max: targetPC].
pc := pc + descriptor numBytes.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]!
Item was changed:
----- Method: Cogit>>blockStartPcsIn: (in category 'disassembly') -----
blockStartPcsIn: aMethod
"Answer the start bytecopde pcs in a method in compilation order, i.e. depth-first.
Blocks must occur in pc/depth-first order for binary tree block dispatch to work."
| startpcs pc latestContinuation end descriptor byte bsOffset nExts |
<doNotGenerate>
startpcs := OrderedCollection new.
startpcs add: (pc := latestContinuation := coInterpreter startPCOfMethod: aMethod).
+ end := objectMemory byteLengthOf: aMethod.
- end := objectMemory byteSizeOf: aMethod.
bsOffset := self bytecodeSetOffsetFor: aMethod.
nExts := 0.
[pc <= end] whileTrue:
[byte := objectMemory fetchByte: pc ofObject: aMethod.
descriptor := self generatorAt: byte + bsOffset.
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[end := pc].
(descriptor isBranch
or: [descriptor isBlockCreation]) ifTrue:
[| targetPC |
targetPC := self latestContinuationPCFor: descriptor at: pc exts: nExts in: aMethod.
latestContinuation := latestContinuation max: targetPC].
pc := pc + descriptor numBytes.
descriptor isBlockCreation ifTrue:
[startpcs add: pc].
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
^startpcs!
Item was removed:
- ----- Method: Cogit>>byteAt:put: (in category 'generate machine code') -----
- byteAt: anAddress put: aValue
- "Store a byte in memory. In Smaltalk defer to the coInterpreter.
- In C this will be replaced by a macro (byteAtPut)."
- <doNotGenerate>
- objectMemory byteAt: anAddress put: aValue!
Item was changed:
----- Method: Cogit>>compileCogMethod: (in category 'compile abstract instructions') -----
compileCogMethod: selector
<returnTypeC: #'CogMethod *'>
| numBytecodes numBlocks result extra |
hasYoungReferent := (objectMemory isYoung: methodObj)
or: [objectMemory isYoung: selector].
methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
inBlock := false.
primInvokeLabel := nil.
postCompileHook := nil.
extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
ifTrue: [30]
ifFalse: [10].
initialPC := coInterpreter startPCOfMethod: methodObj.
"initial estimate. Actual endPC is determined in scanMethod."
endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
ifTrue: [initialPC - 1]
+ ifFalse: [objectMemory byteLengthOf: methodObj].
- ifFalse: [objectMemory byteSizeOf: methodObj].
numBytecodes := endPC - initialPC + 1.
self allocateOpcodes: (numBytecodes + extra) * 10 bytecodes: numBytecodes.
(numBlocks := self scanMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
self allocateBlockStarts: numBlocks.
blockEntryLabel := nil.
methodLabel dependent: nil.
(result := self compileEntireMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
^self generateCogMethod: selector!
Item was changed:
+ ----- Method: Cogit>>endPCOf: (in category 'compiled methods') -----
- ----- Method: Cogit>>endPCOf: (in category 'simulation only') -----
endPCOf: aMethod
+ <var: #descriptor type: #'BytecodeDescriptor *'>
| pc end latestContinuation descriptor prim distance targetPC byte bsOffset nExts |
pc := latestContinuation := coInterpreter startPCOfMethod: aMethod.
(prim := coInterpreter primitiveIndexOf: aMethod) > 0 ifTrue:
[(coInterpreter isQuickPrimitiveIndex: prim) ifTrue:
[^pc - 1]].
bsOffset := self bytecodeSetOffsetFor: aMethod.
nExts := 0.
+ end := objectMemory byteLengthOf: aMethod.
- end := objectMemory byteSizeOf: aMethod.
[pc <= end] whileTrue:
[byte := objectMemory fetchByte: pc ofObject: aMethod.
descriptor := self generatorAt: byte + bsOffset.
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[end := pc].
(descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
[distance := self spanFor: descriptor at: pc exts: nExts in: aMethod.
targetPC := pc + descriptor numBytes + distance.
latestContinuation := latestContinuation max: targetPC.
descriptor isBlockCreation ifTrue:
[pc := pc + distance]].
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
pc := pc + descriptor numBytes].
^end!
Item was changed:
----- Method: Cogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') -----
mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg
"Machine-code <-> bytecode pc mapping support. Evaluate functionSymbol
for each mcpc, bcpc pair in the map until the function returns non-zero,
answering that result, or 0 if it fails to. This works only for frameful methods."
<var: #cogMethod type: #'CogBlockMethod *'>
<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(char *mcpc, sqInt bcpc, void *arg)'>
<var: #arg type: #'void *'>
| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
latestContinuation byte descriptor bsOffset nExts |
<var: #descriptor type: #'BytecodeDescriptor *'>
<var: #homeMethod type: #'CogMethod *'>
self assert: cogMethod stackCheckOffset > 0.
"In both CMMethod and CMBlock cases find the start of the map and
skip forward to the bytecode pc map entry for the stack check."
cogMethod cmType = CMMethod
ifTrue:
[isInBlock := false.
homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
map := self mapStartFor: homeMethod.
self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference
or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall
or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]).
latestContinuation := startbcpc.
aMethodObj := homeMethod methodObject.
+ endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1.
- endbcpc := (objectMemory byteSizeOf: aMethodObj) - 1.
bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader]
ifFalse:
[isInBlock := true.
homeMethod := cogMethod cmHomeMethod.
map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
inMethod: homeMethod.
self assert: map ~= 0.
self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial"
or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]).
[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
[map := map - 1].
map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header."
aMethodObj := homeMethod methodObject.
bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader).
bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
descriptor := self generatorAt: byte.
endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj].
bcpc := startbcpc.
mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
nExts := 0.
"The stack check maps to the start of the first bytecode,
the first bytecode being effectively after frame build."
result := self perform: functionSymbol
with: (self cCoerceSimple: mcpc to: #'char *')
with: startbcpc
with: arg.
result ~= 0 ifTrue:
[^result].
"Now skip up through the bytecode pc map entry for the stack check."
[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
[map := map - 1].
map := map - 1.
[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc"
[mapByte >= FirstAnnotation
ifTrue:
[| annotation nextBcpc |
annotation := mapByte >> AnnotationShift.
mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
(self isPCMappedAnnotation: annotation) ifTrue:
[[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
descriptor := self generatorAt: byte.
isInBlock
ifTrue: [bcpc >= endbcpc ifTrue: [^0]]
ifFalse:
[(descriptor isReturn and: [bcpc > latestContinuation]) ifTrue: [^0].
(descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
[| targetPC |
targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
latestContinuation := latestContinuation max: targetPC]].
nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
descriptor isMapped
or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
[bcpc := nextBcpc.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
"All subsequent bytecodes except backward branches map to the
following bytecode. Backward branches map to themselves other-
wise mapping could cause premature breaking out of loops."
result := self perform: functionSymbol
with: (self cCoerceSimple: mcpc to: #'char *')
with: ((descriptor isBranch
and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj])
ifTrue: [bcpc]
ifFalse: [bcpc + descriptor numBytes])
with: arg.
result ~= 0 ifTrue:
[^result].
bcpc := nextBcpc.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]]
ifFalse:
[mcpc := mcpc + (mapByte >= DisplacementX2N
ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
ifFalse: [mapByte])].
map := map - 1].
^0!
Item was changed:
----- Method: Cogit>>mapObjectReferencesInMachineCodeForBecome (in category 'garbage collection') -----
mapObjectReferencesInMachineCodeForBecome
"Update all references to objects in machine code for a become.
Unlike incrementalGC or fullGC a method that does not refer to young may
refer to young as a result of the become operation. Unlike incrementalGC
or fullGC the reference from a Cog method to its methodObject *must not*
change since the two are two halves of the same object."
| cogMethod hasYoungObj hasYoungObjPtr freedPIC |
<var: #cogMethod type: #'CogMethod *'>
hasYoungObj := false.
hasYoungObjPtr := self cCode: [(self addressOf: hasYoungObj) asInteger]
inSmalltalk: [CPluggableAccessor new
setObject: nil;
atBlock: [:obj :idx| hasYoungObj]
atPutBlock: [:obj :idx :val| hasYoungObj := val]].
codeModified := freedPIC := false.
self mapObjectReferencesInGeneratedRuntime.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[self assert: hasYoungObj not.
cogMethod cmType ~= CMFree ifTrue:
[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
cogMethod selector: (objectRepresentation remapOop: cogMethod selector)..
cogMethod cmType = CMClosedPIC
ifTrue:
[((objectMemory isYoung: cogMethod selector)
or: [self mapObjectReferencesInClosedPIC: cogMethod]) ifTrue:
[freedPIC := true.
methodZone freeMethod: cogMethod]]
ifFalse:
[(objectMemory isYoung: cogMethod selector) ifTrue:
[hasYoungObj := true].
cogMethod cmType = CMMethod ifTrue:
+ [| remappedMethod |
+ self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
- [self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
self assert: ((coInterpreter rawHeaderOf: cogMethod methodObject) = cogMethod asInteger
or: [(self noAssertMethodClassAssociationOf: cogMethod methodObject)
= objectMemory nilObject]).
+ remappedMethod := objectRepresentation remapOop: cogMethod methodObject.
+ remappedMethod ~= cogMethod methodObject ifTrue:
+ [(coInterpreter methodHasCogMethod: remappedMethod) ifTrue:
+ [self error: 'attempt to become two cogged methods'].
+ (objectMemory
+ withoutForwardingOn: cogMethod methodObject
+ and: remappedMethod
+ sendToCogit: #method:hasSameCodeAs:) ifFalse:
+ [self error: 'attempt to become cogged method into different method'].
+ coInterpreter
+ rawHeaderOf: cogMethod methodObject
+ put: cogMethod methodHeader.
+ cogMethod
+ methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
+ methodObject: remappedMethod.
+ coInterpreter
+ rawHeaderOf: remappedMethod
+ put: cogMethod asInteger].
(objectMemory isYoung: cogMethod methodObject) ifTrue:
[hasYoungObj := true]].
self mapFor: cogMethod
performUntil: (self cppIf: NewspeakVM
ifTrue: [#remapNSIfObjectRef:pc:hasYoung:]
ifFalse: [#remapIfObjectRef:pc:hasYoung:])
arg: hasYoungObjPtr.
hasYoungObj
ifTrue:
[cogMethod cmRefersToYoung ifFalse:
[cogMethod cmRefersToYoung: true.
methodZone addToYoungReferrers: cogMethod].
hasYoungObj := false]
ifFalse: [cogMethod cmRefersToYoung: false]]].
cogMethod := methodZone methodAfter: cogMethod].
methodZone pruneYoungReferrers.
freedPIC ifTrue:
[self unlinkSendsToFree.
codeModified := true].
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!
Item was added:
+ ----- Method: Cogit>>method:hasSameCodeAs: (in category 'garbage collection') -----
+ method: methodA hasSameCodeAs: methodB
+ "For the purposes of become: see if the two methods are similar, i.e. can be safely becommed.
+ This is pretty strict. All literals and bytecodes must be identical. Only trailer bytes and header
+ flags can differ."
+ <inline: false>
+ | headerA headerB numLitsA endPCA |
+ headerA := coInterpreter headerOf: methodA.
+ headerB := coInterpreter headerOf: methodB.
+ numLitsA := coInterpreter literalCountOfHeader: headerA.
+ endPCA := self endPCOf: methodA.
+ ((coInterpreter argumentCountOfMethodHeader: headerA) ~= (coInterpreter argumentCountOfMethodHeader: headerB)
+ or: [(coInterpreter temporaryCountOfMethodHeader: headerA) ~= (coInterpreter temporaryCountOfMethodHeader: headerB)
+ or: [(coInterpreter primitiveIndexOfMethod: methodA header: headerA) ~= (coInterpreter primitiveIndexOfMethod: methodB header: headerB)
+ or: [numLitsA ~= (coInterpreter literalCountOfHeader: headerB)
+ or: [endPCA > (objectMemory byteLengthOf: methodB)]]]]) ifTrue:
+ [^false].
+ 1 to: numLitsA - 1 do:
+ [:li|
+ (objectMemory fetchPointer: li ofObject: methodA) ~= (objectMemory fetchPointer: li ofObject: methodB) ifTrue:
+ [^false]].
+ (coInterpreter startPCOfMethod: methodA) to: endPCA do:
+ [:bi|
+ (objectMemory fetchByte: bi ofObject: methodA) ~= (objectMemory fetchByte: bi ofObject: methodB) ifTrue:
+ [^false]].
+ ^true!
Item was added:
+ ----- Method: Integer>>asLong (in category '*VMMaker-interpreter simulator') -----
+ asLong
+ ^self!
Item was added:
+ ----- Method: Interpreter>>flushAtCache (in category 'method lookup cache') -----
+ flushAtCache
+ "Flush the at cache. The method cache is flushed on every programming change and garbage collect."
+
+ 1 to: AtCacheTotalSize do: [ :i | atCache at: i put: 0 ]!
Item was changed:
----- Method: Interpreter>>primitiveBeCursor (in category 'I/O primitives') -----
primitiveBeCursor
"Set the cursor to the given shape. The Mac only supports 16x16 pixel cursors. Cursor offsets are handled by Smalltalk."
| cursorObj maskBitsIndex maskObj bitsObj extentX extentY depth offsetObj offsetX offsetY cursorBitsIndex ourCursor |
- self flag: #Dan. "This is disabled until we convert bitmaps appropriately"
- BytesPerWord = 8 ifTrue: [self pop: argumentCount. ^nil].
-
argumentCount = 0 ifTrue: [
cursorObj := self stackTop.
maskBitsIndex := nil].
argumentCount = 1 ifTrue: [
cursorObj := self stackValue: 1.
maskObj := self stackTop].
self success: (argumentCount < 2).
self success: ((self isPointers: cursorObj) and: [(self lengthOf: cursorObj) >= 5]).
successFlag ifTrue: [
bitsObj := self fetchPointer: 0 ofObject: cursorObj.
extentX := self fetchInteger: 1 ofObject: cursorObj.
extentY := self fetchInteger: 2 ofObject: cursorObj.
depth := self fetchInteger: 3 ofObject: cursorObj.
offsetObj := self fetchPointer: 4 ofObject: cursorObj].
self success: ((self isPointers: offsetObj) and: [(self lengthOf: offsetObj) >= 2]).
successFlag ifTrue: [
offsetX := self fetchInteger: 0 ofObject: offsetObj.
offsetY := self fetchInteger: 1 ofObject: offsetObj.
(argumentCount = 0 and: [depth = 32])
ifTrue: [
"Support arbitrary-sized 32 bit ARGB forms --bf 3/1/2007 23:51"
self success: ((extentX > 0) and: [extentY > 0]).
self success: ((offsetX >= (extentX * -1)) and: [offsetX <= 0]).
self success: ((offsetY >= (extentY * -1)) and: [offsetY <= 0]).
cursorBitsIndex := bitsObj + BaseHeaderSize.
self success: ((self isWords: bitsObj) and: [(self lengthOf: bitsObj) = (extentX * extentY)]).
self cCode: '' inSmalltalk:
[ourCursor := Cursor
extent: extentX @ extentY
depth: 32
fromArray: ((1 to: extentX * extentY) collect: [:i |
self fetchLong32: i-1 ofObject: bitsObj])
offset: offsetX @ offsetY]]
ifFalse: [
self success: ((extentX = 16) and: [extentY = 16 and: [depth = 1]]).
self success: ((offsetX >= -16) and: [offsetX <= 0]).
self success: ((offsetY >= -16) and: [offsetY <= 0]).
self success: ((self isWords: bitsObj) and: [(self lengthOf: bitsObj) = 16]).
cursorBitsIndex := bitsObj + BaseHeaderSize.
self cCode: '' inSmalltalk:
[ourCursor := Cursor
extent: extentX @ extentY
fromArray: ((1 to: 16) collect: [:i |
((self fetchLong32: i-1 ofObject: bitsObj) >> 16) bitAnd: 16rFFFF])
offset: offsetX @ offsetY]]].
argumentCount = 1 ifTrue: [
self success: ((self isPointers: maskObj) and: [(self lengthOf: maskObj) >= 5]).
successFlag ifTrue: [
bitsObj := self fetchPointer: 0 ofObject: maskObj.
extentX := self fetchInteger: 1 ofObject: maskObj.
extentY := self fetchInteger: 2 ofObject: maskObj.
depth := self fetchInteger: 3 ofObject: maskObj].
successFlag ifTrue: [
self success: ((extentX = 16) and: [extentY = 16 and: [depth = 1]]).
self success: ((self isWords: bitsObj) and: [(self lengthOf: bitsObj) = 16]).
maskBitsIndex := bitsObj + BaseHeaderSize]].
successFlag ifTrue: [
argumentCount = 0
ifTrue: [
depth = 32
ifTrue: [(self cCode: 'ioSetCursorARGB(cursorBitsIndex, extentX, extentY, offsetX, offsetY)'
inSmalltalk: [ourCursor show. Cursor currentCursor == ourCursor])
ifFalse: [^self success: false. ]]
ifFalse: [self cCode: 'ioSetCursor(cursorBitsIndex, offsetX, offsetY)'
inSmalltalk: [ourCursor show]]]
ifFalse: [self cCode: 'ioSetCursorWithMask(cursorBitsIndex, maskBitsIndex, offsetX, offsetY)'
inSmalltalk: [cursorBitsIndex == maskBitsIndex. "placate compiler"
ourCursor show]].
self pop: argumentCount]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveBeCursor (in category 'I/O primitives') -----
primitiveBeCursor
"Set the cursor to the given shape. The Mac only supports 16x16 pixel cursors. Cursor offsets are handled by Smalltalk."
| cursorObj maskBitsIndex maskObj bitsObj extentX extentY depth offsetObj offsetX offsetY cursorBitsIndex ourCursor |
- self flag: #Dan. "This is disabled until we convert bitmaps appropriately"
- BytesPerWord = 8 ifTrue: [self pop: argumentCount. ^nil].
-
argumentCount = 0 ifTrue: [
cursorObj := self stackTop.
maskBitsIndex := nil].
argumentCount = 1 ifTrue: [
cursorObj := self stackValue: 1.
maskObj := self stackTop].
self success: (argumentCount < 2).
self success: ((objectMemory isPointers: cursorObj) and: [(objectMemory lengthOf: cursorObj) >= 5]).
self successful ifTrue: [
bitsObj := objectMemory fetchPointer: 0 ofObject: cursorObj.
extentX := self fetchInteger: 1 ofObject: cursorObj.
extentY := self fetchInteger: 2 ofObject: cursorObj.
depth := self fetchInteger: 3 ofObject: cursorObj.
offsetObj := objectMemory fetchPointer: 4 ofObject: cursorObj].
self success: ((objectMemory isPointers: offsetObj) and: [(objectMemory lengthOf: offsetObj) >= 2]).
self successful ifTrue: [
offsetX := self fetchInteger: 0 ofObject: offsetObj.
offsetY := self fetchInteger: 1 ofObject: offsetObj.
(argumentCount = 0 and: [depth = 32])
ifTrue: [
"Support arbitrary-sized 32 bit ARGB forms --bf 3/1/2007 23:51"
self success: ((extentX > 0) and: [extentY > 0]).
self success: ((offsetX >= (extentX * -1)) and: [offsetX <= 0]).
self success: ((offsetY >= (extentY * -1)) and: [offsetY <= 0]).
self success: ((objectMemory isWords: bitsObj) and: [(objectMemory lengthOf: bitsObj) = (extentX * extentY)]).
cursorBitsIndex := bitsObj + BaseHeaderSize.
self cCode: '' inSmalltalk:
[ourCursor := Cursor
extent: extentX @ extentY
depth: 32
fromArray: ((1 to: extentX * extentY) collect: [:i |
objectMemory fetchLong32: i-1 ofObject: bitsObj])
offset: offsetX @ offsetY]]
ifFalse: [
self success: ((extentX = 16) and: [extentY = 16 and: [depth = 1]]).
self success: ((offsetX >= -16) and: [offsetX <= 0]).
self success: ((offsetY >= -16) and: [offsetY <= 0]).
self success: ((objectMemory isWords: bitsObj) and: [(objectMemory lengthOf: bitsObj) = 16]).
cursorBitsIndex := bitsObj + BaseHeaderSize.
self cCode: '' inSmalltalk:
[ourCursor := Cursor
extent: extentX @ extentY
fromArray: ((1 to: 16) collect: [:i |
((objectMemory fetchLong32: i-1 ofObject: bitsObj) >> (BytesPerWord*8 - 16)) bitAnd: 16rFFFF])
offset: offsetX @ offsetY]]].
argumentCount = 1 ifTrue: [
self success: ((objectMemory isPointers: maskObj) and: [(objectMemory lengthOf: maskObj) >= 5]).
self successful ifTrue: [
bitsObj := objectMemory fetchPointer: 0 ofObject: maskObj.
extentX := self fetchInteger: 1 ofObject: maskObj.
extentY := self fetchInteger: 2 ofObject: maskObj.
depth := self fetchInteger: 3 ofObject: maskObj].
self successful ifTrue: [
self success: ((extentX = 16) and: [extentY = 16 and: [depth = 1]]).
self success: ((objectMemory isWords: bitsObj) and: [(objectMemory lengthOf: bitsObj) = 16]).
maskBitsIndex := bitsObj + BaseHeaderSize]].
self successful ifTrue: [
argumentCount = 0
ifTrue: [
depth = 32
ifTrue: [(self cCode: 'ioSetCursorARGB(cursorBitsIndex, extentX, extentY, offsetX, offsetY)'
inSmalltalk: [ourCursor show. Cursor currentCursor == ourCursor])
ifFalse: [^self success: false]]
ifFalse: [self cCode: 'ioSetCursor(cursorBitsIndex, offsetX, offsetY)'
inSmalltalk: [ourCursor show]]]
ifFalse: [self cCode: 'ioSetCursorWithMask(cursorBitsIndex, maskBitsIndex, offsetX, offsetY)'
inSmalltalk: [cursorBitsIndex == maskBitsIndex. "placate compiler"
ourCursor show]].
self pop: argumentCount]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFindHandlerContext (in category 'control primitives') -----
primitiveFindHandlerContext
"Primitive. Search up the context stack for the next method context marked
for exception handling starting at the receiver. Return nil if none found"
+ self subclassResponsibility!
- | handlerOrNilOrZero |
- self externalWriteBackHeadFramePointers.
- handlerOrNilOrZero := self
- findMethodWithPrimitive: 199
- FromContext: self stackTop
- UpToContext: objectMemory nilObject.
- handlerOrNilOrZero = 0 ifTrue:
- [handlerOrNilOrZero := objectMemory nilObject].
- self pop: 1 thenPush: handlerOrNilOrZero!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFindNextUnwindContext (in category 'control primitives') -----
primitiveFindNextUnwindContext
"Primitive. Search up the context stack for the next method context marked for unwind
handling from the receiver up to but not including the argument. Return nil if none found."
+ self subclassResponsibility!
- | stopContext calleeContext handlerOrNilOrZero |
- <var: #theFP type: #'char *'>
- stopContext := self stackTop.
- calleeContext := self stackValue: 1.
- (stopContext = objectMemory nilObject or: [self isContext: stopContext]) ifFalse:
- [^self primitiveFail].
- self externalWriteBackHeadFramePointers.
- (self isStillMarriedContext: calleeContext)
- ifTrue:
- [| theFP |
- theFP := self frameOfMarriedContext: calleeContext.
- (self isBaseFrame: theFP)
- ifTrue:
- [handlerOrNilOrZero := self findMethodWithPrimitive: 198
- FromContext: (self frameCallerContext: theFP)
- UpToContext: stopContext]
- ifFalse:
- [handlerOrNilOrZero := self findMethodWithPrimitive: 198
- FromFP: (self frameCallerFP: theFP)
- UpToContext: stopContext]]
- ifFalse:
- [| startContext |
- startContext := objectMemory fetchPointer: SenderIndex ofObject: calleeContext.
- (self isContext: startContext)
- ifTrue:
- [handlerOrNilOrZero := self findMethodWithPrimitive: 198
- FromContext: startContext
- UpToContext: stopContext]
- ifFalse:
- [handlerOrNilOrZero := 0]].
- handlerOrNilOrZero = 0 ifTrue:
- [handlerOrNilOrZero := objectMemory nilObject].
- self pop: 2 thenPush: handlerOrNilOrZero!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') -----
primitiveFullGC
"Do a full garbage collection and return the number of bytes available (including swap space if dynamic memory management is supported)."
objectMemory fullGCLock > 0 ifTrue:
[^self primitiveFailFor: PrimErrInappropriate].
- self externalWriteBackHeadFramePointers.
objectMemory incrementalGC. "maximimize space for forwarding table"
objectMemory fullGC.
self pop: 1 thenPushInteger: (objectMemory bytesLeft: true).!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveIncrementalGC (in category 'memory space primitives') -----
primitiveIncrementalGC
"Do a quick, incremental garbage collection and return the number of bytes immediately available.
(Note: more space may be made available by doing a full garbage collection."
- self externalWriteBackHeadFramePointers.
objectMemory incrementalGC.
self pop: 1 thenPushInteger: (objectMemory bytesLeft: false)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveInstVarAt (in category 'object access primitives') -----
primitiveInstVarAt
| index rcvr hdr fmt totalLength fixedFields value |
index := self stackIntegerValue: 0.
rcvr := self stackValue: 1.
self successful ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
+ hdr := self baseHeader: rcvr.
- hdr := objectMemory baseHeader: rcvr.
fmt := objectMemory formatOfHeader: hdr.
+ totalLength := self lengthOf: rcvr baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: rcvr format: fmt length: totalLength.
- totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
- fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
(index >= 1 and: [index <= fixedFields]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
+ value := self subscript: rcvr with: index format: fmt.
- (fmt = 3
- and: [objectMemory isContextHeader: hdr])
- ifTrue: [value := self externalInstVar: index - 1 ofContext: rcvr]
- ifFalse: [value := self subscript: rcvr with: index format: fmt].
self pop: argumentCount + 1 thenPush: value!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveInstVarAtPut (in category 'object access primitives') -----
primitiveInstVarAtPut
| newValue index rcvr hdr fmt totalLength fixedFields |
newValue := self stackTop.
index := self stackIntegerValue: 1.
rcvr := self stackValue: 2.
self successful ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
hdr := objectMemory baseHeader: rcvr.
fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
(index >= 1 and: [index <= fixedFields]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
+ self subscript: rcvr with: index storing: newValue format: fmt.
- (fmt = 3
- and: [objectMemory isContextHeader: hdr])
- ifTrue: [self externalInstVar: index - 1 ofContext: rcvr put: newValue]
- ifFalse: [self subscript: rcvr with: index storing: newValue format: fmt].
self pop: argumentCount + 1 thenPush: newValue!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') -----
primitiveObjectPointsTo
+ | rcvr thang lastField |
- "This primitive is assumed to be fast (see e.g. MethodDictionary>>includesKey:) so make it so.
- N.B. Written to use literalHeaderOf: so that in Cog subclasses cogged methods (whose headers
- point to the machine code method) are still correctly scanned, for the header as well as literals."
- | rcvr thang header fmt lastField methodHeader |
thang := self stackTop.
rcvr := self stackValue: 1.
(objectMemory isIntegerObject: rcvr) ifTrue:
[^self pop: 2 thenPushBool: false].
+ lastField := self lastPointerOf: rcvr.
- "Inlined version of lastPointerOf: for speed in determining if rcvr is a context."
- header := objectMemory baseHeader: rcvr.
- fmt := objectMemory formatOfHeader: header.
- fmt <= 4
- ifTrue:
- [(fmt = 3
- and: [objectMemory isContextHeader: header])
- ifTrue:
- [(self isMarriedOrWidowedContext: rcvr) ifTrue:
- [self externalWriteBackHeadFramePointers.
- (self isStillMarriedContext: rcvr) ifTrue:
- [^self pop: 2
- thenPushBool: (self marriedContext: rcvr
- pointsTo: thang
- stackDeltaForCurrentFrame: 2)]].
- "contexts end at the stack pointer"
- lastField := CtxtTempFrameStart + (self fetchStackPointerOf: rcvr) * BytesPerWord]
- ifFalse:
- [lastField := (objectMemory sizeBitsOfSafe: rcvr) - BaseHeaderSize]]
- ifFalse:
- [fmt < 12 "no pointers" ifTrue:
- [^self pop: 2 thenPushBool: false].
- "CompiledMethod: contains both pointers and bytes:"
- methodHeader := self headerOf: rcvr.
- methodHeader = thang ifTrue: [^self pop: 2 thenPushBool: true].
- lastField := ((self literalCountOfHeader: methodHeader) + 1) * BytesPerWord].
-
BaseHeaderSize to: lastField by: BytesPerWord do:
[:i |
(self longAt: rcvr + i) = thang ifTrue:
[^self pop: 2 thenPushBool: true]].
self pop: 2 thenPushBool: false!
Item was removed:
- ----- Method: NewCoObjectMemory>>freeObject: (in category 'become') -----
- freeObject: obj
- self assert: ((self isCompiledMethod: obj) not or: [(self methodHasCogMethod: obj) not]).
- super freeObject: obj!
Item was added:
+ ----- Method: NewCoObjectMemory>>freeObject:header: (in category 'become') -----
+ freeObject: obj header: objHeader
+ (self isCompiledMethodHeader: objHeader) ifTrue:
+ [(self asserta: (coInterpreter methodHasCogMethod: obj) not) ifFalse:
+ [self error: 'attempt to free cogged method']].
+ super freeObject: obj header: objHeader!
Item was added:
+ ----- Method: NewCoObjectMemory>>restoreHeaderOf:to: (in category 'become') -----
+ restoreHeaderOf: obj to: objHeader
+ super restoreHeaderOf: obj to: objHeader.
+ (self isCompiledMethodHeader: objHeader) ifTrue:
+ [(self asserta: ((coInterpreter methodHasCogMethod: obj) not
+ or: [obj = (coInterpreter cogMethodOf: obj)])) ifFalse:
+ [self error: 'attempt to become cogged method']]!
Item was added:
+ ----- Method: NewCoObjectMemory>>withoutForwardingOn:and:sendToCogit: (in category 'cog jit support') -----
+ withoutForwardingOn: obj1 and: obj2 sendToCogit: selector
+ "For the purposes of become: send selector to the cogit with obj1 and obj2 and
+ answer the result. Undo forwarding for the selector, but redo forwarding after since
+ become:'s restoreHeadersAfter*Become* methods expect to be able to restore."
+ <api>
+ <var: #selector declareC: 'sqInt (*selector)(sqInt,sqInt)'>
+ | savedHeaderA savedHeaderB result |
+ savedHeaderA := self baseHeader: obj1.
+ self baseHeader: obj1 put: (self headerWhileForwardingOf: obj1).
+ savedHeaderB := self baseHeader: obj2.
+ self baseHeader: obj2 put: (self headerWhileForwardingOf: obj2).
+
+ result := cogit perform: selector with: obj1 with: obj2.
+
+ self baseHeader: obj1 put: savedHeaderA.
+ self baseHeader: obj2 put: savedHeaderB.
+ ^result!
Item was added:
+ ----- Method: NewObjectMemory>>freeObject:header: (in category 'become') -----
+ freeObject: obj header: objHeader
+ (self isContextHeader: objHeader) ifTrue:
+ [(self asserta: ((coInterpreter isStillMarriedContext: obj) not)) ifFalse:
+ [self error: 'attempt to free married context']].
+ super freeObject: obj header: objHeader!
Item was changed:
----- Method: NewObjectMemory>>freeStart (in category 'accessing') -----
freeStart
+ "This is a horribe hack and only works because C macros are generated after Interpreter variables."
+ <cmacro: '() freeStart'>
^freeStart!
Item was added:
+ ----- Method: NewObjectMemory>>restoreHeaderOf:to: (in category 'become') -----
+ restoreHeaderOf: obj to: objHeader
+ super restoreHeaderOf: obj to: objHeader.
+ (self isContextHeader: objHeader) ifTrue:
+ [(self asserta: ((coInterpreter isStillMarriedContext: obj) not)) ifFalse:
+ [self error: 'attempt to become married context']]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveBeCursor (in category 'I/O primitives') -----
primitiveBeCursor
"Set the cursor to the given shape. The Mac only supports 16x16 pixel cursors. Cursor offsets are handled by Smalltalk."
| cursorObj maskBitsIndex maskObj bitsObj extentX extentY depth offsetObj offsetX offsetY cursorBitsIndex ourCursor |
- self flag: #Dan. "This is disabled until we convert bitmaps appropriately"
- BytesPerWord = 8 ifTrue: [^ self pop: argumentCount].
-
argumentCount = 0 ifTrue: [
cursorObj := self stackTop.
maskBitsIndex := nil].
argumentCount = 1 ifTrue: [
cursorObj := self stackValue: 1.
maskObj := self stackTop].
self success: (argumentCount < 2).
self success: ((self isPointers: cursorObj) and: [(self lengthOf: cursorObj) >= 5]).
self successful ifTrue: [
bitsObj := self fetchPointer: 0 ofObject: cursorObj.
extentX := self fetchInteger: 1 ofObject: cursorObj.
extentY := self fetchInteger: 2 ofObject: cursorObj.
depth := self fetchInteger: 3 ofObject: cursorObj.
offsetObj := self fetchPointer: 4 ofObject: cursorObj].
self success: ((self isPointers: offsetObj) and: [(self lengthOf: offsetObj) >= 2]).
self successful ifTrue: [
offsetX := self fetchInteger: 0 ofObject: offsetObj.
offsetY := self fetchInteger: 1 ofObject: offsetObj.
self success: ((extentX = 16) and: [extentY = 16 and: [depth = 1]]).
self success: ((offsetX >= -16) and: [offsetX <= 0]).
self success: ((offsetY >= -16) and: [offsetY <= 0]).
self success: ((self isWords: bitsObj) and: [(self lengthOf: bitsObj) = 16]).
cursorBitsIndex := bitsObj + BaseHeaderSize.
self cCode: '' inSmalltalk:
[ourCursor := Cursor
extent: extentX @ extentY
fromArray: ((1 to: 16) collect: [:i |
((self fetchLong32: i-1 ofObject: bitsObj) >> (BytesPerWord*8 - 16)) bitAnd: 16rFFFF])
offset: offsetX @ offsetY]].
argumentCount = 1 ifTrue: [
self success: ((self isPointers: maskObj) and: [(self lengthOf: maskObj) >= 5]).
self successful ifTrue: [
bitsObj := self fetchPointer: 0 ofObject: maskObj.
extentX := self fetchInteger: 1 ofObject: maskObj.
extentY := self fetchInteger: 2 ofObject: maskObj.
depth := self fetchInteger: 3 ofObject: maskObj].
self successful ifTrue: [
self success: ((extentX = 16) and: [extentY = 16 and: [depth = 1]]).
self success: ((self isWords: bitsObj) and: [(self lengthOf: bitsObj) = 16]).
maskBitsIndex := bitsObj + BaseHeaderSize]].
self successful ifTrue: [
argumentCount = 0
ifTrue: [self cCode: 'ioSetCursor(cursorBitsIndex, offsetX, offsetY)'
inSmalltalk: [ourCursor show]]
ifFalse: [self cCode: 'ioSetCursorWithMask(cursorBitsIndex, maskBitsIndex, offsetX, offsetY)'
inSmalltalk: [ourCursor show]].
self pop: argumentCount].
!
Item was changed:
----- Method: ObjectMemory>>byteLengthOf: (in category 'indexing primitive support') -----
+ byteLengthOf: obj
+ "Return the number of indexable bytes in the given object.
+ This is basically a special copy of lengthOf: for BitBlt. But it is also
+ whoorishly used for the Cogit."
+ <api>
- byteLengthOf: oop
- "Return the number of indexable bytes in the given object. This is basically a special copy of lengthOf: for BitBlt."
| header sz fmt |
+ header := self baseHeader: obj.
- header := self baseHeader: oop.
sz := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
+ ifTrue: [(self sizeHeader: obj) bitAnd: AllButTypeMask]
- ifTrue: [(self sizeHeader: oop) bitAnd: AllButTypeMask]
ifFalse: [header bitAnd: SizeMask].
fmt := self formatOfHeader: header.
^fmt < 8
ifTrue: [(sz - BaseHeaderSize)] "words"
ifFalse: [(sz - BaseHeaderSize) - (fmt bitAnd: 3)] "bytes"!
Item was changed:
----- Method: ObjectMemory>>freeObject: (in category 'become') -----
freeObject: obj
+ | objHeader |
- | objHeader objHeaderBytes objHeaderType objSize |
objHeader := self baseHeader: obj.
+ self freeObject: obj header: objHeader!
- (self isYoungRootHeader: objHeader) ifTrue:
- [self removeYoungRoot: obj].
- objHeaderType := objHeader bitAnd: TypeMask.
- objHeaderBytes := headerTypeBytes at: objHeaderType.
- (objHeaderType bitAnd: 1) = 1 "HeaderTypeClass or HeaderTypeShort"
- ifTrue: [objSize := objHeader bitAnd: SizeMask]
- ifFalse:
- [objHeaderType = HeaderTypeFree
- ifTrue: [^nil]. "already free"
- objSize := (self sizeHeader: obj) bitAnd: LongSizeMask].
- self assert: (objSize + objHeaderBytes bitAnd: AllButTypeMask) = (objSize + objHeaderBytes).
- self longAt: obj - objHeaderBytes
- put: ((objSize + objHeaderBytes) bitOr: HeaderTypeFree)!
Item was added:
+ ----- Method: ObjectMemory>>freeObject:header: (in category 'become') -----
+ freeObject: obj header: objHeader
+ | objHeaderBytes objHeaderType objSize |
+ (self isYoungRootHeader: objHeader) ifTrue:
+ [self removeYoungRoot: obj].
+ objHeaderType := objHeader bitAnd: TypeMask.
+ objHeaderBytes := headerTypeBytes at: objHeaderType.
+ (objHeaderType bitAnd: 1) = 1 "HeaderTypeClass or HeaderTypeShort"
+ ifTrue: [objSize := objHeader bitAnd: SizeMask]
+ ifFalse:
+ [objHeaderType = HeaderTypeFree
+ ifTrue: [^nil]. "already free"
+ objSize := (self sizeHeader: obj) bitAnd: LongSizeMask].
+ self assert: (objSize + objHeaderBytes bitAnd: AllButTypeMask) = (objSize + objHeaderBytes).
+ self longAt: obj - objHeaderBytes
+ put: ((objSize + objHeaderBytes) bitOr: HeaderTypeFree)!
Item was changed:
----- Method: ObjectMemory>>restoreHeaderOf: (in category 'become') -----
+ restoreHeaderOf: obj
+ "Restore the original header of the given obj from its forwarding block."
+ <inline: true> "for subclasses"
+ | fwdHeader fwdBlock objHeader |
+ fwdHeader := self longAt: obj.
- restoreHeaderOf: oop
- "Restore the original header of the given oop from its
- forwarding block."
- | fwdHeader fwdBlock |
- fwdHeader := self longAt: oop.
fwdBlock := (fwdHeader bitAnd: AllButMarkBitAndTypeMask) << 1.
self assert: (fwdHeader bitAnd: MarkBit) ~= 0.
self assert: (self fwdBlockValid: fwdBlock).
+ objHeader := self longAt: fwdBlock + BytesPerWord.
+ self restoreHeaderOf: obj to: objHeader!
- self longAt: oop put: (self longAt: fwdBlock + BytesPerWord)!
Item was added:
+ ----- Method: ObjectMemory>>restoreHeaderOf:to: (in category 'become') -----
+ restoreHeaderOf: obj to: objHeader
+ "helper for restoreHeaderOf: for subclasses to override"
+ <inline: true> "for subclasses"
+ self longAt: obj put: objHeader!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>compileCogMethod: (in category 'compile abstract instructions') -----
compileCogMethod: selector
<returnTypeC: #'CogMethod *'>
| numBytecodes numBlocks result extra |
self cCode: '' inSmalltalk:
[debugStackPointers := coInterpreter debugStackPointersFor: methodObj].
hasYoungReferent := (objectMemory isYoung: methodObj)
or: [objectMemory isYoung: selector].
methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
methodOrBlockNumTemps := coInterpreter tempCountOf: methodObj.
inBlock := false.
primInvokeLabel := nil.
postCompileHook := nil.
extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
ifTrue: [30]
ifFalse: [10].
initialPC := coInterpreter startPCOfMethod: methodObj.
"initial estimate. Actual endPC is determined in scanMethod."
endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
ifTrue: [initialPC - 1]
+ ifFalse: [objectMemory byteLengthOf: methodObj].
- ifFalse: [objectMemory byteSizeOf: methodObj].
numBytecodes := endPC - initialPC + 1.
self allocateOpcodes: (numBytecodes + extra) * 10 bytecodes: numBytecodes.
(numBlocks := self scanMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
self allocateBlockStarts: numBlocks.
self allocateCounters; initializeCounters.
blockEntryLabel := nil.
methodLabel dependent: nil.
(result := self compileEntireMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
^self generateCogMethod: selector!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') -----
mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg
"Machine-code <-> bytecode pc mapping support. Evaluate functionSymbol
for each mcpc, bcpc pair in the map until the function returns non-zero,
answering that result, or 0 if it fails to. This works only for frameful methods.
Override to add the descriptor as the first argument to function."
<var: #cogMethod type: #'CogBlockMethod *'>
<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor * desc, char *mcpc, sqInt bcpc, void *arg)'>
<var: #arg type: #'void *'>
| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
latestContinuation byte descriptor bsOffset nExts |
<var: #descriptor type: #'BytecodeDescriptor *'>
<var: #homeMethod type: #'CogMethod *'>
self assert: cogMethod stackCheckOffset > 0.
"In both CMMethod and CMBlock cases find the start of the map and
skip forward to the bytecode pc map entry for the stack check."
cogMethod cmType = CMMethod
ifTrue:
[isInBlock := false.
homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
map := self mapStartFor: homeMethod.
self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference
or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall
or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]).
latestContinuation := startbcpc.
aMethodObj := homeMethod methodObject.
+ endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1.
- endbcpc := (objectMemory byteSizeOf: aMethodObj) - 1.
bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader]
ifFalse:
[isInBlock := true.
homeMethod := cogMethod cmHomeMethod.
map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
inMethod: homeMethod.
self assert: map ~= 0.
self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial"
or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]).
[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
[map := map - 1].
map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header."
aMethodObj := homeMethod methodObject.
bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader).
bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
descriptor := self generatorAt: byte.
endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj].
bcpc := startbcpc.
mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
nExts := 0.
"as a hack for collecting counters, remember the prev mcpc in a static variable."
prevMapAbsPCMcpc := 0.
"The stack check maps to the start of the first bytecode,
the first bytecode being effectively after frame build."
result := self perform: functionSymbol
with: nil
with: (self cCoerceSimple: mcpc to: #'char *')
with: startbcpc
with: arg.
result ~= 0 ifTrue:
[^result].
"Now skip up through the bytecode pc map entry for the stack check."
[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
[map := map - 1].
map := map - 1.
[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc"
[mapByte >= FirstAnnotation
ifTrue:
[| annotation nextBcpc |
annotation := mapByte >> AnnotationShift.
mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
(self isPCMappedAnnotation: annotation) ifTrue:
[[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
descriptor := self generatorAt: byte.
isInBlock
ifTrue: [bcpc >= endbcpc ifTrue: [^0]]
ifFalse:
[(descriptor isReturn and: [bcpc > latestContinuation]) ifTrue: [^0].
(descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
[| targetPC |
targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
latestContinuation := latestContinuation max: targetPC]].
nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
descriptor isMapped
or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
[bcpc := nextBcpc.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
"All subsequent bytecodes except backward branches map to the
following bytecode. Backward branches map to themselves other-
wise mapping could cause premature breaking out of loops."
result := self perform: functionSymbol
with: descriptor
with: (self cCoerceSimple: mcpc to: #'char *')
with: ((self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj)
ifTrue: [bcpc]
ifFalse: [bcpc + descriptor numBytes])
with: arg.
result ~= 0 ifTrue:
[^result].
bcpc := nextBcpc].
annotation = IsAbsPCReference ifTrue:
[prevMapAbsPCMcpc := mcpc]]
ifFalse:
[mcpc := mcpc + (mapByte >= DisplacementX2N
ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
ifFalse: [mapByte])].
map := map - 1].
^0!
Item was changed:
----- Method: StackInterpreter>>instVar:ofContext:put: (in category 'frame access') -----
instVar: index ofContext: aMarriedContext put: anOop
| theFP |
"Assign the field of a married context. The important case to optimize is
assigning the sender. We could also consider optimizing assiging the IP but
typically that is followed by an assignment to the stack pointer and we can't
efficiently assign the stack pointer because it involves moving frames around."
<inline: true>
self assert: (self isMarriedOrWidowedContext: aMarriedContext).
self writeBackHeadFramePointers.
(self isStillMarriedContext: aMarriedContext) ifFalse:
[objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop.
index = StackPointerIndex ifTrue:
[self ensureContextIsExecutionSafeAfterAssignToStackPointer: aMarriedContext].
^nil].
theFP := self frameOfMarriedContext: aMarriedContext.
index == SenderIndex ifTrue:
[| thePage onCurrentPage |
thePage := stackPages stackPageFor: theFP.
self assert: stackPage = stackPages mostRecentlyUsedPage.
onCurrentPage := thePage = stackPage.
self storeSenderOfFrame: theFP withValue: anOop.
onCurrentPage
ifTrue:
[localFP := stackPage headFP.
localSP := stackPage headSP]
ifFalse:
[stackPages markStackPageMostRecentlyUsed: stackPage].
^nil].
self externalizeIPandSP.
self externalDivorceFrame: theFP andContext: aMarriedContext.
+ objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop.
- objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop..
index = StackPointerIndex ifTrue:
[self ensureContextIsExecutionSafeAfterAssignToStackPointer: aMarriedContext].
+ self internalizeIPandSP.
+ "Assigning various fields can force a divorce which can change the stackPage."
+ stackPages markStackPageMostRecentlyUsed: stackPage.
+ self assertValidExecutionPointe: localIP asUnsignedInteger r: localFP s: localSP imbar: true!
- self internalizeIPandSP!
Item was changed:
----- Method: StackInterpreter>>printFrameAndCallers:SP:short: (in category 'debug printing') -----
printFrameAndCallers: theFP SP: theSP short: printShort
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
(stackPages couldBeFramePointer: theFP) ifFalse: [^nil].
(self isBaseFrame: theFP) ifFalse:
[self printFrameAndCallers: (self frameCallerFP: theFP)
SP: (self frameCallerSP: theFP)
short: printShort].
+ printShort ifTrue:
+ [self shortPrintFrame: theFP.
+ ^nil].
self cr.
+ self printFrame: theFP WithSP: theSP!
- printShort
- ifTrue: [self shortPrintFrame: theFP]
- ifFalse: [self printFrame: theFP WithSP: theSP]!
Item was changed:
----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') -----
shortPrintOop: oop
<inline: false>
+ self printHex: oop.
- self printNum: oop.
(objectMemory isIntegerObject: oop) ifTrue:
[^self cCode: 'printf("=%ld\n", (long)integerValueOf(oop))' inSmalltalk: [self print: (self shortPrint: oop); cr]].
(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
[self printHex: oop; print: ' is not on the heap'; cr.
^nil].
(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
[self printHex: oop; print: ' is misaligned'; cr.
^nil].
self print: ': a(n) '.
self printNameOfClass: (objectMemory fetchClassOf: oop) count: 5.
self cr!
Item was changed:
----- Method: StackInterpreter>>temporaryCountOfMethodHeader: (in category 'compiled methods') -----
temporaryCountOfMethodHeader: header
+ <api>
<inline: true>
^(header >> 19) bitAnd: 16r3F!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveFindHandlerContext (in category 'control primitives') -----
+ primitiveFindHandlerContext
+ "Primitive. Search up the context stack for the next method context marked
+ for exception handling starting at the receiver. Return nil if none found"
+ | handlerOrNilOrZero |
+ self externalWriteBackHeadFramePointers.
+ handlerOrNilOrZero := self
+ findMethodWithPrimitive: 199
+ FromContext: self stackTop
+ UpToContext: objectMemory nilObject.
+ handlerOrNilOrZero = 0 ifTrue:
+ [handlerOrNilOrZero := objectMemory nilObject].
+ self pop: 1 thenPush: handlerOrNilOrZero!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveFindNextUnwindContext (in category 'control primitives') -----
+ primitiveFindNextUnwindContext
+ "Primitive. Search up the context stack for the next method context marked for unwind
+ handling from the receiver up to but not including the argument. Return nil if none found."
+ | stopContext calleeContext handlerOrNilOrZero |
+ <var: #theFP type: #'char *'>
+ stopContext := self stackTop.
+ calleeContext := self stackValue: 1.
+ (stopContext = objectMemory nilObject or: [self isContext: stopContext]) ifFalse:
+ [^self primitiveFail].
+ self externalWriteBackHeadFramePointers.
+ (self isStillMarriedContext: calleeContext)
+ ifTrue:
+ [| theFP |
+ theFP := self frameOfMarriedContext: calleeContext.
+ (self isBaseFrame: theFP)
+ ifTrue:
+ [handlerOrNilOrZero := self findMethodWithPrimitive: 198
+ FromContext: (self frameCallerContext: theFP)
+ UpToContext: stopContext]
+ ifFalse:
+ [handlerOrNilOrZero := self findMethodWithPrimitive: 198
+ FromFP: (self frameCallerFP: theFP)
+ UpToContext: stopContext]]
+ ifFalse:
+ [| startContext |
+ startContext := objectMemory fetchPointer: SenderIndex ofObject: calleeContext.
+ (self isContext: startContext)
+ ifTrue:
+ [handlerOrNilOrZero := self findMethodWithPrimitive: 198
+ FromContext: startContext
+ UpToContext: stopContext]
+ ifFalse:
+ [handlerOrNilOrZero := 0]].
+ handlerOrNilOrZero = 0 ifTrue:
+ [handlerOrNilOrZero := objectMemory nilObject].
+ self pop: 2 thenPush: handlerOrNilOrZero!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') -----
+ primitiveFullGC
+ "Do a full garbage collection and return the number of bytes available (including swap space if dynamic memory management is supported)."
+
+ objectMemory fullGCLock > 0 ifTrue:
+ [^self primitiveFailFor: PrimErrInappropriate].
+ self externalWriteBackHeadFramePointers.
+ objectMemory incrementalGC. "maximimize space for forwarding table"
+ objectMemory fullGC.
+ self pop: 1 thenPushInteger: (objectMemory bytesLeft: true).!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveIncrementalGC (in category 'memory space primitives') -----
+ primitiveIncrementalGC
+ "Do a quick, incremental garbage collection and return the number of bytes immediately available.
+ (Note: more space may be made available by doing a full garbage collection."
+
+ self externalWriteBackHeadFramePointers.
+ objectMemory incrementalGC.
+ self pop: 1 thenPushInteger: (objectMemory bytesLeft: false)!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveInstVarAt (in category 'object access primitives') -----
+ primitiveInstVarAt
+ | index rcvr hdr fmt totalLength fixedFields value |
+ index := self stackIntegerValue: 0.
+ rcvr := self stackValue: 1.
+ self successful ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ hdr := objectMemory baseHeader: rcvr.
+ fmt := objectMemory formatOfHeader: hdr.
+ totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
+ fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
+ (index >= 1 and: [index <= fixedFields]) ifFalse:
+ [^self primitiveFailFor: PrimErrBadIndex].
+ (fmt = 3
+ and: [objectMemory isContextHeader: hdr])
+ ifTrue: [value := self externalInstVar: index - 1 ofContext: rcvr]
+ ifFalse: [value := self subscript: rcvr with: index format: fmt].
+ self pop: argumentCount + 1 thenPush: value!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveInstVarAtPut (in category 'object access primitives') -----
+ primitiveInstVarAtPut
+ | newValue index rcvr hdr fmt totalLength fixedFields |
+ newValue := self stackTop.
+ index := self stackIntegerValue: 1.
+ rcvr := self stackValue: 2.
+ self successful ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ hdr := objectMemory baseHeader: rcvr.
+ fmt := objectMemory formatOfHeader: hdr.
+ totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
+ fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
+ (index >= 1 and: [index <= fixedFields]) ifFalse:
+ [^self primitiveFailFor: PrimErrBadIndex].
+ (fmt = 3
+ and: [objectMemory isContextHeader: hdr])
+ ifTrue: [self externalInstVar: index - 1 ofContext: rcvr put: newValue]
+ ifFalse: [self subscript: rcvr with: index storing: newValue format: fmt].
+ self pop: argumentCount + 1 thenPush: newValue!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') -----
+ primitiveObjectPointsTo
+ "This primitive is assumed to be fast (see e.g. MethodDictionary>>includesKey:) so make it so.
+ N.B. Written to use literalHeaderOf: so that in Cog subclasses cogged methods (whose headers
+ point to the machine code method) are still correctly scanned, for the header as well as literals."
+ | rcvr thang header fmt lastField methodHeader |
+ thang := self stackTop.
+ rcvr := self stackValue: 1.
+ (objectMemory isIntegerObject: rcvr) ifTrue:
+ [^self pop: 2 thenPushBool: false].
+
+ "Inlined version of lastPointerOf: for speed in determining if rcvr is a context."
+ header := objectMemory baseHeader: rcvr.
+ fmt := objectMemory formatOfHeader: header.
+ fmt <= 4
+ ifTrue:
+ [(fmt = 3
+ and: [objectMemory isContextHeader: header])
+ ifTrue:
+ [(self isMarriedOrWidowedContext: rcvr) ifTrue:
+ [self externalWriteBackHeadFramePointers.
+ (self isStillMarriedContext: rcvr) ifTrue:
+ [^self pop: 2
+ thenPushBool: (self marriedContext: rcvr
+ pointsTo: thang
+ stackDeltaForCurrentFrame: 2)]].
+ "contexts end at the stack pointer"
+ lastField := CtxtTempFrameStart + (self fetchStackPointerOf: rcvr) * BytesPerWord]
+ ifFalse:
+ [lastField := (objectMemory sizeBitsOfSafe: rcvr) - BaseHeaderSize]]
+ ifFalse:
+ [fmt < 12 "no pointers" ifTrue:
+ [^self pop: 2 thenPushBool: false].
+ "CompiledMethod: contains both pointers and bytes:"
+ methodHeader := self headerOf: rcvr.
+ methodHeader = thang ifTrue: [^self pop: 2 thenPushBool: true].
+ lastField := ((self literalCountOfHeader: methodHeader) + 1) * BytesPerWord].
+
+ BaseHeaderSize to: lastField by: BytesPerWord do:
+ [:i |
+ (self longAt: rcvr + i) = thang ifTrue:
+ [^self pop: 2 thenPushBool: true]].
+ self pop: 2 thenPushBool: false!
Item was changed:
StackInterpreterPrimitives subclass: #StackInterpreterSimulator
instanceVariableNames: 'byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-InterpreterSimulation'!
+ !StackInterpreterSimulator commentStamp: 'eem 2/13/2013 15:23' prior: 0!
- !StackInterpreterSimulator commentStamp: '<historical>' prior: 0!
This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.
To see the thing actually run, you could (after backing up this image and changes), execute
(StackInterpreterSimulator new openOn: Smalltalk imageName) test
+ and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image.
+
+ Here's an example of what Eliot uses to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff:
+
+ | vm |
+ StackInterpreter initializeWithOptions: (Dictionary newFromPairs: #()).
+ vm := StackInterpreterSimulator new.
+ vm openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'.
+ vm setBreakSelector: #&.
+ vm openAsMorph; run!
- and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image. You will probably have more luck using InterpreteSimulatorLSB or InterpreterSimulatorMSB as befits your machine.!
Item was changed:
----- Method: TMethod>>checkForCompleteness:in: (in category 'inlining') -----
checkForCompleteness: stmtLists in: aCodeGen
"Set the complete flag if none of the given statement list nodes contains further candidates for inlining."
complete := true.
stmtLists do:
[ :stmtList |
stmtList statements do:
[ :node |
[(self inlineableSend: node in: aCodeGen) ifTrue:
[complete := false. "more inlining to do"
^self]]]].
parseTree
nodesDo:
[ :n |
(self inlineableFunctionCall: n in: aCodeGen) ifTrue:
[complete := false. "more inlining to do"
^self]]
unless:
+ [ :n | n isSend and: [#(cCode:inSmalltalk: assert: asserta:) includes: n selector]]!
- [ :n | n isSend and: [#(cCode:inSmalltalk: assert:) includes: n selector]]!
Item was changed:
----- Method: TMethod>>statementsListsForInlining (in category 'inlining') -----
statementsListsForInlining
"Answer a collection of statement list nodes that are candidates for inlining.
Currently, we cannot inline into the argument blocks of and: and or: messages.
We do not want to inline code strings within cCode:inSmalltalk: blocks (those with a
proper block for the cCode: argument are inlined in MessageNode>>asTranslatorNodeIn:).
We do not want to inline code within assert: sends (because we want the assert to read nicely)."
| stmtLists |
stmtLists := OrderedCollection new: 10.
parseTree
nodesDo:
[ :node |
node isStmtList ifTrue: [ stmtLists add: node ]]
unless:
[ :node |
+ node isSend and: [#(cCode:inSmalltalk: assert: asserta:) includes: node selector]].
- node isSend and: [#(cCode:inSmalltalk: assert:) includes: node selector]].
parseTree nodesDo:
[ :node |
node isSend ifTrue:
[node selector = #cCode:inSmalltalk: ifTrue:
[node nodesDo:
[:inStNode| stmtLists remove: inStNode ifAbsent: []]].
node selector = #cppIf:ifTrue:ifFalse: ifTrue:
[node args first nodesDo:
[:inCondNode| stmtLists remove: inCondNode ifAbsent: []]].
((node selector = #and:) or: [node selector = #or:]) ifTrue:
"Note: the PP 2.3 compiler produces two arg nodes for these selectors"
[stmtLists remove: node args first ifAbsent: [].
stmtLists remove: node args last ifAbsent: []].
(#( #ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue:
#ifNil: #ifNotNil: #ifNil:ifNotNil: #ifNotNil:ifNil: ) includes: node selector) ifTrue:
[stmtLists remove: node receiver ifAbsent: []].
(#(whileTrue whileTrue: whilefalse whileFalse:) includes: node selector) ifTrue:
"Allow inlining if it is a [...] whileTrue/whileFalse.
This is identified by having more than one statement in the
receiver block in which case the C code wouldn't work anyways"
[node receiver statements size = 1 ifTrue:
[stmtLists remove: node receiver ifAbsent: []]].
(node selector = #to:do:) ifTrue:
[stmtLists remove: node receiver ifAbsent: [].
stmtLists remove: node args first ifAbsent: []].
(node selector = #to:by:do:) ifTrue:
[stmtLists remove: node receiver ifAbsent: [].
stmtLists remove: node args first ifAbsent: [].
stmtLists remove: node args second ifAbsent: []]].
node isCaseStmt ifTrue: "don't inline cases"
[node cases do: [: case | stmtLists remove: case ifAbsent: []]]].
^stmtLists!
Item was changed:
----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') -----
tryToInlineMethodsIn: aCodeGen
"Expand any (complete) inline methods called by this method. Set the complete bit when all inlining has been done. Return true if something was inlined."
| stmtLists didSomething newStatements sendsToInline |
self definedAsMacro ifTrue:
[complete := true.
^false].
didSomething := false.
sendsToInline := Dictionary new: 100.
parseTree
nodesDo:
[ :n |
(self inlineableFunctionCall: n in: aCodeGen) ifTrue:
[sendsToInline at: n put: (self inlineFunctionCall: n in: aCodeGen)]]
unless: "Don't inline the arguments to asserts to keep the asserts readable"
+ [:n| n isSend and: [#(cCode:inSmalltalk: assert: asserta:) includes: n selector]].
- [:n| n isSend and: [#(cCode:inSmalltalk: assert:) includes: n selector]].
sendsToInline isEmpty ifFalse:
[didSomething := true.
parseTree := parseTree replaceNodesIn: sendsToInline].
didSomething ifTrue:
[writtenToGlobalVarsCache := nil.
^didSomething].
stmtLists := self statementsListsForInlining.
stmtLists do:
[ :stmtList |
newStatements := OrderedCollection new: 100.
stmtList statements do:
[ :stmt |
(self inlineCodeOrNilForStatement: stmt in: aCodeGen)
ifNil: [newStatements addLast: stmt]
ifNotNil: [:inlinedStmts|
didSomething := true.
newStatements addAllLast: inlinedStmts]].
stmtList setStatements: newStatements asArray].
didSomething ifTrue:
[writtenToGlobalVarsCache := nil.
^didSomething].
complete ifFalse:
[self checkForCompleteness: stmtLists in: aCodeGen.
complete ifTrue: [ didSomething := true ]]. "marking a method complete is progress"
^didSomething!
Item was changed:
----- Method: VMMaker class>>generateSqueakCogVM (in category 'configurations') -----
generateSqueakCogVM
^VMMaker
generate: (Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^self]]
value: #(CoInterpreter CoInterpreterMT)))
and: StackToRegisterMappingCogit
with: #( MULTIPLEBYTECODESETS false
NewspeakVM false)
to: (FileDirectory default pathFromURI: 'oscogvm/src')
platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms')
+ including:#( AioPlugin ADPCMCodecPlugin AsynchFilePlugin BalloonEnginePlugin B3DAcceleratorPlugin
- including:#( ADPCMCodecPlugin AsynchFilePlugin BalloonEnginePlugin B3DAcceleratorPlugin
BMPReadWriterPlugin BitBltSimulation BochsIA32Plugin CroquetPlugin DSAPlugin
DeflatePlugin DropPlugin FT2Plugin FFTPlugin FileCopyPlugin FilePlugin FloatArrayPlugin
FloatMathPlugin GeniePlugin HostWindowPlugin IA32ABIPlugin InternetConfigPlugin
JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin
LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin
MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin SecurityPlugin SerialPlugin
SocketPlugin SoundCodecPlugin SoundGenerationPlugin SoundPlugin ThreadedIA32FFIPlugin
StarSqueakPlugin UUIDPlugin UnixOSProcessPlugin Win32OSProcessPlugin VMProfileMacSupportPlugin)!
More information about the Vm-dev
mailing list