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

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

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

Name: VMMaker.oscog-eem.1522
Author: eem
Time: 17 November 2015, 5:12:50.33 pm
UUID: 62cb521e-b3cc-4104-999e-095ad37474a5
Ancestors: VMMaker.oscog-eem.1521

Cogit:
Implement the long conditional branch/long unconditional branch split necessitated by the MIPS processor in all of the closed PIC methods.

Update Slang to collapse an ifTrue:ifFalse: if bioth arms are the same, to avoid the code duplication this introduces on the rest of the processors where conditional and unconditional branch offsets can be accessed in the same way.

Caution:  Tim's new CPICs are broken w.r.t. accessing class tags in PICs.  In fact, he's left the breaks in classRefInClosedPICAt: & storeClassRef:inClosedPICAt: to show his unease.  I'll fix this asap.  First I need to add code to disassemble the closed PIC prototype so I can see the wood for the trees.

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

Item was changed:
  ----- Method: CCodeGenerator>>generateIfFalseIfTrue:on:indent: (in category 'C translation') -----
  generateIfFalseIfTrue: msgNode on: aStream indent: level
        "Generate the C code for this message onto the given stream."

        (self nilOrBooleanConstantReceiverOf: msgNode receiver)
                ifNil:
+                       [(self tryToCollapseBothArmsOfConditional: msgNode on: aStream indent: level) ifFalse:
+                               [aStream nextPutAll: 'if ('.
+                                msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self.
+                                aStream nextPutAll: ') {'; cr.
+                                msgNode args last emitCCodeOn: aStream level: level + 1 generator: self.
+                                aStream tab: level; nextPut: $}; crtab: level; nextPutAll: 'else {'; cr.
+                                msgNode args first emitCCodeOn: aStream level: level + 1 generator: self.
+                                aStream tab: level; nextPut: $}]]
-                       [aStream nextPutAll: 'if ('.
-                       msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self.
-                       aStream nextPutAll: ') {'; cr.
-                       msgNode args last emitCCodeOn: aStream level: level + 1 generator: self.
-                       aStream tab: level; nextPut: $}; crtab: level; nextPutAll: 'else {'; cr.
-                       msgNode args first emitCCodeOn: aStream level: level + 1 generator: self.
-                       aStream tab: level; nextPut: $}]
                ifNotNil:
                        [:const |
                         (const ifTrue: [msgNode args last] ifFalse: [msgNode args first])
                                emitCCodeOn: aStream level: level generator: self]!

Item was changed:
  ----- Method: CCodeGenerator>>generateIfFalseIfTrueAsArgument:on:indent: (in category 'C translation') -----
  generateIfFalseIfTrueAsArgument: msgNode on: aStream indent: level
        "Generate the C code for this message onto the given stream."

        (self nilOrBooleanConstantReceiverOf: msgNode receiver)
                ifNil:
+                       [(self tryToCollapseBothArmsOfConditionalExpression: msgNode on: aStream indent: level) ifFalse:
+                               [aStream nextPut: $(.
+                                msgNode receiver emitCCodeAsArgumentOn: aStream level: level generator: self.
+                                aStream crtab: level + 1; nextPut: $?; space.
+                                msgNode args last emitCCodeAsArgumentOn: aStream level: level + 2 generator: self.
+                                aStream crtab: level + 1; nextPut: $:; space.
+                                msgNode args first emitCCodeAsArgumentOn: aStream level: level + 2 generator: self.
+                                aStream nextPut: $)]]
-                       [aStream nextPut: $(.
-                       msgNode receiver emitCCodeAsArgumentOn: aStream level: level generator: self.
-                       aStream crtab: level + 1; nextPut: $?; space.
-                       msgNode args last emitCCodeAsArgumentOn: aStream level: level + 2 generator: self.
-                       aStream crtab: level + 1; nextPut: $:; space.
-                       msgNode args first emitCCodeAsArgumentOn: aStream level: level + 2 generator: self.
-                       aStream nextPut: $)]
                ifNotNil:
                        [:const|
                        (const
                                ifTrue: [msgNode args last]
                                ifFalse: [msgNode args first])
                                        emitCCodeAsArgumentOn: aStream level: level generator: self]!

Item was changed:
  ----- Method: CCodeGenerator>>generateIfTrueIfFalse:on:indent: (in category 'C translation') -----
  generateIfTrueIfFalse: msgNode on: aStream indent: level
        "Generate the C code for this message onto the given stream."

        (self nilOrBooleanConstantReceiverOf: msgNode receiver)
                ifNil:
+                       [(self tryToCollapseBothArmsOfConditional: msgNode on: aStream indent: level) ifFalse:
+                               [aStream nextPutAll: 'if ('.
+                                msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self.
+                                aStream nextPutAll: ') {'; cr.
+                                msgNode args first emitCCodeOn: aStream level: level + 1 generator: self.
+                                aStream tab: level; nextPut: $}; crtab: level; nextPutAll: 'else {'; cr.
+                                msgNode args last emitCCodeOn: aStream level: level + 1 generator: self.
+                                aStream tab: level; nextPut: $}]]
-                       [aStream nextPutAll: 'if ('.
-                       msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self.
-                       aStream nextPutAll: ') {'; cr.
-                       msgNode args first emitCCodeOn: aStream level: level + 1 generator: self.
-                       aStream tab: level; nextPut: $}; crtab: level; nextPutAll: 'else {'; cr.
-                       msgNode args last emitCCodeOn: aStream level: level + 1 generator: self.
-                       aStream tab: level; nextPut: $}]
                ifNotNil:
                        [:const |
                        (const ifTrue: [msgNode args first] ifFalse: [msgNode args last])
                                emitCCodeOn: aStream level: level generator: self]!

Item was changed:
  ----- Method: CCodeGenerator>>generateIfTrueIfFalseAsArgument:on:indent: (in category 'C translation') -----
  generateIfTrueIfFalseAsArgument: msgNode on: aStream indent: level
        "Generate the C code for this message onto the given stream."

        (self nilOrBooleanConstantReceiverOf: msgNode receiver)
                ifNil:
+                       [(self tryToCollapseBothArmsOfConditionalExpression: msgNode on: aStream indent: level) ifFalse:
+                               [aStream nextPut: $(.
+                                msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self.
+                                aStream crtab: level + 1; nextPut: $?; space.
+                                msgNode args first emitCCodeAsArgumentOn: aStream level: level + 2 generator: self.
+                                aStream crtab: level + 1; nextPut: $:; space.
+                                msgNode args last emitCCodeAsArgumentOn: aStream level: level + 2 generator: self.
+                                aStream nextPut: $)]]
-                       [aStream nextPut: $(.
-                       msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self.
-                       aStream crtab: level + 1; nextPut: $?; space.
-                       msgNode args first emitCCodeAsArgumentOn: aStream level: level + 2 generator: self.
-                       aStream crtab: level + 1; nextPut: $:; space.
-                       msgNode args last emitCCodeAsArgumentOn: aStream level: level + 2 generator: self.
-                       aStream nextPut: $)]
                ifNotNil:
                        [:const|
                        (const ifTrue: [msgNode args first] ifFalse: [msgNode args last])
                                emitCCodeAsArgumentOn: aStream level: level generator: self]!

Item was added:
+ ----- Method: CCodeGenerator>>tryToCollapseBothArmsOfConditional:on:indent: (in category 'C translation support') -----
+ tryToCollapseBothArmsOfConditional: msgNode on: aStream indent: level
+       "Attempt to generate the code for an ifTrue:ifFalse: if both arms are found to be the same, in which case
+        answer true.  Otherwise output nothing and answer false."
+       (msgNode args first isSameAs: msgNode args second) ifFalse:
+               [^false].
+       msgNode receiver hasSideEffect ifTrue:
+               [msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self.
+                aStream nextPut: $; ; crtab: level].
+       msgNode args first emitCCodeOn: aStream level: level generator: self.
+       ^true!

Item was added:
+ ----- Method: CCodeGenerator>>tryToCollapseBothArmsOfConditionalExpression:on:indent: (in category 'C translation support') -----
+ tryToCollapseBothArmsOfConditionalExpression: msgNode on: aStream indent: level
+       "Attempt to generate the code for an ifTrue:ifFalse: if both arms are found to be the same, in which case
+        answer true.  Otherwise output nothing and answer false."
+       (msgNode args first isSameAs: msgNode args second) ifFalse:
+               [^false].
+       aStream nextPut: $(.
+       msgNode receiver hasSideEffect ifTrue:
+               [msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self.
+                aStream nextPut: $, ; crtab: level]..
+       msgNode args first emitCCodeAsArgumentOn: aStream level: level generator: self.
+       aStream nextPut: $).
+       ^true!

Item was removed:
- ----- Method: CogARMCompiler>>jumpLongConditionalTargetBeforeFollowingAddress: (in category 'inline cacheing') -----
- jumpLongConditionalTargetBeforeFollowingAddress: mcpc
-       ^self jumpLongTargetBeforeFollowingAddress: mcpc!

Item was added:
+ ----- Method: CogAbstractInstruction>>jumpLongConditionalTargetBeforeFollowingAddress: (in category 'inline cacheing') -----
+ jumpLongConditionalTargetBeforeFollowingAddress: mcpc
+       "Extract the target from a long conditional jump.  On many ISAs this si the same as
+        extracting the target from a long unconditional jump, so we provide the default here.
+        Processors such as MIPS override as appropriate."
+       <inline: true>
+       ^self jumpLongTargetBeforeFollowingAddress: mcpc!

Item was removed:
- ----- Method: CogIA32Compiler>>jumpLongConditionalTargetBeforeFollowingAddress: (in category 'inline cacheing') -----
- jumpLongConditionalTargetBeforeFollowingAddress: mcpc
-       ^self jumpLongTargetBeforeFollowingAddress: mcpc !

Item was changed:
  ----- Method: Cogit>>cPIC:HasTarget: (in category 'in-line cacheing') -----
  cPIC: cPIC HasTarget: targetMethod
        "Are any of the jumps from this CPIC to targetMethod?"
        <var: #cPIC type: #'CogMethod *'>
        <var: #targetMethod type: #'CogMethod *'>
        | pc target |
        target := targetMethod asUnsignedInteger + cmNoCheckEntryOffset.
        pc := cPIC asInteger + firstCPICCaseOffset.
        "Since this is a fast test doing simple compares we don't need to care that some
+       cases have nonsense addresses in there. Just zip on through."
+       "First jump is unconditional; subsequent ones are conditional"
+       target = (backEnd jumpLongTargetBeforeFollowingAddress: pc) ifTrue:
+               [^true].
+       2 to: maxCPICCases do:
-       cases have nonsense addresses in there. Just zip on through"
-       1 to: maxCPICCases do:
                [:i|
+               pc := pc + cPICCaseSize.
+               target = (backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc) ifTrue:
+                       [^true]].
-               target = (backEnd jumpLongTargetBeforeFollowingAddress: pc) ifTrue:
-                       [^true].
-               pc := pc + cPICCaseSize].
        ^false!

Item was changed:
  ----- Method: Cogit>>cPICHasFreedTargets: (in category 'in-line cacheing') -----
  cPICHasFreedTargets: cPIC
        "scan the CPIC for target methods that have been freed. "
        <var: #cPIC type: #'CogMethod *'>
        | pc entryPoint targetMethod |
        <var: #targetMethod type: #'CogMethod *'>

        1 to: cPIC cPICNumCases do:
                [:i|
                pc := self addressOfEndOfCase: i inCPIC: cPIC.
+               entryPoint := i = 1
+                                               ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: pc]
+                                               ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
-               entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
                "Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
                (cPIC containsAddress: entryPoint) ifFalse:
                        [targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
                         self assert: (targetMethod cmType = CMMethod or: [targetMethod cmType = CMFree]).
                         targetMethod cmType = CMFree ifTrue:
                                [^true]]].
        ^false!

Item was changed:
  ----- Method: Cogit>>closedPICRefersToUnmarkedObject: (in category 'garbage collection') -----
  closedPICRefersToUnmarkedObject: cPIC
        "Answer if the ClosedPIC refers to any unmarked objects or freed/freeable target methods,
         applying markAndTraceOrFreeCogMethod:firstVisit: to those targets to determine if freed/freeable."
        <var: #cPIC type: #'CogMethod *'>
        | pc offsetToLiteral object entryPoint targetMethod |
        <var: #targetMethod type: #'CogMethod *'>
        (objectMemory isImmediate: cPIC selector) ifFalse:
                [(objectMemory isMarked: cPIC selector) ifFalse:
                        [^true]].
+       "First jump is unconditional; subsequent ones are conditional."
-       "First jump is unconditional; subsequent ones are conditional"
        offsetToLiteral := backEnd jumpLongByteSize.
        1 to: cPIC cPICNumCases do:
                [:i|
                pc := self addressOfEndOfCase: i inCPIC: cPIC.
                (objectRepresentation inlineCacheTagsMayBeObjects and: [i>1] ) "inline cache tags for the 0th case are at the send site" ifTrue:
                        [object := literalsManager classRefInClosedPICAt: pc - offsetToLiteral.
                         ((objectRepresentation couldBeObject: object)
                          and: [(objectMemory isMarked: object) not]) ifTrue:
                                [^true]].
                object := literalsManager objRefInClosedPICAt: pc - offsetToLiteral.
                ((objectRepresentation couldBeObject: object)
                 and: [(objectMemory isMarked: object) not]) ifTrue:
                        [^true].
                offsetToLiteral := backEnd jumpLongConditionalByteSize.
+               entryPoint := i = 1
+                                               ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: pc]
+                                               ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
-               entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
                "Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
                self assert: (entryPoint > methodZoneBase and: [entryPoint < methodZone freeStart]).
                (cPIC containsAddress: entryPoint) ifFalse:
                        [targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
                         self assert: (targetMethod cmType = CMMethod
                                                or: [targetMethod cmType = CMFree]).
                         (self markAndTraceOrFreeCogMethod: targetMethod
                                  firstVisit: targetMethod asUnsignedInteger > pc asUnsignedInteger) ifTrue:
+                               [^true]]].
-                               [^true]].
-               ].
        ^false!

Item was changed:
  ----- Method: Cogit>>compileClosedPICPrototype (in category 'in-line cacheing') -----
  compileClosedPICPrototype
+       "Compile the abstract instructions for a full closed PIC, used to generate the chunk of code
+        which is copied to form each closed PIC.  A Closed Polymorphic Inline Cache is a small jump
+        table used to optimize sends with a limited degree of polymorphism (currently up to 6 cases).
+        We call it closed because it deals only with a finite number of cases, as opposed to an Open PIC.
+        When a monomorphic linked send (a send with a single case, linking direct to the checked entry
+        point of a CogMethod) fails a class check, the Cogit attempts to create a two-entry PIC that will
+        handle jumping to the original target for the original class and the relevant target for the new
+        class.  This jump table will be extended on subsequent failures up to a limit (6).
+
+        We avoid extending CPICs to Open PICs by linking the send site to an Open PIC if one already
+        exists with the send's selector, a good policy since measurements show that sends of mega-
+        morphic selectors usually become megamorphic at all send sites.  Hence the Open PIC list.
+
+        A CPIC also optimizes MNUs and interpret-only methods.  Each case can load SendNumArgs with
+        the oop of a method, or will load SendNumArgs with 0 if not.  MNUs are optimized by jumping to
+        the mnuAbort in the CPIC, which calls code that creates the Message, thereby avoiding looking up
+        the original message which will not be found, and either looks up doesNotUnderstand: or directly
+        activates the method loaded into SendNumArgs, hence avoiding looking up doesNotUnderstand:.
+        Interpret-only methods are handled by jumping to the picInterpretAbort, which enters the
+        interpreter activating the method loaded in SendNumArgs.
+
+        CPICs look like the following, where rClass is set at the original send site for the 1st case, and #Foo
+        is some constant, either an oop, a class tag or an instruction address.
+
+               rTemp := (rRecever bitAnd: TagMask) = 0 ifTrue: [rReceiver class] ifFalse: [rRecever bitAnd: TagMask].
+               rTemp = rClass ifFalse:
+                       [self goto: #Label].
+               rSendNumArgs := #MethodForCase1Or0.
+               self goto: #TargetForCase1.
+        #Label
+               rTemp = #ClassTagForCase6 ifTrue:
+                       [rSendNumArgs := #MethodForCase6Or0.
+                        self goto: #TargetForCase6].
+               ...cases 5, 4 & 3
+               rTemp = #ClassTagForCase2 ifTrue:
+                       [rSendNumArgs := #MethodForCase2Or0.
+                        self goto: #TargetForCase2].
+               self goto: #CPICMissTrampoline
+               literals (if out-of-line literals)
+
+        where we short-cut as many cases as needed by making the self goto: #Label skip as many cases
+        as needed."
-       "Compile the abstract instructions for a full closed PIC used to initialize closedPICSize.
-        The loads into SendNumArgsReg are those for optional method objects which may be
-        used in MNU cases."
        <inline: true>
        | numArgs jumpNext |
        <var: #jumpNext type: #'AbstractInstruction *'>
+       self compilePICAbort: (numArgs := 0). "Will get rewritten to appropriate arity when configuring."
+       jumpNext := self compileCPICEntry.
+       "At the end of the entry code we need to jump to the first case code, which is actually the last chunk.
+        On each entension we must update this jump to move back one case."
+       "16r5EAF00D is the method oop, or 0, for the 1st case."
-       numArgs := 0.
-       self compilePICAbort: numArgs.
-       jumpNext := self compileCPICEntry. "at the end of the entry code we need to jump to the first case code, which is actually the last chunk - for each entension we must update this jump to move back one case"
        self MoveUniqueCw: 16r5EAF00D R: SendNumArgsReg.
        self JumpLong: self cPICPrototypeCaseOffset + 16rCA5E10.
        endCPICCase0 := self Label.
        1 to: maxCPICCases - 1 do:
                [:h|
+               h = (maxCPICCases - 1) ifTrue:
+                       [jumpNext jmpTarget: self Label]. "this is where we jump to for the first case"
+               "16rBABE1F15+h is the class tag for the Nth case"
-               h = (maxCPICCases - 1)
-                               ifTrue: [jumpNext jmpTarget: self Label]. "this is where we jump to for the first case"
                self CmpCw: 16rBABE1F15+h R: TempReg.
+               "16rBADA550+h is the method oop, or 0, for the Nth case."
                self MoveUniqueCw: 16rBADA550 + h R: SendNumArgsReg.
                self JumpLongZero: self cPICPrototypeCaseOffset + 16rCA5E10 + (h * 16).
+               h = 1 ifTrue:
-               h =  1 ifTrue:
                        [endCPICCase1 := self Label]].
        self MoveCw: methodLabel address R: ClassReg.
+       self JumpLong: (self cPICMissTrampolineFor: numArgs).   "Will get rewritten to appropriate arity when configuring."
-       self JumpLong: (self cPICMissTrampolineFor: numArgs).
        cPICEndOfCodeLabel := self Label.
        literalsManager dumpLiterals: false.
        ^0!

Item was changed:
  ----- Method: Cogit>>noTargetsFreeInClosedPIC: (in category 'compaction') -----
  noTargetsFreeInClosedPIC: cPIC
        "Answer if all targets in the PIC are in-use methods."
+       ^(self cPICHasFreedTargets: cPIC) not!
-       <var: #cPIC type: #'CogMethod *'>
-       | pc entryPoint targetMethod |
-       <var: #targetMethod type: #'CogMethod *'>
-
-       1 to: cPIC cPICNumCases do:
-               [:i|
-               pc := self addressOfEndOfCase: i inCPIC: cPIC.
-               entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
-               "Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
-               (cPIC containsAddress: entryPoint) ifFalse:
-                       [targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
-                        targetMethod cmType ~= CMMethod ifTrue:
-                               [^false]]].
-       ^true!

Item was changed:
  ----- Method: Cogit>>relocateCallsInClosedPIC: (in category 'compaction') -----
  relocateCallsInClosedPIC: cPIC
        <var: #cPIC type: #'CogMethod *'>
        | delta pc entryPoint targetMethod |
        <var: #targetMethod type: #'CogMethod *'>
        delta := cPIC objectHeader.
        self assert: (backEnd callTargetFromReturnAddress: cPIC asInteger + missOffset)
                                        = (self picAbortTrampolineFor: cPIC cmNumArgs).
        backEnd relocateCallBeforeReturnPC: cPIC asInteger + missOffset by: delta negated.

        pc := cPIC asInteger + firstCPICCaseOffset.
        1 to: cPIC cPICNumCases do:
                [:i|
                pc := self addressOfEndOfCase: i inCPIC: cPIC.
+               entryPoint := i = 1
+                                               ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: pc]
+                                               ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
-               entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
                "Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
                (cPIC containsAddress: entryPoint) ifFalse:
                        [targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
                         self assert: targetMethod cmType = CMMethod.
                         backEnd
                                relocateJumpLongBeforeFollowingAddress: pc
                                by: (delta - targetMethod objectHeader) negated]].
        self assert: cPIC cPICNumCases > 0.

        "Finally relocate the load of the PIC and the jump to the overflow routine ceCPICMiss:receiver:"
        backEnd relocateMethodReferenceBeforeAddress: (self addressOfEndOfCase: 2 inCPIC: cPIC)+ backEnd loadPICLiteralByteSize by: delta.
        backEnd relocateJumpLongBeforeFollowingAddress: cPIC asInteger + cPICEndOfCodeOffset by: delta negated!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>populate:withPICInfoFor:firstCacheTag: (in category 'method introspection') -----
  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."
        <var: #cPIC type: #'CogMethod *'>
        | pc cacheTag classOop entryPoint targetMethod value |
        <var: #targetMethod type: #'CogMethod *'>

        1 to: cPIC cPICNumCases do:
                [:i|
                pc := self addressOfEndOfCase: i inCPIC: cPIC.
                cacheTag := i = 1
                                                ifTrue: [firstCacheTag]
                                                ifFalse: [backEnd literalBeforeFollowingAddress: pc
                                                                                                                                                - backEnd jumpLongConditionalByteSize
                                                                                                                                                - backEnd loadLiteralByteSize].
                classOop := objectRepresentation classForInlineCacheTag: cacheTag.
                objectMemory storePointer: i * 2 - 1 ofObject: tuple withValue: classOop.
+               entryPoint := i = 1
+                                               ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: pc]
+                                               ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
-               entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
                "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]!
-               objectMemory storePointer: i * 2 ofObject: tuple withValue: value ]!

Item was added:
+ ----- Method: TAssignmentNode>>isSameAs: (in category 'testing') -----
+ isSameAs: aTParseNode
+       ^aTParseNode isAssignment
+        and: [(variable isSameAs: aTParseNode variable)
+        and: [expression isSameAs: aTParseNode expression]]!

Item was added:
+ ----- Method: TConstantNode>>hasSideEffect (in category 'testing') -----
+ hasSideEffect
+       "Answer if the parse tree rooted at this node has a side-effect or not."
+       ^false!

Item was added:
+ ----- Method: TParseNode>>hasSideEffect (in category 'testing') -----
+ hasSideEffect
+       "Answer if the parse tree rooted at this node has a side-effect or not.  By default assume it has.  Nodes that don't override."
+       ^true!

Item was changed:
  ----- Method: TParseNode>>isSameAs: (in category 'comparing') -----
  isSameAs: aTParseNode
+       "Answer if the ParseTree rooted at this node is the same as aTParseNode.
+        By default answer false and have subclasses override as appropriate."
+       ^false!
-       ^self subclassResponsibility!

Item was added:
+ ----- Method: TSendNode>>hasSideEffect (in category 'as yet unclassified') -----
+ hasSideEffect
+       "Answer if the parse tree rooted at this node has a side-effect or not."
+       ^(#(#+ #- #* #/ #// #\\ #= #== #~= #~~) includes: selector) not!

Item was added:
+ ----- Method: TStmtListNode>>isSameAs: (in category 'testing') -----
+ isSameAs: aTParseNode
+       (aTParseNode isStmtList
+        and: [statements size = aTParseNode statements size]) ifFalse:
+               [^false].
+       statements with: aTParseNode statements do:
+               [:mine :theirs|
+                (mine isSameAs: theirs) ifFalse:
+                       [^false]].
+       ^true!

Item was changed:
  ----- Method: TSwitchStmtNode>>createCasesFromBraceNode: (in category 'instance initialization') -----
  createCasesFromBraceNode: aTBraceNode
+       "Answer a sequence of tuples of { labels. case } for a TBraceNode, making
+        sure to collect equivalent cases together under a signle sequence of labels."
        | casesToStrings stringsToLabels newCases |
        casesToStrings := Dictionary new.
        stringsToLabels := Dictionary new.
        newCases := OrderedCollection new: aTBraceNode caseLabels size.
        aTBraceNode caseLabels with: aTBraceNode cases do:
                [:label :case| | printString |
                printString := casesToStrings at: case put: case printString.
                (stringsToLabels at: printString ifAbsentPut: [OrderedCollection new]) addLast: label].

        aTBraceNode caseLabels with: aTBraceNode cases do:
                [:label :case| | printString labels |
                printString := casesToStrings at: case.
                label = (labels := (stringsToLabels at: printString) asArray) first ifTrue:
                        [newCases addLast: { labels collect: [:ea| ea statements first]. case}]].

        ^newCases!

Item was added:
+ ----- Method: TVariableNode>>hasSideEffect (in category 'as yet unclassified') -----
+ hasSideEffect
+       "Answer if the parse tree rooted at this node has a side-effect or not."
+       ^false!

Hi Ben,

On Wed, Nov 18, 2015 at 3:05 PM, Ben Coman <[hidden email]> wrote:

On Thu, Nov 19, 2015 at 1:58 AM, Eliot Miranda <[hidden email]> wrote:
>
> On Tue, Nov 17, 2015 at 10:23 PM, Ryan Macnak <[hidden email]> wrote:
>>
>> This commit also broke the stack VMs, so something's probably amiss with the Slang changes.

I'm not sure if a lightbulb just went on or my intuition misleads me.
How does Slang related to the interpreter?
i.e. Is it Slang that the interpreter interprets?

The VM is written as a Smalltalk program.  There are three different versions of the interpreter in it, Interpreter, which is a classical blue-book interpreter that uses context objects to represent method activations, the STackInterpreter that avoids creating contexts as much as possible and uses stack frames to represent method activations, and CoInterpreter, a subclass of StackInterpreter that can interoperate with the JIT so that machine code can execute Smalltalk on its own, interleaved with the CoInterpreter interpreting methods that have yet to be fitted or are judged too big to be worth jitting.  All of these interpreters interpret Smalltalk bytecocde methods.  They contain methods like the following, which is the pushInstVar byte code used to push an instance variable of the receiver onto the stack:

pushReceiverVariableBytecode

<expandCases>

self pushReceiverVariable: (currentBytecode bitAnd: 16rF).

self fetchNextBytecode

pushReceiverVariable: fieldIndex

self internalPush: (objectMemory fetchPointer: fieldIndex ofObject: self receiver).

All three implement their interpreter as a loop that indexes an Array of selectors for each byte code of methods like the above:

StackInterpreterSimulator>>run

"Just run"

quitBlock := [displayView ifNotNil:

  [displayView containingWindow ifNotNil:

[:topWindow|

((World submorphs includes: topWindow)

and: [UIManager default confirm: 'close?']) ifTrue:

[topWindow delete]]].

 ^self].

self initStackPages.

self loadInitialContext.

self internalizeIPandSP.

self fetchNextBytecode.

[true] whileTrue:

[self assertValidExecutionPointers.

atEachStepBlock value. "N.B. may be nil"

self dispatchOn: currentBytecode in: BytecodeTable.

self incrementByteCount].

localIP := localIP - 1.

"undo the pre-increment of IP before returning"

self externalizeIPandSP

dispatchOn: anInteger in: selectorArray

"Simulate a case statement via selector table lookup.

The given integer must be between 0 and selectorArray size-1, inclusive.

For speed, no range test is done, since it is done by the at: operation."

self perform: (selectorArray at: (anInteger + 1)).

The BytecodeTable has 256 entries.  Depending on the byte code set the first 16 elements might be #pushReceiverVariableBytecode, the next 16 #pushTemporaryVariableBytecode and so on.

This is fine for developing the VM but can't yield useful performance in practice.  We need somehow to translate the Smalltalk code into something a real machine can run.  We do this in two steps.  First, the Smalltalk code is converted from Smalltalk to C.  This is "trivial" because in fact the VM is written in a subset of C that is "trivially" translatable to C.  There are no Dictionaries or Sets in the bowels of the VM, just whole and for looks and performs mapped either to inlining of code or to calling through function pointers.  The thing that does the Smalltalk to C translation is called Slang.  The pours trees of the methods of the VM are translated into Slang's parse trees which in turn implement analysis and output code that allows the entire VM to be written out as a C program.  The last step is to compile this using a common or garden C compiler.

Here's what the code of the interpreter loop looks like.  You'll be curious about the <expandCases> pragma above in pushReceiverVariableBytecode.  It and a couple of other pragmas are used to guide Slang in producing the interpreter loop's C code:

        /* begin internalizeIPandSP */

        localIP = pointerForOop(GIV(instructionPointer));

        localSP = pointerForOop(GIV(stackPointer));

        localFP = pointerForOop(GIV(framePointer));

        /* begin fetchNextBytecode */

        currentBytecode = byteAtPointer(++localIP);

        /* begin initExtensions */

        while (1) {

                bytecodeDispatchDebugHook();

                VM_LABEL(bytecodeDispatch);

                switch (currentBytecode) {

                case 0:

                        /* pushReceiverVariableBytecode */

                        {

                                VM_LABEL(pushReceiverVariableBytecode);

                                /* begin fetchNextBytecode */

                                currentBytecode = byteAtPointer(++localIP);

                                /* begin pushReceiverVariable: */

                                /* begin internalPush: */

                                longAtPointerput((localSP -= BytesPerOop), longAt(((longAt(localFP + FoxReceiver)) + BaseHeaderSize)));

                        }

                        break;

                case 1:

                        /* pushReceiverVariableBytecode */

                        {

                                VM_LABEL(pushReceiverVariableBytecode1);

                                /* begin fetchNextBytecode */

                                currentBytecode = byteAtPointer(++localIP);

                                /* begin pushReceiverVariable: */

                                /* begin internalPush: */

                                longAtPointerput((localSP -= BytesPerOop), longAt(((longAt(localFP + FoxReceiver)) + BaseHeaderSize) + 4 /* (currentBytecode bitAnd: 15) << self shiftForWord */));

                        }

                        break;

 

So we get to develop the VM in Smalltalk, but the code is reasonably well compiled by a C compiler and hence acceptably efficiently executed by a commodity microprocessor.

And of course the Cogit is another story :-)

_,,,^..^,,,_

best, Eliot