From 6b9c9b6c6cf1f77c8e2f7ecc8ac030d35bc2f9fd Mon Sep 17 00:00:00 2001 From: palumbon Date: Wed, 2 Apr 2025 16:37:41 +0200 Subject: [PATCH 1/3] Generate simple cogit script --- smalltalksrc/VMMaker/PharoVMMaker.class.st | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/smalltalksrc/VMMaker/PharoVMMaker.class.st b/smalltalksrc/VMMaker/PharoVMMaker.class.st index 4ff021cb16..212b29f5f9 100644 --- a/smalltalksrc/VMMaker/PharoVMMaker.class.st +++ b/smalltalksrc/VMMaker/PharoVMMaker.class.st @@ -170,6 +170,14 @@ PharoVMMaker >> generatePlugins: anObject [ generatePlugins := anObject ] +{ #category : 'generation' } +PharoVMMaker >> generateSimple [ + + self generates64Bits ifTrue: [ self generate: CoInterpreter memoryManager: Spur64BitCoMemoryManager compilerClass: SimpleStackBasedCogit ]. + self generates32Bits ifTrue: [ self generate: CoInterpreter memoryManager: Spur32BitCoMemoryManager compilerClass: SimpleStackBasedCogit ]. + +] + { #category : 'generation' } PharoVMMaker >> generateStackVM [ From ddc96470ff3f5d42d8f165cca0b7ba0cbcfaf6de Mon Sep 17 00:00:00 2001 From: palumbon Date: Wed, 2 Apr 2025 17:15:07 +0200 Subject: [PATCH 2/3] Pushing up mustBeGlobalInFile: to SimpleCogit --- smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st | 6 ++++++ smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st | 6 ------ 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st index 4a67d877e5..31a60ff1ff 100644 --- a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st +++ b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st @@ -189,6 +189,12 @@ SimpleStackBasedCogit class >> initializeBytecodeTableForSistaV1 [ (3 254 255 unknownBytecode)) ] +{ #category : 'translation' } +SimpleStackBasedCogit class >> mustBeGlobalInFile: var [ + + ^ #( #aMethodLabel #generatorTable ) includes: var +] + { #category : 'class initialization' } SimpleStackBasedCogit class >> table: primArray from: specArray [ "Fill in the specified entries in the primitive table." diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index b26eeef1b1..75478405be 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -433,12 +433,6 @@ StackToRegisterMappingCogit class >> mustBeGlobalAndExport: var [ var ] ] -{ #category : 'translation' } -StackToRegisterMappingCogit class >> mustBeGlobalInFile: var [ - - ^ #( #aMethodLabel #generatorTable ) includes: var -] - { #category : 'accessing' } StackToRegisterMappingCogit class >> numPushNilsFunction [ "Answer the value of numPushNilsFunction" From 6004f99748a46568bd2e3d0254265aa5fbd14cd8 Mon Sep 17 00:00:00 2001 From: palumbon Date: Wed, 2 Apr 2025 18:29:27 +0200 Subject: [PATCH 3/3] Pushing up profiling data methods to SimpleStackCogit --- .../VMMaker/SimpleStackBasedCogit.class.st | 178 +++++++++++++++++- .../StackToRegisterMappingCogit.class.st | 178 +----------------- 2 files changed, 178 insertions(+), 178 deletions(-) diff --git a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st index 31a60ff1ff..ed1e21e4ad 100644 --- a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st +++ b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st @@ -12,7 +12,8 @@ Class { 'externalPrimJumpOffsets', 'externalSetPrimOffsets', 'introspectionDataIndex', - 'introspectionData' + 'introspectionData', + 'counterIndex' ], #pools : [ 'VMClassIndices', @@ -3013,6 +3014,35 @@ SimpleStackBasedCogit >> picAbortTrampolineFor: numArgs [ ^cePICAbortTrampoline ] +{ #category : 'method introspection' } +SimpleStackBasedCogit >> populate: tuple withPICInfoFor: cPIC firstCacheTag: firstCacheTag [ + "Populate tuple (which must be large enough) with the ClosedPIC's target method class pairs. + The first entry in tuple contains the bytecode pc for the send, so skip the tuple's first field." + + | picCaseMachineCodePC cacheTag classOop entryPoint targetMethod value | + + + 1 to: cPIC cPICNumCases do: [:i| + picCaseMachineCodePC := self addressOfEndOfCase: i inCPIC: cPIC. + cacheTag := i = 1 + ifTrue: [firstCacheTag] + ifFalse: [backEnd literalBeforeFollowingAddress: picCaseMachineCodePC - backEnd jumpLongConditionalByteSize]. + + classOop := objectRepresentation classForInlineCacheTag: cacheTag. + objectMemory storePointer: i * 2 - 1 ofObject: tuple withValue: classOop. + entryPoint := i = 1 + ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: picCaseMachineCodePC] + ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: picCaseMachineCodePC]. + "Find target from jump. A jump to the MNU entry-point should collect #doesNotUnderstand:" + (cPIC containsAddress: entryPoint) + ifTrue: [ value := objectMemory splObj: SelectorDoesNotUnderstand ] + ifFalse: [ + targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'. + self assert: targetMethod cmType = CMMethod. + value := targetMethod methodObject ]. + objectMemory storePointer: i * 2 ofObject: tuple withValue: value ] +] + { #category : 'primitive generators' } SimpleStackBasedCogit >> primitiveDescriptor [ "If there is a generator for the current primitive then answer it; @@ -3071,6 +3101,152 @@ SimpleStackBasedCogit >> primitivePropertyFlags: primIndex primitiveDescriptor: ^baseFlags ] +{ #category : 'method introspection' } +SimpleStackBasedCogit >> profilingDataFor: descriptor Annotation: isBackwardBranchAndAnnotation Mcpc: mcpc Bcpc: bcpc Method: cogMethodArg [ + + + + + | annotation entryPoint tuple counter | + "N.B. Counters are always 32-bits, having two 16-bit halves for the reached and taken counts." + + + descriptor ifNil: + [^0]. + descriptor isBranch ifTrue: + ["it's a branch; conditional?" + (descriptor isBranchTrue or: [descriptor isBranchFalse]) ifTrue: [ | counters | + counters := self + cCoerce: ((self + cCoerceSimple: cogMethodArg + to: #'CogMethod *') counters) + to: #'usqInt *'. + "If no counters are available, do not record counters" + counters = 0 ifTrue: [ ^ 0 ]. + + counter := counters at: counterIndex. + tuple := self profilingDataForCounter: counter at: bcpc + 1. + tuple = 0 ifTrue: [^PrimErrNoMemory]. + objectMemory + storePointer: introspectionDataIndex + ofObject: introspectionData + withValue: tuple. + introspectionDataIndex := introspectionDataIndex + 1. + counterIndex := counterIndex + 1]. + ^0]. + + annotation := isBackwardBranchAndAnnotation >> 1. + ((self isPureSendAnnotation: annotation) + and: [entryPoint := backEnd callTargetFromReturnAddress: mcpc asUnsignedInteger. + entryPoint > methodZoneBase]) ifFalse: "send is not linked, or is not a send" + [^0]. + + "It's a linked send; find which kind." + self targetMethodAndSendTableFor: entryPoint + annotation: annotation + into: [:targetCogCode :sendTable| | methodClassIfSuper association | + methodClassIfSuper := nil. + sendTable = superSendTrampolines ifTrue: [ + methodClassIfSuper := coInterpreter methodClassOf: (self cCoerceSimple: cogMethodArg to: #'CogMethod *') methodObject. + ]. + sendTable = directedSuperSendTrampolines ifTrue: [ + association := backEnd literalBeforeInlineCacheTagAt: mcpc asUnsignedInteger. + methodClassIfSuper := objectRepresentation valueOfAssociation: association ]. + tuple := self profilingDataForSendTo: targetCogCode + methodClassIfSuper: methodClassIfSuper + at: mcpc + bcpc: bcpc + 1]. + + tuple = 0 ifTrue: [^PrimErrNoMemory]. + objectMemory + storePointer: introspectionDataIndex + ofObject: introspectionData + withValue: tuple. + introspectionDataIndex := introspectionDataIndex + 1. + ^0 +] + +{ #category : 'method introspection' } +SimpleStackBasedCogit >> profilingDataFor: cogMethod into: arrayObj [ + + "Collect the branch and send data for cogMethod, storing it into arrayObj." + + + + | errCode | + "If the method is frameless, it has no message sends. No need to continue." + cogMethod stackCheckOffset = 0 ifTrue: [ ^ 0 ]. + + introspectionDataIndex := counterIndex := 0. + introspectionData := arrayObj. + errCode := self + mapFor: (self cCoerceSimple: cogMethod to: #'CogMethod *') + bcpc: (coInterpreter startPCOfMethod: cogMethod methodObject) + performUntil: #profilingDataFor:Annotation:Mcpc:Bcpc:Method: + arg: cogMethod asVoidPointer. + errCode ~= 0 ifTrue: [ + self assert: errCode = PrimErrNoMemory. + ^ -1 ]. + ^ introspectionDataIndex +] + +{ #category : 'method introspection' } +SimpleStackBasedCogit >> profilingDataForCounter: counter at: bcpc [ + "Undefined by now, do nothing" + + ^ 0 +] + +{ #category : 'method introspection' } +SimpleStackBasedCogit >> profilingDataForSendTo: cogCodeSendTarget methodClassIfSuper: methodClassOrNil at: sendMcpc bcpc: sendBcpc [ + "Answer a tuple with the send data for a linked send to cogMethod. + If the target is a CogMethod (monomorphic send) answer + { bytecode pc, inline cache class, target method } + If the target is an open PIC (megamorphic send) answer + { bytecode pc, nil, send selector } + If the target is a closed PIC (polymorphic send) answer + { bytecode pc, first class, target method, second class, second target method, ... }" + + + | tuple class | + tuple := objectMemory + eeInstantiateClassIndex: ClassArrayCompactIndex + format: objectMemory arrayFormat + numSlots: (cogCodeSendTarget cmType = CMPolymorphicIC + ifTrue: [2 * cogCodeSendTarget cPICNumCases + 1] + ifFalse: [3]). + tuple = 0 ifTrue: + [^0]. + + objectMemory storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: sendBcpc). + + "Monomorphic - linked against a single method" + cogCodeSendTarget cmType = CMMethod ifTrue: [ + "If it is not a super send, we don't have a class, let's extract it from the call site" + class := methodClassOrNil ifNil: [ + objectRepresentation classForInlineCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger)]. + objectMemory + storePointer: 1 ofObject: tuple withValue: class; + storePointer: 2 ofObject: tuple withValue: cogCodeSendTarget methodObject. + ^tuple ]. + + cogCodeSendTarget cmType = CMPolymorphicIC ifTrue: [ + self + populate: tuple + withPICInfoFor: cogCodeSendTarget + firstCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger). + ^tuple ]. + + cogCodeSendTarget cmType = CMMegamorphicIC ifTrue: [ + objectMemory + storePointerUnchecked: 1 ofObject: tuple withValue: objectMemory nilObject; + storePointer: 2 ofObject: tuple withValue: cogCodeSendTarget selector. + ^tuple ]. + + self error: 'invalid method type'. + ^0 "to get Slang to type this method as answering sqInt" +] + { #category : 'bytecode generator support' } SimpleStackBasedCogit >> putSelfInReceiverResultReg [ diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index 75478405be..54846c9a02 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -136,8 +136,7 @@ Class { 'realCECallCogCodePopReceiverArg0Regs', 'realCECallCogCodePopReceiverArg1Arg0Regs', 'deadCode', - 'useTwoPaths', - 'counterIndex' + 'useTwoPaths' ], #pools : [ 'CogCompilationConstants', @@ -3729,35 +3728,6 @@ StackToRegisterMappingCogit >> picMissTrampolines [ ] -{ #category : 'method introspection' } -StackToRegisterMappingCogit >> populate: tuple withPICInfoFor: cPIC firstCacheTag: firstCacheTag [ - "Populate tuple (which must be large enough) with the ClosedPIC's target method class pairs. - The first entry in tuple contains the bytecode pc for the send, so skip the tuple's first field." - - | picCaseMachineCodePC cacheTag classOop entryPoint targetMethod value | - - - 1 to: cPIC cPICNumCases do: [:i| - picCaseMachineCodePC := self addressOfEndOfCase: i inCPIC: cPIC. - cacheTag := i = 1 - ifTrue: [firstCacheTag] - ifFalse: [backEnd literalBeforeFollowingAddress: picCaseMachineCodePC - backEnd jumpLongConditionalByteSize]. - - classOop := objectRepresentation classForInlineCacheTag: cacheTag. - objectMemory storePointer: i * 2 - 1 ofObject: tuple withValue: classOop. - entryPoint := i = 1 - ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: picCaseMachineCodePC] - ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: picCaseMachineCodePC]. - "Find target from jump. A jump to the MNU entry-point should collect #doesNotUnderstand:" - (cPIC containsAddress: entryPoint) - ifTrue: [ value := objectMemory splObj: SelectorDoesNotUnderstand ] - ifFalse: [ - targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'. - self assert: targetMethod cmType = CMMethod. - value := targetMethod methodObject ]. - objectMemory storePointer: i * 2 ofObject: tuple withValue: value ] -] - { #category : 'testing' } StackToRegisterMappingCogit >> prevInstIsPCAnnotated [ | prevIndex prevInst | @@ -3861,152 +3831,6 @@ StackToRegisterMappingCogit >> printSimStack: aSimStack toDepth: limit spillBase flush ] ] -{ #category : 'method introspection' } -StackToRegisterMappingCogit >> profilingDataFor: descriptor Annotation: isBackwardBranchAndAnnotation Mcpc: mcpc Bcpc: bcpc Method: cogMethodArg [ - - - - - | annotation entryPoint tuple counter | - "N.B. Counters are always 32-bits, having two 16-bit halves for the reached and taken counts." - - - descriptor ifNil: - [^0]. - descriptor isBranch ifTrue: - ["it's a branch; conditional?" - (descriptor isBranchTrue or: [descriptor isBranchFalse]) ifTrue: [ | counters | - counters := self - cCoerce: ((self - cCoerceSimple: cogMethodArg - to: #'CogMethod *') counters) - to: #'usqInt *'. - "If no counters are available, do not record counters" - counters = 0 ifTrue: [ ^ 0 ]. - - counter := counters at: counterIndex. - tuple := self profilingDataForCounter: counter at: bcpc + 1. - tuple = 0 ifTrue: [^PrimErrNoMemory]. - objectMemory - storePointer: introspectionDataIndex - ofObject: introspectionData - withValue: tuple. - introspectionDataIndex := introspectionDataIndex + 1. - counterIndex := counterIndex + 1]. - ^0]. - - annotation := isBackwardBranchAndAnnotation >> 1. - ((self isPureSendAnnotation: annotation) - and: [entryPoint := backEnd callTargetFromReturnAddress: mcpc asUnsignedInteger. - entryPoint > methodZoneBase]) ifFalse: "send is not linked, or is not a send" - [^0]. - - "It's a linked send; find which kind." - self targetMethodAndSendTableFor: entryPoint - annotation: annotation - into: [:targetCogCode :sendTable| | methodClassIfSuper association | - methodClassIfSuper := nil. - sendTable = superSendTrampolines ifTrue: [ - methodClassIfSuper := coInterpreter methodClassOf: (self cCoerceSimple: cogMethodArg to: #'CogMethod *') methodObject. - ]. - sendTable = directedSuperSendTrampolines ifTrue: [ - association := backEnd literalBeforeInlineCacheTagAt: mcpc asUnsignedInteger. - methodClassIfSuper := objectRepresentation valueOfAssociation: association ]. - tuple := self profilingDataForSendTo: targetCogCode - methodClassIfSuper: methodClassIfSuper - at: mcpc - bcpc: bcpc + 1]. - - tuple = 0 ifTrue: [^PrimErrNoMemory]. - objectMemory - storePointer: introspectionDataIndex - ofObject: introspectionData - withValue: tuple. - introspectionDataIndex := introspectionDataIndex + 1. - ^0 -] - -{ #category : 'method introspection' } -StackToRegisterMappingCogit >> profilingDataFor: cogMethod into: arrayObj [ - - "Collect the branch and send data for cogMethod, storing it into arrayObj." - - - - | errCode | - "If the method is frameless, it has no message sends. No need to continue." - cogMethod stackCheckOffset = 0 ifTrue: [ ^ 0 ]. - - introspectionDataIndex := counterIndex := 0. - introspectionData := arrayObj. - errCode := self - mapFor: (self cCoerceSimple: cogMethod to: #'CogMethod *') - bcpc: (coInterpreter startPCOfMethod: cogMethod methodObject) - performUntil: #profilingDataFor:Annotation:Mcpc:Bcpc:Method: - arg: cogMethod asVoidPointer. - errCode ~= 0 ifTrue: [ - self assert: errCode = PrimErrNoMemory. - ^ -1 ]. - ^ introspectionDataIndex -] - -{ #category : 'method introspection' } -StackToRegisterMappingCogit >> profilingDataForCounter: counter at: bcpc [ - "Undefined by now, do nothing" - - ^ 0 -] - -{ #category : 'method introspection' } -StackToRegisterMappingCogit >> profilingDataForSendTo: cogCodeSendTarget methodClassIfSuper: methodClassOrNil at: sendMcpc bcpc: sendBcpc [ - "Answer a tuple with the send data for a linked send to cogMethod. - If the target is a CogMethod (monomorphic send) answer - { bytecode pc, inline cache class, target method } - If the target is an open PIC (megamorphic send) answer - { bytecode pc, nil, send selector } - If the target is a closed PIC (polymorphic send) answer - { bytecode pc, first class, target method, second class, second target method, ... }" - - - | tuple class | - tuple := objectMemory - eeInstantiateClassIndex: ClassArrayCompactIndex - format: objectMemory arrayFormat - numSlots: (cogCodeSendTarget cmType = CMPolymorphicIC - ifTrue: [2 * cogCodeSendTarget cPICNumCases + 1] - ifFalse: [3]). - tuple = 0 ifTrue: - [^0]. - - objectMemory storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: sendBcpc). - - "Monomorphic - linked against a single method" - cogCodeSendTarget cmType = CMMethod ifTrue: [ - "If it is not a super send, we don't have a class, let's extract it from the call site" - class := methodClassOrNil ifNil: [ - objectRepresentation classForInlineCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger)]. - objectMemory - storePointer: 1 ofObject: tuple withValue: class; - storePointer: 2 ofObject: tuple withValue: cogCodeSendTarget methodObject. - ^tuple ]. - - cogCodeSendTarget cmType = CMPolymorphicIC ifTrue: [ - self - populate: tuple - withPICInfoFor: cogCodeSendTarget - firstCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger). - ^tuple ]. - - cogCodeSendTarget cmType = CMMegamorphicIC ifTrue: [ - objectMemory - storePointerUnchecked: 1 ofObject: tuple withValue: objectMemory nilObject; - storePointer: 2 ofObject: tuple withValue: cogCodeSendTarget selector. - ^tuple ]. - - self error: 'invalid method type'. - ^0 "to get Slang to type this method as answering sqInt" -] - { #category : 'span functions' } StackToRegisterMappingCogit >> pushNilSize: aMethodObj numInitialNils: numInitialNils [