Skip to content

Commit

Permalink
CogVM source as per VMMaker.oscog-eem.3444
Browse files Browse the repository at this point in the history
StackInterpreter:
Move the fast primitive log support up to StackInterpreter as a compile-time
option via the conditional define of LOGPRIMITIVES.

Slang:
Rewrite the Slang transpiler's parse tree and inliner.

The original TParseNode/TMethod hierarchy did modifications by scanning
the tree for nodes to be changed, entering the modification for the node
into a dictionary from existing to replacement node, and then copying the
entire tree, substituting replacements during the copy.  This had a
certain simplicity but had two major downsides
	a) the search for likely nodes was top-down and largely context-free,
       focussed on inlining blind-folded as to a node's context
	b) the system spent nearly all its time reclaiming old trees as most
       modifications required a tree rewrite

The rewrite is to grace all TParseNodes with a parent inst var referencing
the node immediately above in the tree, with a TMethod at the top.  This
has two major advantages:
	a) inlining decisions can always be made in context by directly asking
       the parent and ancestors for context.
       Hence nodes can now easily find whether they're used for effect
       or value, what their statement level node is, etc.
	b) modification can be done in place via
			aNode parent replaceChild: childNode with: replacementNode
The resulting framework is much easier to understand and much faster.

The inlining strategy has been changed. Before, the attempt to inline
expressions and statements was freely intermixed. Now, each TMethod
starts off in the expressions inlining phase. Only when no more
inlinable expressions remain does it progress to the statements
inlining phase, in which it will prefer inlining statements over
expressions, but still inline expressions where possible. Finally when
no more inlinable expressions or statements remain it progresses to
the inlineMustInline phase, where it will inline against its better
judgement if the inlinee demands inlining (<inline: #always>). The
completeness check may regress to an earlier phase if the inlining of
something resulted in inlinable candidates managed in a previous phase.
This strategy appears to be significantly better, resulting in less
variables and less labels generated in the generated code.

More transformations are done before source generation, so now value
expansions of literal blocks are done on the parse tree rather than
in the emitCCodeOn:level:generator: methods.
  • Loading branch information
eliotmiranda committed Aug 23, 2024
1 parent 1af9a9b commit 0d7eba4
Show file tree
Hide file tree
Showing 162 changed files with 694,721 additions and 813,199 deletions.
2 changes: 2 additions & 0 deletions building/macos64x64/squeak.stack.spur/Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,8 @@ BIT_IDENTICAL_FLOATING_POINT=BIT_IDENTICAL_FLOATING_POINT
VMSRCDIR:= ../../../src/spur64.stack
SOURCEFILE:=SqueakV50.sources

XCFLAGS=-DLOGPRIMITIVES=1

# Now include the Makefile proper, which is common to all Mac OS builds.
#
include ../common/Makefile.app.squeak
2 changes: 1 addition & 1 deletion image/Slang Test Workspace.text
Original file line number Diff line number Diff line change
@@ -1 +1 @@
"Here are some doits to get Slang to generate a single method to the transcript"CCodeGenerator classPool at: #BreakSrcSelectors put: nil.[Transcript show: [| sel vmm s cg | sel := #printFrame:WithSP:. vmm := (VMMaker forPlatform: 'Cross') interpreterClass: "CoInterpreter"StackInterpreter; options: #(ObjectMemory Spur64BitMemoryManager MULTIPLEBYTECODESETS true). cg := [vmm buildCodeGeneratorForInterpreter] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. "to break at inlining decisions or type inferrence uncomment the following. If src & dest are different selectors, breaks on inlining. If src & dest are the same selector, breaks on type inference in sel." cg breakSrcInlineSelector: #frameRange:to:; breakDestInlineSelector: sel; breakOnInline: "true"#trueIfComplete"nil". cg vmClass preGenerationHook: cg. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { sel }. cg prepareMethods. (cg isIncludedInInterpretCase: sel) ifTrue: [cg doBasicInlining: true] ifFalse: [cg doInlining: true]. s := ReadWriteStream on: String new. (cg methodNamed: sel) halt; emitCCodeOn: s generator: cg. s contents] value].[Transcript show: [| sel vmm s cg | sel := #primitiveFullGC"populate:from:to:". "CCodeGenerator classPool at: #BreakSrcSelectors put: #(checkForEventsMayContextSwitch: checkInvokeIOProcessEvents:)." vmm := (VMMaker forPlatform: 'Cross') interpreterClass: CoInterpreterMT; options: #(COGMTVM true ObjectMemory Spur64BitCoMemoryManager MULTIPLEBYTECODESETS true), {#Cogit. Cogit chooseCogitClass name}. cg := [vmm buildCodeGeneratorForInterpreter] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. cg vmClass preGenerationHook: cg. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { sel }. cg prepareMethods. (cg isIncludedInInterpretCase: sel) ifTrue: [cg doBasicInlining: true] ifFalse: [cg doInlining: true]. s := ReadWriteStream on: String new. (cg methodNamed: sel) halt; emitCCodeOn: s generator: cg. s contents] value].[Transcript show: [| sel s vmm cg | sel := #genPrimitiveIdenticalOrNotIf:"dispatchConcretize""genAlloc64BitSignedIntegerValue:into:scratchReg:scratchReg:". vmm := VMMaker forPlatform: 'Cross'. cg := [vmm interpreterClass: CoInterpreter; options: {#Cogit. Cogit chooseCogitClass name}, {#ISA. Cogit choose64BitISA}, #(ObjectMemory Spur64BitCoMemoryManager MULTIPLEBYTECODESETS true); buildCodeGeneratorForCogit] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. "to break at inlining decisions or type inferrence uncomment the following. If src & dest are different selectors, breaks on inlining. If src & dest are the same selector, breaks on type inference in sel." cg "breakSrcInlineSelector: #shouldAnnotateObjectReference:;" breakSrcInlineSelector: #genMoveConstant:R:; "breakDestInlineSelector:#genMoveConstant:R:;" breakDestInlineSelector:#genMoveFalseR:; breakDestInlineSelector: sel; breakOnInline: #trueIfComplete. cg vmClass preGenerationHook: cg. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { #compactCogCompiledCode. sel }. cg prepareMethods. cg doInlining: cg vmClass doInlining. s := ReadWriteStream on: String new. (cg methodNamed: sel) halt; emitCCodeOn: s generator: cg. s contents] value].[Transcript show: [| tm s vmm cg | vmm := VMMaker forPlatform: 'Cross'. cg := [vmm interpreterClass: StackInterpreter; buildCodeGeneratorForInterpreter] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. cg vmClass preGenerationHook: cg. tm := (StackInterpreter compile: 'foo self cppIf: ''ARBITRARY'' ifTrue: [self cCode: ''arbi''] ifFalse: [self cCode: ''trary'']. self cppIf: (self cCode: ''ARBITRARY'') ifTrue: [self cCode: ''arbi''] ifFalse: [self cCode: ''trary'']' classified: nil notifying: nil trailer: CompiledMethodTrailer empty ifFail: []) node asTranslationMethodOfClass: cg translationMethodClass. cg addMethod: tm. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { #foo }. cg prepareMethods. cg doInlining: true. s := ReadWriteStream on: String new. (cg methodNamed: #foo) halt; emitCCodeOn: s generator: cg. s contents] value].[Transcript show: [| plugin sel s vmm cg | plugin := "ThreadedARM64FFIPlugin"UnixOSProcessPlugin. sel := #"primitiveCallout"setSignalNumber:handler:. vmm := VMMaker forPlatform: 'Cross'. cg := [plugin buildCodeGenerator] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. cg breakSrcInlineSelector: #cdigitMontgomery:len:times:len:modulo:len:mInvModB:into:; breakDestInlineSelector: sel; breakOnInline: "false"true. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { sel }. cg prepareMethods. cg doInlining: true. s := ReadWriteStream on: String new. (cg anyMethodNamed: sel) removeUnusedTempsAndNilIfRequiredIn: cg; halt; emitCCodeOn: s generator: cg. s contents] value].[Transcript show: [| plugin s cg | plugin := "FileCopyPlugin"UnixOSProcessPlugin. cg := plugin buildCodeGenerator. cg breakSrcInlineSelector: #sendSignal:toPid:; breakDestInlineSelector: #sendSignalToPids; breakOnInline: true. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg doInlining: true. plugin pruneUnusedInterpreterPluginMethodsIn: cg. s := ReadWriteStream on: String new. #sendSignalToPids ifNotNil: [:sel| (cg methodNamed: sel) halt emitCCodeOn: s generator: cg] ifNil: [cg emitCCodeOn: s doInlining: true doAssertions: false]. s contents] value].[| cg |cg := BalloonEnginePlugin buildCodeGenerator.cg breakSrcInlineSelector: #getUsedPut:; breakDestInlineSelector: #addEdgeToGET:; breakOnInline: true.cg inferTypesForImplicitlyTypedVariablesAndMethods.cg doInlining: true.Transcript show: (String streamContents: [:s| (cg methodNamed: #addEdgeToGET:) halt; emitCCodeOn: s generator: cg])] on: TMethodValidationNotification do: [:ex| ex halt].[| cg |cg := ThreadedX64SysVFFIPlugin buildCodeGenerator.cg breakSrcInlineSelector: #isAtomicType:; breakDestInlineSelector: #ffiCheckReturn:With:in:; breakOnInline: #trueIfComplete.cg inferTypesForImplicitlyTypedVariablesAndMethods.cg doInlining: true.Transcript show: (String streamContents: [:s| (cg methodNamed: #ffiCall:ArgArrayOrNil:NumArgs:"loadBitBltFrom:warping:") halt; emitCCodeOn: s generator: cg])] on: TMethodValidationNotification do: [:ex| ex halt].
"Here are some doits to get Slang to generate a single method to the transcript"CCodeGenerator classPool at: #BreakBlock put: nil.CCodeGenerator classPool at: #BreakBlock put: [:action :ss| action == #transform and: [ss == #setMethod:]].[Transcript show: [| sel vmm cg str | sel := #prepareForSnapshot. vmm := (VMMaker forPlatform: 'Cross') interpreterClass: "CoInterpreterPrimitives"StackInterpreterPrimitives; options: #(ObjectMemory Spur32BitMemoryManager MULTIPLEBYTECODESETS true). cg := [vmm buildCodeGeneratorForInterpreter] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. "cg breakBlock: [:action :ss :dm :cm| action == #inline and: [ss == #frameMethod: and: [dm selector == sel and: [cm getNodeInto: [:node| Transcript cr; print: node; space; print: node parent; flush. node parent isSend and: [node parent selector == #setMethod:]]]]]]." "cg breakBlock: [:action :ss :dm| #transform == action and: [dm selector == sel]]." cg breakBlock: [:action :ss :dm :cm| action == #transform and: [dm selector == sel]]. "cg breakBlock: [:action :ss :dm| (#(inline inlineTest) includes: action) and: [(#(numSlotsOf: numSlotsForBytes: noInlineAllocateSlots:) includes: ss) and: [(cg isComplete: ss) and: [(cg currentNode parentChainAnySatisfy: [:node| node isSend and: [(node methodIn: cg) notNil and: [(node methodIn: cg) neverInline]]]) and: [dm selector == sel]]]]]." cg vmClass preGenerationHook: cg. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { sel }. cg prepareMethods. (cg isIncludedInInterpretCase: sel) ifTrue: [cg doBasicInlining: true] ifFalse: [cg doInlining: vmm doInlining]. str := ReadWriteStream on: String new. (cg methodNamed: sel) halt; "emitCFunctionPrototype: str generator: cg;" emitCCodeOn: str generator: cg. str contents] value].CCodeGenerator classPool at: #BreakBlock put: nil.CCodeGenerator classPool at: #BreakBlock put: [:action :ss| action == #"create"transform and: [ss == #initializeSharableLiteral:]].[Transcript show: [| sel vmm s cg | sel := #primitiveSetVMParameter:arg:. vmm := (VMMaker forPlatform: 'Cross') interpreterClass: CoInterpreterMT; options: #(COGMTVM true ObjectMemory Spur64BitCoMemoryManager MULTIPLEBYTECODESETS true), {#Cogit. Cogit chooseCogitClass name}. cg := [vmm buildCodeGeneratorForInterpreter] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. false ifTrue: [cg breakBlock: [:a :ss :dm| (#(access) includes: a) and: [ss selector == #normalSend and: [dm selector == sel and: [(cg currentNode isSend not or: [cg currentNode selector ~~ #normalSend]) and: [Transcript cr; print: cg currentNode; flush. true]]]]]] ifFalse: [true ifTrue:[cg breakBlock: [:a :ss :dm| (#(inline "inlineTest") includes: a) and: [(#(normalSend) includes: ss) and: [dm selector == sel]]]] ifFalse: [cg breakBlock: [:a :ss :dm| (#(transform) includes: a) and: [dm selector == sel]]]]. cg vmClass preGenerationHook: cg. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { sel }. cg prepareMethods. (cg isIncludedInInterpretCase: sel) ifTrue: [cg doBasicInlining: true] ifFalse: [cg doInlining: vmm doInlining]. s := ReadWriteStream on: String new. (cg methodNamed: sel) halt; emitCCodeOn: s generator: cg. s contents] value].CCodeGenerator classPool at: #BreakBlock put: nil.CCodeGenerator classPool at: #BreakBlock put: [:action :sel| action == #create and: [sel == #genMarshallNArgs:arg:arg:arg:arg:]].[Transcript show: [| sel s vmm cg | sel := #ssFlushUpThroughTemporaryVariable:. vmm := VMMaker forPlatform: 'Cross'. cg := [vmm interpreterClass: CoInterpreter; options: {#Cogit. Cogit chooseCogitClass name}, {#ISA. Cogit choose64BitISA}, #(ObjectMemory Spur64BitCoMemoryManager MULTIPLEBYTECODESETS true); buildCodeGeneratorForCogit] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. "cg breakBlock: [:a :ss :m| (#(inline inlineTest) includes: a) and: [ss == #preferredRegisterForMovePerfCnt64RL and: [m selector == sel]]]." cg breakBlock: [:a :ss :m| a == #transform and: [ss == #value: and: [m selector == sel]]]. cg vmClass preGenerationHook: cg. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { #compactCogCompiledCode. sel }. cg prepareMethods. cg doInlining: cg vmClass doInlining. s := ReadWriteStream on: String new. (cg methodNamed: sel) halt; emitCCodeOn: s generator: cg. s contents] value].CCodeGenerator classPool at: #BreakBlock put: nil.CCodeGenerator classPool at: #BreakBlock put: [:action :sel| action == #create and: [sel == #genMarshallNArgs:arg:arg:arg:arg:]].[Transcript show: [| sel s vmm cg | sel := #genCheckForProfileTimerTick:. vmm := VMMaker forPlatform: 'Cross'. cg := [vmm interpreterClass: CoInterpreter; options: {#Cogit. Cogit chooseCogitClass name}, {#ISA. Cogit choose32BitISA}, ((UIManager default confirm: 'Spur?') ifTrue: [#(ObjectMemory Spur64BitCoMemoryManager MULTIPLEBYTECODESETS true)] ifFalse: [#(ObjectMemory NewCoObjectMemory)]); buildCodeGeneratorForCogit] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. "cg breakBlock: [:a :ss :m| (#(inline inlineTest) includes: a) and: [ss == #preferredRegisterForMovePerfCnt64RL and: [m selector == sel]]]." "cg breakBlock: [:a :ss :m| a == #transform and: [m selector == sel]]." cg vmClass preGenerationHook: cg. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { #compactCogCompiledCode. sel }. cg prepareMethods. cg doInlining: cg vmClass doInlining. s := ReadWriteStream on: String new. (cg methodNamed: sel) halt; emitCCodeOn: s generator: cg. s contents] value].[Transcript show: [| tm s vmm cg | vmm := VMMaker forPlatform: 'Cross'. cg := [vmm interpreterClass: StackInterpreter; buildCodeGeneratorForInterpreter] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. cg vmClass preGenerationHook: cg. tm := (StackInterpreter compile: 'foo self cppIf: ''ARBITRARY'' ifTrue: [self cCode: ''arbi''] ifFalse: [self cCode: ''trary'']. self cppIf: (self cCode: ''ARBITRARY'') ifTrue: [self cCode: ''arbi''] ifFalse: [self cCode: ''trary'']' classified: nil notifying: nil trailer: CompiledMethodTrailer empty ifFail: []) node asTranslationMethodOfClass: cg translationMethodClass. cg addMethod: tm. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { #foo }. cg prepareMethods. cg doInlining: vmm doInlining. s := ReadWriteStream on: String new. (cg methodNamed: #foo) halt; emitCCodeOn: s generator: cg. s contents] value].[Transcript show: [| plugin sel s vmm cg | plugin := IA32ABIPlugin. sel := #primAddressField. vmm := VMMaker forPlatform: 'Cross'. cg := [plugin buildCodeGeneratorInto:[:theCG| theCG breakBlock: [:action :ss :dm| action == #inline and: [ss == #positiveMachineIntegerFor: and: (theCG isComplete: ss) and: [dm selector == sel]]]]] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. cg breakSrcInlineSelector: #cdigitMontgomery:len:times:len:modulo:len:mInvModB:into:; breakDestInlineSelector: sel; breakOnInline: "false"true. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: { sel }. cg prepareMethods. cg doInlining: vmm doInlining. s := ReadWriteStream on: String new. (cg anyMethodNamed: sel) emitCCodeOn: s generator: cg. s contents] value].[| cg sel |sel := #primitiveSocketAbortConnection.cg := SocketPlugin buildCodeGeneratorInto: [:theCG| theCG breakBlock: [:action :ss :dm| action == #inline and: [ss == #socketValueOf: and: [dm selector == sel]]]].cg inferTypesForImplicitlyTypedVariablesAndMethods.cg retainMethods: { sel }.cg doInlining: true.Transcript show: (String streamContents: [:s| (cg methodNamed: sel) halt; emitCCodeOn: s generator: cg])] on: TMethodValidationNotification do: [:ex| ex halt].[| cg sel |sel := #ffiCalloutTo:SpecOnStack:in:.cg := ThreadedARM64FFIPlugin buildCodeGeneratorInto: [:theCG| theCG breakBlock: [:action :ss :dm| action == #create and: [ss == #ffiArgByValue:in:]]].cg inferTypesForImplicitlyTypedVariablesAndMethods.cg doInlining: true.Transcript show: (String streamContents: [:s| (cg methodNamed: sel) halt; emitCCodeOn: s generator: cg])] on: TMethodValidationNotification do: [:ex| ex halt].
Expand Down
Loading

0 comments on commit 0d7eba4

Please sign in to comment.