Vm-dev May 2019

vm-dev@lists.squeakfoundation.org

20 participants
76 discussions

Some more effort to make Slang and VMMaker work on Pharo [for review]
by Guillermo Polito 09 May '19

09 May '19

Hi all, In the last couple of days I've worked a bit on making VMMaker work in Pharo again, based on the original effort of Eliot. I've produced a couple of patches that I've left in the VMMaker inbox (below I past the commits' info). With these changes I was able to generate, compile and run successfully so far the Stack VM on OSX (mojave). I've tried it with opensmalltalk-vm's platform code commit a838346b1, which is a commit previous to the migration to Metal. To make this work I've written some tests too. I've packaged them so far in a separate package (VMMaker-Tests). I've seen that currently VMMaker tests are inside the VMMaker package itself, but some of them are red in Pharo. I can move those tests to the VMMaker package itself if people see a value on them. In any case, I'm just submitting this for review :). Cheers, Guille ==== Patch 1 ==== Name: VMMaker.oscog-GAP.2533 Author: GAP Time: 7 May 2019, 10:57:16.034354 am UUID: 3209319f-60f3-4586-8d03-cfac3c9fddee Ancestors: VMMaker.oscog-eem.2532 Convert numeric constants to strings for concatenation. Required for Pharo compatibility, where the arguments of concatenation are not automatically coerced to strings. ==== Patch 2 - Pharo specific package ==== Name: VMMakerCompatibilityForPharo6-GuillermoPolito.10 Author: GuillermoPolito Time: 7 May 2019, 11:03:08.229705 am UUID: 4f49f938-aa44-0d00-8739-04000059f8ce Ancestors: VMMakerCompatibilityForPharo6-eem.9 Fixes in AST translation to make it work as in Squeak - to:do: => to:by:do: with extra arguments - ifNil:ifNotNil: => ifTrue:ifFalse: - fix arguments in TMethods - fix comments in TMethods - add name at the level of TParseNode (#name is not defined in Object anymore in Pharo) Other - Added FileDirectory compatibility layer using FileSystem behind the scenes (see FileDirectory and VMMakerFile classes). - Added PackageOrganizer compatibility layer using RPackage behind the scenes. - Extending Scanner and SystemNavigation with compatibility methods - Extending Time with compatibility method ==== Patch 3 - Tests ==== Name: VMMakerTests-GuillermoPolito.1 Author: GuillermoPolito Time: 7 May 2019, 11:27:14.195596 am UUID: 77f9288f-aa44-0d00-873a-d0970059f8ce Ancestors: Tests for AST translation and C code generation

4 5

VM Maker: VMMakerCompatibilityForPharo6-GuillermoPolito.12.mcz
by commits＠source.squeak.org 09 May '19

09 May '19

Guillermo Polito uploaded a new version of VMMakerCompatibilityForPharo6 to project VM Maker: http://source.squeak.org/VMMaker/VMMakerCompatibilityForPharo6-GuillermoPol… ==================== Summary ==================== Name: VMMakerCompatibilityForPharo6-GuillermoPolito.12 Author: GuillermoPolito Time: 9 May 2019, 5:44:58.893868 pm UUID: 9f94c311-d844-0d00-b3c4-7c560f1a7e9a Ancestors: VMMakerCompatibilityForPharo6-GuillermoPolito.11 Moved tests to Pharo compatibility package =============== Diff against VMMakerCompatibilityForPharo6-GuillermoPolito.11 =============== Item was changed: SystemOrganization addCategory: #VMMakerCompatibilityForPharo6! SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-FileDirectoryToFileSystem'! SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-Kernel-Methods'! SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-PackageOrganizer'! SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-SUnit-Extensions'! SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-System'! + SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-Tests'! Item was changed: DisplayObject subclass: #DisplayText instanceVariableNames: 'text textStyle offset form foreColor backColor' classVariableNames: '' poolDictionaries: 'TextConstants' + category: 'VMMakerCompatibilityForPharo6-System'! - category: 'VMMakerCompatibilityForPharo6'! !DisplayText commentStamp: '<historical>' prior: 0! I represent Text whose emphasis changes are mapped to a set of fonts. My instances have an offset used in determining screen placement for displaying. They get used two different ways in the system. In the user interface, they mainly hold onto some text which is viewed by some form of ParagraphEditor. However, as a DisplayObject, they may need to display efficiently, so my instances have a cache for the bits.! Item was changed: WriteStream subclass: #TranscriptStream instanceVariableNames: 'lastChar' classVariableNames: 'AccessSema CharacterLimit ForceUpdate RedirectToStdOut' poolDictionaries: '' + category: 'VMMakerCompatibilityForPharo6-System'! - category: 'VMMakerCompatibilityForPharo6'! !TranscriptStream commentStamp: 'fbs 12/30/2013 09:53' prior: 0! This class is a much simpler implementation of Transcript protocol that supports multiple views and very simple conversion to morphic. Because it inherits from Stream, it is automatically compatible with code that is designed to write to streams.! Item was added: + TestCase subclass: #VMCodeGenerationTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMakerCompatibilityForPharo6-Tests'! Item was added: + ----- Method: VMCodeGenerationTest>>methodWithIfNil (in category 'generation-targets') ----- + methodWithIfNil + + self something + ifNil: [ 1 ] + ifNotNil: [ 2 ]! Item was added: + ----- Method: VMCodeGenerationTest>>methodWithIfNilAssignment (in category 'generation-targets') ----- + methodWithIfNilAssignment + + | variable | + variable := self something + ifNil: [ 1 ] + ifNotNil: [ 2 ]! Item was added: + ----- Method: VMCodeGenerationTest>>methodWithIfNilAssignmentOfComplexStatements (in category 'generation-targets') ----- + methodWithIfNilAssignmentOfComplexStatements + + | variable | + variable := self something + ifNil: [ | temp | + temp := 1. + temp := temp + 1. + temp * 3 ] + ifNotNil: [ | temp | + temp := 2. + temp := temp + 5. + temp * 3 ]! Item was added: + ----- Method: VMCodeGenerationTest>>methodWithLoop (in category 'generation-targets') ----- + methodWithLoop + + 1 to: 10 do: [ :i | self foo: i ]! Item was added: + ----- Method: VMCodeGenerationTest>>methodWithNilIfNil (in category 'generation-targets') ----- + methodWithNilIfNil + + ^ nil + ifNil: [ 1 ] + ifNotNil: [ 2 ]! Item was added: + ----- Method: VMCodeGenerationTest>>testComplexIfNilAssignment (in category 'tests') ----- + testComplexIfNilAssignment + + | translation method codeGenerator result | + method := self class >> #methodWithIfNilAssignmentOfComplexStatements. + translation := method asTranslationMethodOfClass: TMethod. + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator addMethod: translation. + codeGenerator doInlining: true. + + result := String streamContents: [ :stream | + translation parseTree statements first emitCCodeOn: stream level: 0 generator: codeGenerator. + ]. + + self assert: result equals: 'if ((something()) == null) { + temp = 1; + temp += 1; + variable = temp * 3; + } + else { + temp = 2; + temp += 5; + variable = temp * 3; + }'! Item was added: + ----- Method: VMCodeGenerationTest>>testLoopVariableIsTemp (in category 'tests') ----- + testLoopVariableIsTemp + + | translation method codeGenerator result | + method := self class >> #methodWithLoop. + translation := method asTranslationMethodOfClass: TMethod. + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator doInlining: true. + + result := String streamContents: [ :stream | + translation emitCCodeOn: stream generator: codeGenerator. + ]. + + self assert: result equals: ' + /* VMCodeGenerationTest>>#methodWithLoop */ + static sqInt + methodWithLoop(void) + { + sqInt i; + + for (i = 1; i <= 10; i += 1) { + foo(i); + } + return self; + } + '! Item was added: + ----- Method: VMCodeGenerationTest>>testNilIfNilGeneratesOnlyFirstBranch (in category 'tests') ----- + testNilIfNilGeneratesOnlyFirstBranch + + | translation method codeGenerator result | + method := self class >> #methodWithNilIfNil. + translation := method asTranslationMethodOfClass: TMethod. + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator generateDeadCode: false. + codeGenerator addMethod: translation. + codeGenerator doInlining: true. + + result := String streamContents: [ :stream | + translation parseTree statements first emitCCodeOn: stream level: 0 generator: codeGenerator. + ]. + + self assert: result equals: 'return 1'! Item was added: + ----- Method: VMCodeGenerationTest>>testSimpleIfNil (in category 'tests') ----- + testSimpleIfNil + + | translation method codeGenerator result | + method := self class >> #methodWithIfNilAssignment. + translation := method asTranslationMethodOfClass: TMethod. + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator generateDeadCode: false. + codeGenerator addMethod: translation. + codeGenerator doInlining: true. + + result := String streamContents: [ :stream | + translation parseTree statements first emitCCodeOn: stream level: 0 generator: codeGenerator. + ]. + + self assert: result equals: 'variable = ((something()) == null + ? 1 + : 2)'! Item was added: + ----- Method: VMCodeGenerationTest>>testSimpleIfNilAssignment (in category 'tests') ----- + testSimpleIfNilAssignment + + | translation method codeGenerator result | + method := self class >> #methodWithIfNil. + translation := method asTranslationMethodOfClass: TMethod. + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator generateDeadCode: false. + codeGenerator addMethod: translation. + codeGenerator doInlining: true. + + result := String streamContents: [ :stream | + translation parseTree statements first emitCCodeOn: stream level: 0 generator: codeGenerator. + ]. + + self assert: result equals: 'if ((something()) == null) { + } + else { + }'! Item was added: + TestCase subclass: #VMMASTTranslationTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMakerCompatibilityForPharo6-Tests'! Item was added: + ----- Method: VMMASTTranslationTest>>+ (in category 'generation-targets') ----- + + arg! Item was added: + ----- Method: VMMASTTranslationTest>>emptyBlockHasSingleNilStatement (in category 'generation-targets') ----- + emptyBlockHasSingleNilStatement + + [ ] value! Item was added: + ----- Method: VMMASTTranslationTest>>inlineMethodWithLoop (in category 'generation-targets') ----- + inlineMethodWithLoop + + self methodWithLoop! Item was added: + ----- Method: VMMASTTranslationTest>>inlineSecondLevelMethodWithLoop (in category 'generation-targets') ----- + inlineSecondLevelMethodWithLoop + + self inlineMethodWithLoop! Item was added: + ----- Method: VMMASTTranslationTest>>inlineTwiceMethodWithLoop (in category 'generation-targets') ----- + inlineTwiceMethodWithLoop + + self methodWithLoop. + self methodWithLoop! Item was added: + ----- Method: VMMASTTranslationTest>>inlineTwiceSecondLevelMethodWithLoop (in category 'generation-targets') ----- + inlineTwiceSecondLevelMethodWithLoop + + self inlineMethodWithLoop. + self inlineMethodWithLoop! Item was added: + ----- Method: VMMASTTranslationTest>>methodWithArgument: (in category 'generation-targets') ----- + methodWithArgument: anArgument! Item was added: + ----- Method: VMMASTTranslationTest>>methodWithIfNil (in category 'generation-targets') ----- + methodWithIfNil + + self something + ifNil: [ 1 ] + ifNotNil: [ 2 ]! Item was added: + ----- Method: VMMASTTranslationTest>>methodWithIfNilIfNotNil (in category 'generation-targets') ----- + methodWithIfNilIfNotNil + + self something + ifNil: [ 1 ] + ifNotNil: [ 2 ] + ! Item was added: + ----- Method: VMMASTTranslationTest>>methodWithIfNilIfNotNilWithArgument (in category 'generation-targets') ----- + methodWithIfNilIfNotNilWithArgument + + self something + ifNil: [ ] + ifNotNil: [ :soSomething | self lala: soSomething ]! Item was added: + ----- Method: VMMASTTranslationTest>>methodWithIfNotNilIfNil (in category 'generation-targets') ----- + methodWithIfNotNilIfNil + + self something + ifNotNil: [ 1 ] + ifNil: [ 2 ]! Item was added: + ----- Method: VMMASTTranslationTest>>methodWithIfNotNilIfNilWithArgument (in category 'generation-targets') ----- + methodWithIfNotNilIfNilWithArgument + + self something + ifNotNil: [ :soSomething | self lala: soSomething ] + ifNil: [ ]! Item was added: + ----- Method: VMMASTTranslationTest>>methodWithIfNotNilWithArgument (in category 'generation-targets') ----- + methodWithIfNotNilWithArgument + + self something ifNotNil: [ :soSomething | + self lala: soSomething ]! Item was added: + ----- Method: VMMASTTranslationTest>>methodWithLoop (in category 'generation-targets') ----- + methodWithLoop + + 1 to: 10 do: [ :i | self foo: i ]! Item was added: + ----- Method: VMMASTTranslationTest>>methodWithNoArguments (in category 'generation-targets') ----- + methodWithNoArguments! Item was added: + ----- Method: VMMASTTranslationTest>>testArgumentIsNoTemp (in category 'tests') ----- + testArgumentIsNoTemp + + | translation method | + method := (self class >> #methodWithArgument:). + translation := method asTranslationMethodOfClass: TMethod. + + self deny: (translation locals includes: method methodNode arguments first name)! Item was added: + ----- Method: VMMASTTranslationTest>>testComplexIfNilIfNotNilWithArgument (in category 'tests') ----- + testComplexIfNilIfNotNilWithArgument + + | translation method codeGenerator assignment conditional condition | + method := (self class >> #methodWithIfNilIfNotNilWithArgument). + translation := method asTranslationMethodOfClass: TMethod. + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator addMethod: translation. + codeGenerator doInlining: true. + + self assert: translation parseTree statements size equals: 3. + assignment := translation parseTree statements first. + self assert: assignment expression isSend. + self assert: assignment expression receiver name equals: 'self'. + self assert: assignment expression selector equals: #something. + self assert: assignment isAssignment. + + conditional := translation parseTree statements second. + self assert: conditional isSend. + self assert: conditional selector equals: #ifTrue:ifFalse:. + self assert: conditional args first isStmtList. + self assert: conditional args second isStmtList. + self assert: conditional args first args isEmpty. + self assert: conditional args second args notEmpty. + + condition := conditional receiver. + self assert: condition isSend. + self assert: condition selector equals: #==. + self assert: condition receiver name equals: conditional args second args first. + self assert: condition args first name equals: 'nil'.! Item was added: + ----- Method: VMMASTTranslationTest>>testComplexIfNotNilIfNilWithArgument (in category 'tests') ----- + testComplexIfNotNilIfNilWithArgument + + | translation method codeGenerator assignment conditional condition | + method := (self class >> #methodWithIfNilIfNotNilWithArgument). + translation := method asTranslationMethodOfClass: TMethod. + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator addMethod: translation. + codeGenerator doInlining: true. + + self assert: translation parseTree statements size equals: 3. + assignment := translation parseTree statements first. + self assert: assignment expression isSend. + self assert: assignment expression receiver name equals: 'self'. + self assert: assignment expression selector equals: #something. + self assert: assignment isAssignment. + + conditional := translation parseTree statements second. + self assert: conditional isSend. + self assert: conditional selector equals: #ifTrue:ifFalse:. + self assert: conditional args first isStmtList. + self assert: conditional args second isStmtList. + self assert: conditional args first args isEmpty. + self assert: conditional args second args notEmpty. + + condition := conditional receiver. + self assert: condition isSend. + self assert: condition selector equals: #==. + self assert: condition receiver name equals: conditional args second args first. + self assert: condition args first name equals: 'nil'.! Item was added: + ----- Method: VMMASTTranslationTest>>testComplexIfNotNilWithArgument (in category 'tests') ----- + testComplexIfNotNilWithArgument + + | translation method codeGenerator assignment conditional condition | + method := (self class >> #methodWithIfNotNilWithArgument). + translation := method asTranslationMethodOfClass: TMethod. + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator addMethod: translation. + codeGenerator doInlining: true. + + self assert: translation parseTree statements size equals: 3. + assignment := translation parseTree statements first. + self assert: assignment isAssignment. + + conditional := translation parseTree statements second. + self assert: conditional isSend. + self assert: conditional selector equals: #ifFalse:. + self assert: conditional args first isStmtList. + self assert: conditional args first args notEmpty. + + condition := conditional receiver. + self assert: condition isSend. + self assert: condition selector equals: #==. + self assert: condition receiver name equals: conditional args first args first. + self assert: condition args first name equals: 'nil'.! Item was added: + ----- Method: VMMASTTranslationTest>>testEmptyBlockGeneratesSingleNilStatement (in category 'tests') ----- + testEmptyBlockGeneratesSingleNilStatement + + | translation method codeGenerator block | + method := (self class >> #emptyBlockHasSingleNilStatement). + translation := method asTranslationMethodOfClass: TMethod. + + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator addMethod: translation. + codeGenerator doInlining: true. + + block := translation statements first receiver. + self assert: block statements size equals: 1. + self assert: block statements first name equals: 'nil'! Item was added: + ----- Method: VMMASTTranslationTest>>testIfNilIfNotNilBecomesIfTrueIfFalse (in category 'tests') ----- + testIfNilIfNotNilBecomesIfTrueIfFalse + + | translation | + translation := (self class >> #methodWithIfNil) asTranslationMethodOfClass: TMethod. + + self assert: translation statements first selector equals: #ifTrue:ifFalse:! Item was added: + ----- Method: VMMASTTranslationTest>>testIfNilIfNotNilDoesNotInvertBlocks (in category 'tests') ----- + testIfNilIfNotNilDoesNotInvertBlocks + + | translation | + translation := (self class >> #methodWithIfNilIfNotNil) asTranslationMethodOfClass: TMethod. + + self assert: translation statements first selector equals: #ifTrue:ifFalse:. + self assert: translation statements first args first statements first value equals: 1. + self assert: translation statements first args second statements first value equals: 2.! Item was added: + ----- Method: VMMASTTranslationTest>>testIfNotNilIfNilInversesBlocks (in category 'tests') ----- + testIfNotNilIfNilInversesBlocks + + | translation | + translation := (self class >> #methodWithIfNotNilIfNil) asTranslationMethodOfClass: TMethod. + + self assert: translation statements first selector equals: #ifTrue:ifFalse:. + self assert: translation statements first args first statements first value equals: 2. + self assert: translation statements first args second statements first value equals: 1! Item was added: + ----- Method: VMMASTTranslationTest>>testInlineMethodWithLoopDeclaresLoopIndexVariable (in category 'tests') ----- + testInlineMethodWithLoopDeclaresLoopIndexVariable + + | translation codeGenerator inlinedMethod | + translation := (self class >> #inlineMethodWithLoop) asTranslationMethodOfClass: TMethod. + inlinedMethod := ((self class >> #methodWithLoop) asTranslationMethodOfClass: TMethod). + + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator addMethod: translation. + codeGenerator addMethod: inlinedMethod. + codeGenerator doInlining: true. + + self assert: (translation locals includesAll: inlinedMethod locals)! Item was added: + ----- Method: VMMASTTranslationTest>>testInlineSecondLevelMethodWithLoopDeclaresLoopIndexVariable (in category 'tests') ----- + testInlineSecondLevelMethodWithLoopDeclaresLoopIndexVariable + + | translation codeGenerator inlinedMethods | + translation := (self class >> #inlineSecondLevelMethodWithLoop) asTranslationMethodOfClass: TMethod. + inlinedMethods := #( inlineMethodWithLoop methodWithLoop ) collect: [ :s | ((self class >> s) asTranslationMethodOfClass: TMethod)]. + + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator addMethod: translation. + inlinedMethods do: [ :e | + codeGenerator addMethod: e ]. + codeGenerator doInlining: true. + + self assert: translation locals size equals: 1! Item was added: + ----- Method: VMMASTTranslationTest>>testInlineTwiceMethodWithLoopDeclaresTwiceLoopIndexVariable (in category 'tests') ----- + testInlineTwiceMethodWithLoopDeclaresTwiceLoopIndexVariable + + | translation codeGenerator inlinedMethod | + translation := (self class >> #inlineTwiceMethodWithLoop) asTranslationMethodOfClass: TMethod. + inlinedMethod := ((self class >> #methodWithLoop) asTranslationMethodOfClass: TMethod). + + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator addMethod: translation. + codeGenerator addMethod: inlinedMethod. + codeGenerator doInlining: true. + + self assert: translation locals size equals: 2! Item was added: + ----- Method: VMMASTTranslationTest>>testInlineTwiceSecondLevelMethodWithLoopDeclaresLoopIndexVariable (in category 'tests') ----- + testInlineTwiceSecondLevelMethodWithLoopDeclaresLoopIndexVariable + + | translation codeGenerator inlinedMethods | + translation := (self class >> #inlineTwiceSecondLevelMethodWithLoop) asTranslationMethodOfClass: TMethod. + inlinedMethods := #( inlineMethodWithLoop methodWithLoop ) collect: [ :s | ((self class >> s) asTranslationMethodOfClass: TMethod)]. + + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator addMethod: translation. + inlinedMethods do: [ :e | + codeGenerator addMethod: e ]. + codeGenerator doInlining: true. + + self assert: translation locals size equals: 2! Item was added: + ----- Method: VMMASTTranslationTest>>testKeywordMethodHasArgument (in category 'tests') ----- + testKeywordMethodHasArgument + + | translation method | + method := self class >> #methodWithArgument:. + translation := method asTranslationMethodOfClass: TMethod. + + self assert: (translation args includes: method methodNode arguments first name)! Item was added: + ----- Method: VMMASTTranslationTest>>testMethodWithLoopDeclaresLoopIndexVariable (in category 'tests') ----- + testMethodWithLoopDeclaresLoopIndexVariable + + | translation method block | + method := self class >> #methodWithLoop. + translation := method asTranslationMethodOfClass: TMethod. + + block := method methodNode statements first arguments second. + self deny: (translation locals includes: block arguments first)! Item was added: + ----- Method: VMMASTTranslationTest>>testTranslateBinaryMethodHasSameName (in category 'tests') ----- + testTranslateBinaryMethodHasSameName + + | translation | + translation := self class >> #+ asTranslationMethodOfClass: TMethod. + + self assert: translation selector equals: #+.! Item was added: + ----- Method: VMMASTTranslationTest>>testTranslateKeywordMethodHasSameName (in category 'tests') ----- + testTranslateKeywordMethodHasSameName + + | translation method | + method := self class >> #methodWithArgument:. + translation := method asTranslationMethodOfClass: TMethod. + + self assert: translation selector equals: method selector.! Item was added: + ----- Method: VMMASTTranslationTest>>testTranslateUnaryMethodHasSameName (in category 'tests') ----- + testTranslateUnaryMethodHasSameName + + | translation method | + method := self class >> #methodWithNoArguments. + translation := method asTranslationMethodOfClass: TMethod. + + self assert: translation selector equals: method selector.!

1 0

VM Maker: VMMakerCompatibilityForPharo6-GuillermoPolito.11.mcz
by commits＠source.squeak.org 09 May '19

09 May '19

1 0

VM Maker Inbox: VMMakerCompatibilityForPharo6-GuillermoPolito.11.mcz
by commits＠source.squeak.org 09 May '19

09 May '19

Guillermo Polito uploaded a new version of VMMakerCompatibilityForPharo6 to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMakerCompatibilityForPharo6-Guiller… ==================== Summary ==================== Name: VMMakerCompatibilityForPharo6-GuillermoPolito.11 Author: GuillermoPolito Time: 9 May 2019, 5:15:50.00473 pm UUID: e1a685a9-d744-0d00-b3c1-ad600f1a7e9a Ancestors: VMMakerCompatibilityForPharo6-GuillermoPolito.10 Fixes to correctly translate ifNotNil: [:arg & variants. This makes Cog compile and run. =============== Diff against VMMakerCompatibilityForPharo6-GuillermoPolito.10 =============== Item was added: + ----- Method: FileDirectory class>>baseNameFor: (in category 'accessing') ----- + baseNameFor: aString + + ^ aString asFileReference basename! Item was changed: ----- Method: RBBlockNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of me" | statementList | statementList := OrderedCollection new. body statements do: [:s | | newS | newS := s asTranslatorNodeIn: aTMethod. "inline the statement list returned when a CascadeNode is translated and/or when ifNotNil: is transformed" newS isStmtList ifTrue: [statementList addAll: newS statements] ifFalse: [statementList add: newS]]. + statementList ifEmpty: [ + statementList add: (TVariableNode new setName: 'nil'). + ]. ^TStmtListNode new setArguments: (arguments asArray collect: [:arg | arg name]) statements: statementList; comment: self commentOrNil! Item was changed: ----- Method: RBMessageNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of me" "selector is sometimes a Symbol, sometimes a SelectorNode!! On top of this, numArgs is needed due to the (truly grody) use of arguments as a place to store the extra expressions needed to generate code for in-line to:by:do:, etc. see below, where it is used. Expand super nodes in place. Elide sends of halt so that halts can be sprinkled through the simulator but will be eliminated from the generated C." | usedSelector rcvrOrNil args | usedSelector := selector. rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod]. (rcvrOrNil notNil and: [rcvrOrNil isVariable and: [rcvrOrNil name = 'super']]) ifTrue: [^aTMethod superExpansionNodeFor: usedSelector args: arguments]. usedSelector == #halt ifTrue: [^rcvrOrNil]. (usedSelector == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." or: [usedSelector == #cCode:]) ifTrue: [arguments first isBlockNode ifTrue: [| block | ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1 ifTrue: [block statements first] ifFalse: [block]]. (arguments first isLiteralNode and: [arguments first value isString and: [arguments first value isEmpty]]) ifTrue: [^arguments first asTranslatorNodeIn: aTMethod]]. args := arguments collect: [:arg| arg asTranslatorNodeIn: aTMethod]. (usedSelector == #to:do:) ifTrue: [ | block | usedSelector := #to:by:do:. block := args second. args := OrderedCollection with: args first with: (TConstantNode new setValue: 1) with: args second with: (TAssignmentNode new setVariable: (arguments first asTranslatorNodeIn: aTMethod) expression: (TConstantNode new setValue: 1); yourself) with: (TSendNode new setSelector: #<= receiver: (TVariableNode new setName: block args first) arguments: { receiver asTranslatorNodeIn: aTMethod }) with: (TAssignmentNode new setVariable: (TVariableNode new setName: block args first) expression: (TSendNode new setSelector: #+ receiver: (TVariableNode new setName: block args first) arguments: { TConstantNode new setValue: 1 }); yourself) ]. + "If in the form of ifNil: [ :obj | ], replace that by an assignment and an ifFalse" + ((usedSelector == #ifNotNil:) and: [ args first args notEmpty ]) ifTrue: [ + ^ TStmtListNode new + setArguments: #(); + setStatements: { + TAssignmentNode new + setVariable: (TVariableNode new setName: args first args first) + expression: rcvrOrNil. + + TSendNode new + setSelector: #ifFalse: + receiver: (TSendNode new + setSelector: #== + receiver: (TVariableNode new setName: args first args first) + arguments: {(TVariableNode new setName: 'nil')}; + yourself) + arguments: {args first} + }; + yourself ]. + + (#(#ifNotNil:ifNil: #ifNil:ifNotNil:) includes: usedSelector) ifTrue: [ | comparand expression blockWithPossibleArgument | + "We turn it always to an ifTrueIfFalse" + usedSelector = #ifNotNil:ifNil: + ifTrue: [ args := args reversed ]. + blockWithPossibleArgument := args second. + expression := rcvrOrNil. + comparand := blockWithPossibleArgument args + ifEmpty: [ expression ] + ifNotEmpty: [ (TVariableNode new setName: blockWithPossibleArgument args first) ]. + + usedSelector := #ifTrue:ifFalse:. + rcvrOrNil := TSendNode new + setSelector: #== + receiver: comparand + arguments: { TVariableNode new setName: 'nil' }. + + "If there is a variable we should epand the message as a statement" + blockWithPossibleArgument args notEmpty ifTrue: [ + ^ TStmtListNode new + setArguments: #(); + setStatements: { + TAssignmentNode new + setVariable: (TVariableNode new setName: blockWithPossibleArgument args first) + expression: expression. + + TSendNode new + setSelector: usedSelector + receiver: rcvrOrNil + arguments: args + }; + yourself + ] ]. + (usedSelector == #ifNil:ifNotNil:) ifTrue: [ usedSelector := #ifTrue:ifFalse:. rcvrOrNil := TSendNode new setSelector: #== receiver: rcvrOrNil arguments: { TVariableNode new setName: 'nil' } ]. (usedSelector == #ifTrue:ifFalse: and: [arguments first statements isEmpty]) ifTrue: [usedSelector := #ifFalse:. args := {args last}]. (usedSelector == #ifTrue:ifFalse: and: [arguments last statements isEmpty]) ifTrue: [usedSelector := #ifTrue:. args := {args first}]. (usedSelector == #ifFalse:ifTrue: and: [arguments first statements isEmpty]) ifTrue: [usedSelector := #ifTrue:. args := {args last}]. (usedSelector == #ifFalse:ifTrue: and: [arguments last statements isEmpty]) ifTrue: [usedSelector := #ifTrue:. args := {args first}]. ((usedSelector == #ifFalse: or: [usedSelector == #or:]) and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue: ["Restore argument block that got moved by transformOr: or transformIfFalse:" args := {(arguments at: 2) asTranslatorNodeIn: aTMethod}]. (args size > usedSelector numArgs and: [usedSelector ~~ #to:by:do:]) ifTrue: "to:by:do: has iLimiT hidden in last arg" ["prune the extra blocks left by ifTrue:, ifFalse:, and: & or:" self assert: args size - usedSelector numArgs = 1. self assert: (args last isStmtList and: [args last statements size = 1 and: [(args last statements first isVariable or: [args last statements first isConstant]) and: [#('nil' true false) includes: args last statements first nameOrValue]]]). args := args first: usedSelector numArgs]. ((CCodeGenerator isVarargsSelector: usedSelector) and: [args last isCollection and: [args last isSequenceable]]) ifTrue: [args := args allButLast, args last]. ^TSendNode new setSelector: usedSelector receiver: rcvrOrNil arguments: args!

1 0

VM Maker: VMMakerCompatibilityForPharo6-GuillermoPolito.10.mcz
by commits＠source.squeak.org 09 May '19

09 May '19

1 0

VM Maker Inbox: VMMaker.oscog-GAP.2534.mcz
by commits＠source.squeak.org 09 May '19

09 May '19

A new version of VMMaker was added to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMaker.oscog-GAP.2534.mcz ==================== Summary ==================== Name: VMMaker.oscog-GAP.2534 Author: GAP Time: 9 May 2019, 5:12:22.055089 pm UUID: cd6aae16-6f20-4ddb-9328-64b19b413cb1 Ancestors: VMMaker.oscog-eem.2532 Convert numeric constants to strings for concatenation using #printString. Required for Pharo compatibility, where the arguments of concatenation are not automatically coerced to strings. =============== Diff against VMMaker.oscog-eem.2532 =============== Item was changed: ----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock "Enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct." "(CogAbstractInstruction withAllSubclasses reject: [:c| c name includesSubString: 'ForTests']) do: [:c| Transcript print: c; cr. c printTypedefOn: Transcript]" (self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do: [:ivn| aBinaryBlock value: ivn value: (ivn caseOf: { ['address'] -> [#usqInt]. "usqInt is always large enough to contain a pointer; we do not need to use usqIntptr_t" ['machineCode'] -> [self machineCodeDeclaration]. + ['operands'] -> [{#usqInt. '[', NumOperands printString, ']'}]. - ['operands'] -> [{#usqInt. '[', NumOperands, ']'}]. ['dependent'] -> ['struct _AbstractInstruction *']} otherwise: [#'unsigned char'])]! Item was changed: ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator #( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation' 'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass' 'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses' 'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters' 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do: [:simulationVariableNotNeededForRealVM| aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM]. NewspeakVM ifFalse: [#( 'selfSendTrampolines' 'dynamicSuperSendTrampolines' 'implicitReceiverSendTrampolines' 'outerSendTrampolines' 'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do: [:variableNotNeededInNormalVM| aCCodeGenerator removeVariable: variableNotNeededInNormalVM]]. aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time" aCCodeGenerator addHeaderFile:'<stddef.h>'; "for e.g. offsetof" addHeaderFile:'"sqCogStackAlignment.h"'; addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up" addHeaderFile:'"cogmethod.h"'. NewspeakVM ifTrue: [aCCodeGenerator addHeaderFile:'"nssendcache.h"']. aCCodeGenerator addHeaderFile:'#if COGMTVM'; addHeaderFile:'"cointerpmt.h"'; addHeaderFile:'#else'; addHeaderFile:'"cointerp.h"'; addHeaderFile:'#endif'; addHeaderFile:'"cogit.h"'. aCCodeGenerator var: #ceGetFP declareC: 'usqIntptr_t (*ceGetFP)(void)'; var: #ceGetSP declareC: 'usqIntptr_t (*ceGetSP)(void)'; var: #ceCaptureCStackPointers declareC: 'void (*ceCaptureCStackPointers)(void)'; var: #ceEnterCogCodePopReceiverReg declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)'; var: #realCEEnterCogCodePopReceiverReg declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)'; var: #ceCallCogCodePopReceiverReg declareC: 'void (*ceCallCogCodePopReceiverReg)(void)'; var: #realCECallCogCodePopReceiverReg declareC: 'void (*realCECallCogCodePopReceiverReg)(void)'; var: #ceCallCogCodePopReceiverAndClassRegs declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)'; var: #realCECallCogCodePopReceiverAndClassRegs declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)'; var: #ceFlushICache declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)'; var: #ceCheckFeaturesFunction declareC: 'static usqIntptr_t (*ceCheckFeaturesFunction)(void)'; var: #ceTryLockVMOwner declareC: 'usqIntptr_t (*ceTryLockVMOwner)(void)'; var: #ceUnlockVMOwner declareC: 'void (*ceUnlockVMOwner)(void)'; var: #postCompileHook declareC: 'void (*postCompileHook)(CogMethod *)'; var: #openPICList declareC: 'CogMethod *openPICList = 0'; var: #maxMethodBefore type: #'CogBlockMethod *'; var: 'enumeratingCogMethod' type: #'CogMethod *'. aCCodeGenerator declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel" var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel'; var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'. self declareC: #(abstractOpcodes stackCheckLabel blockEntryLabel blockEntryNoContextSwitch stackOverflowCall sendMiss entry noCheckEntry selfSendEntry dynSuperEntry fullBlockNoContextSwitchEntry fullBlockEntry picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 cPICEndOfCodeLabel) as: #'AbstractInstruction *' in: aCCodeGenerator. aCCodeGenerator declareVar: #blockStarts type: #'BlockStart *'; declareVar: #fixups type: #'BytecodeFixup *'. aCCodeGenerator var: #ordinarySendTrampolines declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]'; var: #superSendTrampolines declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'. BytecodeSetHasDirectedSuperSend ifTrue: [aCCodeGenerator var: #directedSuperSendTrampolines declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]'; var: #directedSuperBindingSendTrampolines declareC: 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]']. NewspeakVM ifTrue: [aCCodeGenerator var: #selfSendTrampolines declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]'; var: #dynamicSuperSendTrampolines declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]'; var: #implicitReceiverSendTrampolines declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]'; var: #outerSendTrampolines declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]']. aCCodeGenerator var: #trampolineAddresses declareC: 'static char *trampolineAddresses[NumTrampolines*2]'; var: #objectReferencesInRuntime declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]'; var: #labelCounter type: #int; var: #traceFlags declareC: 'int traceFlags = 8 /* prim trace log on by default */'; var: #cStackAlignment declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'. aCCodeGenerator declareVar: #CFramePointer type: #'void *'; declareVar: #CStackPointer type: #'void *'; declareVar: #minValidCallAddress type: #'usqIntptr_t'; declareVar: #debugPrimCallStackOffset type: #'usqIntptr_t'. aCCodeGenerator vmClass generatorTable ifNotNil: [:bytecodeGenTable| aCCodeGenerator var: #generatorTable + declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']', - declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']', (self tableInitializerFor: bytecodeGenTable in: aCCodeGenerator)]. "In C the abstract opcode names clash with the Smalltak generator syntactic sugar. Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic sugar to avoid the clash." (self organization listAtCategoryNamed: #'abstract instructions') do: [:s| aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)]. aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!

1 0

VM Maker: VMMaker-dtl.401.mcz
by commits＠source.squeak.org 08 May '19

08 May '19

David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.401.mcz ==================== Summary ==================== Name: VMMaker-dtl.401 Author: dtl Time: 4 May 2019, 9:22:54.649 am UUID: c8ffe0ea-c3b8-4f49-8343-df16ac0656ea Ancestors: VMMaker-dtl.400 VMMaker 4.16.6 Primitive support for snapshot objects, answering object memory and header as in-image objects. Instead of disk-based snapshot file. Currently implemented in ContextInterpreter. "ImageSnapshot new" The primitives are: #primitiveInterpreterStateSnapshot - snapshot the header information #primitiveMemoryCopy - snapshot the memory #primitiveMemorySnapshotBytesWithHeader - snapshot memory bytes and header #primitiveMemorySnapshotWithHeader - snapshot memory bitmap and header mage side support package ImageFormat in http://source.squeak.org/VMMaker: ImageFileHeader fromValues: ImageFileHeader primInterpreterStateSnapshot. ImageFileHeader primMemoryCopy. Image side support from package ImageSnapshot in http://www.squeaksource.com/ImageSnapshot: ImageSnapshot basicNew getSnapshot. ImageBitmapSnapshot basicNew getSnapshot. Snapshot to disk, equivalent to normal snapshot: ImageSnapshot new saveAs: 'newimage.image' =============== Diff against VMMaker-dtl.400 =============== Item was changed: Interpreter subclass: #ContextInterpreter + instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext localReturnContext localReturnValue messageSelector currentBytecode primitiveIndex primitiveFunctionPointer methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptPending savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks newNativeMethod methodClass receiverClass interpreterVersion imageFormatVersionNumber interpreterProxy showSurfaceFn interruptCheckCounter interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable globalSessionID jmpBuf jmpDepth jmpMax suspendedCallbacks suspendedMethods imageFormatInitialVersion allowAccessBeyondSP' - instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext localReturnContext localReturnValue messageSelector currentBytecode primitiveIndex primitiveFunctionPointer methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptPending savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks extraVMMemory newNativeMethod methodClass receiverClass interpreterVersion imageFormatVersionNumber interpreterProxy showSurfaceFn interruptCheckCounter interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable globalSessionID jmpBuf jmpDepth jmpMax suspendedCallbacks suspendedMethods imageFormatInitialVersion allowAccessBeyondSP' classVariableNames: 'BlockArgumentCountIndex BytecodeTable CacheProbeMax CallerIndex CompilerHooksSize DirBadPath DirEntryFound DirNoMoreEntries DoBalanceChecks HomeIndex InitialIPIndex MaxJumpBuf MessageDictionaryIndex MethodCacheNative TempFrameStart' poolDictionaries: 'VMMethodCacheConstants VMSqueakV3BytecodeConstants' category: 'VMMaker-Interpreter'! !ContextInterpreter commentStamp: '<historical>' prior: 0! This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas. It has been modernized with 32-bit pointers, better management of Contexts, and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms. In addition to SmallInteger arithmetic and Floats, it supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case. NOTE: Here follows a list of things to be borne in mind when working on this code, or when making changes for the future. 1. There are a number of things that should be done the next time we plan to release a copletely incompatible image format. These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:. Also, contexts should be given a special format code (see next item). 2. There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change. This is necessary because the oops may change during a compaction when the oops are being adjusted. It's important to be aware of this when writing a new image using the systemTracer. A better solution would be to reserve one of the format codes for Contexts only. 3. We have made normal files tolerant to size and positions up to 32 bits. This has not been done for async files, since they are still experimental. The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes. 4. Note that 0 is used in a couple of places as an impossible oop. This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment). The places include the method cache and the at cache. ! Item was added: + ----- Method: ContextInterpreter>>allocateMemory:heapSize: (in category 'snapshot resume') ----- + allocateMemory: dataSize heapSize: desiredHeapSize + "Allocate memory space sufficient to contain object memory data from an image snapshot." + + | unusedHeaderSize minimumMemory memStart heapSize unusedFileReference savedOldMemoryAddress | + <returnTypeC: 'usqInt'> + <var: #unusedFileReference type: 'sqImageFile '> + <var: #desiredHeapSize type: 'usqInt'> + <var: #dataSize type: 'size_t '> + <var: #savedOldMemoryAddress type: 'usqInt'> + + unusedFileReference := nil. self flag: #FIXME. "remove unused" + unusedHeaderSize := nil. self flag: #FIXME. "remove unused" + + "decrease Squeak object heap to leave extra memory for the VM" + heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'. + + "compare memory requirements with availability". + minimumMemory := dataSize + 100000. "need at least 100K of breathing room" + heapSize < minimumMemory ifTrue: [ + self insufficientMemorySpecifiedError]. + + "allocate a contiguous block of memory for the Squeak heap" + "below calls a macro that does sqAllocateMemory(minimumMemory, heapSize)" + "so save prior value of memory so it can be freed at the end of this method, and + call the below to create new memory here" + savedOldMemoryAddress := self cCode: 'sqMemoryBase'. self flag: #FIXME. "see package MemoryAccess sqMemoryBaseAddress" + "allocate new here" + (objectMemory allocateMemory: heapSize + minimum: minimumMemory + imageFile: unusedFileReference + headerSize: unusedHeaderSize) = nil ifTrue: [self insufficientMemoryAvailableError]. + + memStart := objectMemory startOfMemory. + objectMemory setMemoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety" + objectMemory setEndOfMemory: memStart + dataSize. + ^savedOldMemoryAddress. + ! Item was added: + ----- Method: ContextInterpreter>>displayExtent: (in category 'primitive support') ----- + displayExtent: screenSizeWord + "Answer a Point representing the display extent" + + | displayX displayY extent | + extent := objectMemory instantiateClass: objectMemory classPoint indexableSize: 0. + displayX := objectMemory positive32BitIntegerFor: (screenSizeWord >> 16). + displayY := objectMemory positive32BitIntegerFor: (screenSizeWord bitAnd: 16rFFFF). + objectMemory storePointer: 0 ofObject: extent withValue: displayX. + objectMemory storePointer: 1 ofObject: extent withValue: displayY. + ^extent + ! Item was added: + ----- Method: ContextInterpreter>>headerAndSnapshotOfSize:class: (in category 'primitive support') ----- + headerAndSnapshotOfSize: size class: class + + "Answer a snapshot copy of the current object memory and header information. The + object memory will be saved as and object of type class" + | bytesPerElement oop start copy ptr result | + <var: 'start' type: 'usqInt'> + <var: 'end' type: 'usqInt'> + <var: 'size' type: 'size_t'> + <var: 'copy' type: 'void *'> + <var: 'ptr' type: 'void *'> + "Expect class Bitmap or ByteArray" + objectMemory classByteArray = class + ifTrue: [bytesPerElement := 1] + ifFalse: [objectMemory classBitmap = class + ifTrue: [bytesPerElement := 4] + ifFalse: [^interpreterProxy primitiveFail]]. + "Get values needed for object memory copy before first allocation" + start := objectMemory getMemory. + copy := self malloc: size. + copy == nil + ifTrue: [^ self primitiveFail]. + self mem: copy "to temporary allocated space" + cp: (objectMemory pointerForOop: start) "from start of memory" + y: size. "copy memory to separately allocated space" + + objectMemory pushRemappableOop: (self memoryHeaderState: size). "allocation happens here" + + "Copy the saved memory image back to a Bitmap" + oop := objectMemory instantiateClass: class indexableSize: (size / bytesPerElement). + self successful + ifFalse: [self free: copy. + ^ self primitiveFail]. + ptr := objectMemory firstIndexableField: oop. + self mem: ptr cp: copy y: size. "copy saved memory back into newly allocated Bitmap" + self free: copy. "free the temp space" + objectMemory pushRemappableOop: oop. + + result := objectMemory instantiateClass: objectMemory classArray indexableSize: 2. + objectMemory + storePointer: 0 + ofObject: result + withValue: (objectMemory popRemappableOop). + objectMemory + storePointer: 1 + ofObject: result + withValue: (objectMemory popRemappableOop). + ^ result + + + ! Item was added: + ----- Method: ContextInterpreter>>headerAndSnapshotOfSize:class:bytesPerElement: (in category 'primitive support') ----- + headerAndSnapshotOfSize: size class: class bytesPerElement: bytesPerElement + + "Answer a snapshot copy of the current object memory and header information. The + object memory will be saved as and object of type class" + | oop start copy ptr result | + <var: 'start' type: 'usqInt'> + <var: 'end' type: 'usqInt'> + <var: 'size' type: 'size_t'> + <var: 'copy' type: 'void *'> + <var: 'ptr' type: 'void *'> + + "Get values needed for object memory copy before first allocation" + start := objectMemory getMemory. + copy := self malloc: size. + copy == nil + ifTrue: [^ self primitiveFail]. + self mem: copy "to temporary allocated space" + cp: (objectMemory pointerForOop: start) "from start of memory" + y: size. "copy memory to separately allocated space" + + objectMemory pushRemappableOop: (self memoryHeaderState: size). "allocation happens here" + + "Copy the saved memory image back to a Bitmap" + oop := objectMemory instantiateClass: class indexableSize: (size / bytesPerElement). + self successful + ifFalse: [self free: copy. + ^ self primitiveFail]. + ptr := objectMemory firstIndexableField: oop. + self mem: ptr cp: copy y: size. "copy saved memory back into newly allocated Bitmap" + self free: copy. "free the temp space" + objectMemory pushRemappableOop: oop. + + result := objectMemory instantiateClass: objectMemory classArray indexableSize: 2. + objectMemory + storePointer: 0 + ofObject: result + withValue: (objectMemory popRemappableOop). + objectMemory + storePointer: 1 + ofObject: result + withValue: (objectMemory popRemappableOop). + ^ result + + + ! Item was added: + ----- Method: ContextInterpreter>>memoryHeaderState: (in category 'primitive support') ----- + memoryHeaderState: dataSize + "Answer current interpreter and object memory state information." + + | splObjsOop oopStart headerSize results hash displayExtent | + + "seee ContextInterpreter>>writeImageFileIO:" + + "self putLong: (self imageFormatVersion) toFile: f. + self putLong: headerSize toFile: f. + self putLong: imageBytes toFile: f. + self putLong: (objectMemory startOfMemory) toFile: f. + self putLong: objectMemory getSpecialObjectsOop toFile: f. + self putLong: objectMemory getLastHash toFile: f. + self putLong: (self ioScreenSize) toFile: f. + self putLong: fullScreenFlag toFile: f. + self putLong: extraVMMemory toFile: f. + 1 to: 7 do: [:i | self putLong: 0 toFile: f]." "fill remaining header words with zeros" + + headerSize := 16 * objectMemory bytesPerWord. "header size in bytes; do not change!!" + oopStart := objectMemory startOfMemory. + splObjsOop := objectMemory getSpecialObjectsOop. + hash := objectMemory integerObjectOf: objectMemory getLastHash. + "self ioScreenSize." + "fullScreenFlag" + "extraVMMemory" + "Pad the rest of the header." + "7 timesRepeat: [self putLong: 0 toFile: file]." + + InterpreterProxy pushRemappableOop: (objectMemory + instantiateClass: (objectMemory classArray) + indexableSize: 16). "results array" + displayExtent := self displayExtent: self ioScreenSize. "may trigger GC" + results := interpreterProxy popRemappableOop. + objectMemory + storePointer: 0 + ofObject: results + withValue: (objectMemory integerObjectOf: self imageFormatVersion). + objectMemory + storePointer: 1 + ofObject: results + withValue: (objectMemory integerObjectOf: headerSize). + objectMemory + storePointer: 2 + ofObject: results + withValue: (self positive64BitIntegerFor: dataSize). + objectMemory + storePointer: 3 + ofObject: results + withValue: (objectMemory integerObjectOf: oopStart). + objectMemory + storePointer: 4 + ofObject: results + withValue: (objectMemory integerObjectOf: splObjsOop). + objectMemory + storePointer: 5 + ofObject: results + withValue: (objectMemory integerObjectOf: hash). + objectMemory + storePointer: 6 + ofObject: results + withValue: displayExtent. + objectMemory + storePointer: 7 + ofObject: results + withValue: (objectMemory integerObjectOf: 0).. + objectMemory + storePointer: 8 + ofObject: results + withValue: (objectMemory integerObjectOf: extraVMMemory).. + objectMemory + storePointer: 9 + ofObject: results + withValue: (objectMemory integerObjectOf: 0). + objectMemory + storePointer: 10 + ofObject: results + withValue: (objectMemory integerObjectOf: 0). + objectMemory + storePointer: 11 + ofObject: results + withValue: (objectMemory integerObjectOf: 0). + objectMemory + storePointer: 12 + ofObject: results + withValue: (objectMemory integerObjectOf: 0). + objectMemory + storePointer: 13 + ofObject: results + withValue: (objectMemory integerObjectOf: 0). + objectMemory + storePointer: 14 + ofObject: results + withValue: (objectMemory integerObjectOf: 0). + objectMemory + storePointer: 15 + ofObject: results + withValue: (objectMemory integerObjectOf: 0). + ^ results.! Item was added: + ----- Method: ContextInterpreter>>memoryImageCopyAs:bytesPerElement: (in category 'primitive support') ----- + memoryImageCopyAs: class bytesPerElement: bytesPerElement + "Answer a snapshot copy of the current object memory. If class is organized + as words, then bytesPerElement should be 4, else 1 for byte organization." + | oop start size copy ptr | + <var: 'start' type: 'usqInt'> + <var: 'size' type: 'size_t'> + <var: 'copy' type: 'void *'> + <var: 'ptr' type: 'void *'> + + start := objectMemory startOfMemory. + size := objectMemory getFreeBlock - start. "Assume all objects are below the start of the free block" + copy := self malloc: size. + copy == nil + ifTrue: [^ self primitiveFail]. + self mem: copy "to temporary allocated space" + cp: (objectMemory pointerForOop: start) "from start of memory" + y: size. "copy memory to separately allocated space" + oop := objectMemory instantiateClass: class indexableSize: size / bytesPerElement. + self successful + ifFalse: [self free: copy. + ^ self primitiveFail]. + ptr := objectMemory firstIndexableField: oop. + self mem: ptr cp: copy y: size. "copy saved memory back into newly allocated Bitmap" + self free: copy. "free the temp space" + ^oop. + ! Item was added: + ----- Method: ContextInterpreter>>memoryImageCopyAsBitmap (in category 'primitive support') ----- + memoryImageCopyAsBitmap + "Answer a snapshot copy of the current object memory. Answer a Bitmap organized + in 32 bit words suitable for interpretation as an ObjectMemory." + + ^ self memoryImageCopyAs: objectMemory classBitmap bytesPerElement: 4 + ! Item was added: + ----- Method: ContextInterpreter>>memoryImageCopyAsBytes (in category 'primitive support') ----- + memoryImageCopyAsBytes + "Answer a snapshot copy of the current object memory. Answer the raw memory + data as a byte array suitable for fast save to disk or write to network." + + ^ self memoryImageCopyAs: objectMemory classByteArray bytesPerElement: 1 + ! Item was added: + ----- Method: ContextInterpreter>>prepareForSnapshot (in category 'image save/restore') ----- + prepareForSnapshot + "Prepare the object memory to be captured as a resumable snapshot. Answer + the size of object memory space to be snapshotted." + + "update state of active context" + | activeProc | + compilerInitialized + ifTrue: [self compilerPreSnapshot] + ifFalse: [self storeContextRegisters: activeContext]. + + "update state of active process" + activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer. + objectMemory + storePointer: SuspendedContextIndex + ofObject: activeProc + withValue: activeContext. + + "compact memory and compute the size of the memory actually in use" + objectMemory incrementalGC. + + "maximimize space for forwarding table" + objectMemory fullGC. + self snapshotCleanUp. + + ^objectMemory getFreeBlock - objectMemory startOfMemory. "Assume all objects are below the start of the free block" + ! Item was added: + ----- Method: ContextInterpreter>>primitiveInterpreterStateSnapshot (in category 'snapshot utility primitives') ----- + primitiveInterpreterStateSnapshot + "Primitive. Answer state information for the object memory as of the point + of entry to this primitive. This is the information that is stored in an image + file header when the image is saved to disk. The memory state information, + when combined with the object memory image, is sufficient to initialize an + an image to be run in an interpreter." + <export: true> + self methodReturnValue: (self memoryHeaderState: self prepareForSnapshot). + ! Item was added: + ----- Method: ContextInterpreter>>primitiveMemoryCopy (in category 'snapshot utility primitives') ----- + primitiveMemoryCopy + "Primitive. Answer an exact copy of the object memory as of the point of entry + to this primitive. The object memory is not prepared for saving as a snapshot. + Compare to primitiveMemorySnapshotWithHeader, which prepares the object + memory to be resumed from a saved snapshot" + <export: true> + self methodReturnValue: self memoryImageCopyAsBitmap + ! Item was added: + ----- Method: ContextInterpreter>>primitiveMemorySnapshotBytesWithHeader (in category 'snapshot utility primitives') ----- + primitiveMemorySnapshotBytesWithHeader + "Primitive. Answer an array with a snapshot copy of the object memory as + of the point of entry to this primitive, and with the header information for + the image at the point of the snapshot. + + The memory snapshot is a ByteArray copy of the object memory, and the header + information is an array of the values that would be stored in an image file + header if the image was being saved to disk. The header state information + along with memory snapshot are sufficient to initialize an an image to be run + in an interpreter." + + <export: true> + "pop rcvr. A resuming image will see this primitive answering true, otherwise + it will answer the expected value of a two element array. Test for result equal + to true to determine if the image is being resumed from a saved snapshot.." + | result | + self pop: argumentCount + 1. + self push: objectMemory getTrueObj. "resuming image will see this" + result := self + headerAndSnapshotOfSize: self prepareForSnapshot + class: objectMemory classByteArray. + self pop: 1. "restore stack" + self push: result. "normal sender will see this" + ! Item was added: + ----- Method: ContextInterpreter>>primitiveMemorySnapshotWithHeader (in category 'snapshot utility primitives') ----- + primitiveMemorySnapshotWithHeader + "Primitive. Answer an array with a snapshot copy of the object memory as + of the point of entry to this primitive, and with the header information for + the image at the point of the snapshot. + + The memory snapshot is a Bitmap copy of the object memory, and the header + information is an array of the values that would be stored in an image file + header if the image was being saved to disk. The header state information + along with memory snapshot are sufficient to initialize an an image to be run + in an interpreter." + + <export: true> + "pop rcvr. A resuming image will see this primitive answering true, otherwise + it will answer the expected value of a two element array. Test for result equal + to true to determine if the image is being resumed from a saved snapshot.." + | result | + self pop: argumentCount + 1. + self push: objectMemory getTrueObj. "resuming image will see this" + result := self + headerAndSnapshotOfSize: self prepareForSnapshot + class: objectMemory classBitmap. + self pop: 1. "restore stack" + self push: result. "normal sender will see this" + ! Item was removed: - ----- Method: ContextInterpreter>>readImageFormatFromFile:StartingAt: (in category 'image save/restore') ----- - readImageFormatFromFile: f StartingAt: imageOffset - "Read an image header from the given file stream, and answer the image format - version number for the saved image. Exported to allow platform support code to - query image files for image format number." - - <export: true> - <var: #f type: 'sqImageFile '> - <var: #imageOffset type: 'squeakFileOffsetType '> - - self checkImageVersionFrom: f startingAt: imageOffset. - ^ imageFormatInitialVersion - ! Item was changed: + ----- Method: ContextInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'snapshot resume') ----- - ----- Method: ContextInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') ----- readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset "Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory." "Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command." "This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!" + | swapBytes headerStart headerSize dataSize oldBaseAddr | - | swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize | <var: #f type: 'sqImageFile '> <var: #desiredHeapSize type: 'usqInt'> <var: #headerStart type: 'squeakFileOffsetType '> <var: #dataSize type: 'size_t '> <var: #imageOffset type: 'squeakFileOffsetType '> swapBytes := self checkImageVersionFrom: f startingAt: imageOffset. headerStart := (self sqImageFilePosition: f) - objectMemory bytesPerWord. "record header start position" headerSize := self getLongFromFile: f swap: swapBytes. dataSize := self getLongFromFile: f swap: swapBytes. oldBaseAddr := self getLongFromFile: f swap: swapBytes. objectMemory setSpecialObjectsOop: (self getLongFromFile: f swap: swapBytes). objectMemory setLastHash: (self getLongFromFile: f swap: swapBytes). savedWindowSize := self getLongFromFile: f swap: swapBytes. fullScreenFlag := self oldFormatFullScreenFlag: (self getLongFromFile: f swap: swapBytes). extraVMMemory := self getLongFromFile: f swap: swapBytes. objectMemory getLastHash = 0 ifTrue: [ "lastHash wasn't stored (e.g. by the cloner); use 999 as the seed" objectMemory setLastHash: 999]. + self allocateMemory: dataSize heapSize: desiredHeapSize. + self sqImageFile: f Seek: headerStart + headerSize. "position file after the header" + self snapshotMemoryRead: f size: dataSize. "read object memory data" + self swapBytesAndPrepareToInterpret: swapBytes oldBaseAddr: oldBaseAddr. - "decrease Squeak object heap to leave extra memory for the VM" - heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'. - - "compare memory requirements with availability". - minimumMemory := dataSize + 100000. "need at least 100K of breathing room" - heapSize < minimumMemory ifTrue: [ - self insufficientMemorySpecifiedError]. - - "allocate a contiguous block of memory for the Squeak heap" - (objectMemory allocateMemory: heapSize - minimum: minimumMemory - imageFile: f - headerSize: headerSize) = nil ifTrue: [self insufficientMemoryAvailableError]. - - memStart := objectMemory startOfMemory. - objectMemory setMemoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety" - objectMemory setEndOfMemory: memStart + dataSize. - - "position file after the header" - self sqImageFile: f Seek: headerStart + headerSize. - - "read in the image in bulk, then swap the bytes if necessary" - bytesRead := self - sqImage: (objectMemory pointerForOop: objectMemory getMemory) - read: f - size: (self cCode: 'sizeof(unsigned char)') - length: dataSize. - bytesRead ~= dataSize ifTrue: [self unableToReadImageError]. - - objectMemory headerTypeBytesAt: 0 put: objectMemory bytesPerWord * 2. "3-word header (type 0)" - objectMemory headerTypeBytesAt: 1 put: objectMemory bytesPerWord. "2-word header (type 1)" - objectMemory headerTypeBytesAt: 2 put: 0. "free chunk (type 2)" - objectMemory headerTypeBytesAt: 3 put: 0. "1-word header (type 3)" - - swapBytes ifTrue: [self reverseBytesInImage]. - - "compute difference between old and new memory base addresses" - bytesToShift := memStart - oldBaseAddr. - self initializeInterpreter: bytesToShift. "adjusts all oops to new location" - self isBigEnder. "work out the machine endianness and cache the answer" - - (self initialImageFormatVersion bitAnd: 1) = 1 - ifTrue: ["Low order bit set, indicating that the image was saved from - a StackInterpreter (Cog) VM. Storage of all Float objects must be - returned to older object memory format." - self normalizeFloatOrderingInImage]. - ^ dataSize ! Item was changed: ----- Method: ContextInterpreter>>snapshot: (in category 'image save/restore') ----- + snapshot: embedded - snapshot: embedded - "update state of active context" - | activeProc dataSize rcvr setMacType | - <var: #setMacType type: 'void *'> - compilerInitialized - ifTrue: [self compilerPreSnapshot] - ifFalse: [self storeContextRegisters: activeContext]. + | dataSize rcvr setMacType | + dataSize := self prepareForSnapshot. - "update state of active process" - activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer. - objectMemory - storePointer: SuspendedContextIndex - ofObject: activeProc - withValue: activeContext. - - "compact memory and compute the size of the memory actually in use" - objectMemory incrementalGC. - - "maximimize space for forwarding table" - objectMemory fullGC. - self snapshotCleanUp. - - dataSize := objectMemory getFreeBlock - objectMemory startOfMemory. "Assume all objects are below the start of the free block" self successful ifTrue: [rcvr := self popStack. "pop rcvr" self push: objectMemory getTrueObj. self writeImageFile: dataSize. embedded ifFalse: ["set Mac file type and creator; this is a noop on other platforms" setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'. setMacType = 0 ifFalse: [self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']]. self pop: 1]. "activeContext was unmarked in #snapshotCleanUp, mark it old " objectMemory beRootIfOld: activeContext. self successful ifTrue: [self push: objectMemory getFalseObj] ifFalse: [self push: rcvr]. compilerInitialized ifTrue: [self compilerPostSnapshot]! Item was added: + ----- Method: ContextInterpreter>>snapshotMemoryRead:size: (in category 'snapshot resume') ----- + snapshotMemoryRead: imageFile size: dataSize + "Read the object memory data from a snapshot file into a previously allocated memory space." + + | bytesRead | + <returnTypeC: 'usqInt'> + <var: #imageFile type: 'sqImageFile '> + <var: #dataSize type: 'size_t '> + bytesRead := self + sqImage: (objectMemory pointerForOop: objectMemory getMemory) + read: imageFile + size: (self cCode: 'sizeof(unsigned char)') + length: dataSize. + bytesRead ~= dataSize ifTrue: [self unableToReadImageError]. + ^bytesRead. + ! Item was added: + ----- Method: ContextInterpreter>>swapBytesAndPrepareToInterpret:oldBaseAddr: (in category 'snapshot resume') ----- + swapBytesAndPrepareToInterpret: swapBytes oldBaseAddr: oldBaseAddr + "An object memory has been loaded from a snapshot. Prepare it to be executed by an interpreter." + + | bytesToShift | + objectMemory headerTypeBytesAt: 0 put: objectMemory bytesPerWord * 2. "3-word header (type 0)" + objectMemory headerTypeBytesAt: 1 put: objectMemory bytesPerWord. "2-word header (type 1)" + objectMemory headerTypeBytesAt: 2 put: 0. "free chunk (type 2)" + objectMemory headerTypeBytesAt: 3 put: 0. "1-word header (type 3)" + + swapBytes ifTrue: [self reverseBytesInImage]. + + "compute difference between old and new memory base addresses" + bytesToShift := objectMemory startOfMemory - oldBaseAddr. + self initializeInterpreter: bytesToShift. "adjusts all oops to new location" + self isBigEnder. "work out the machine endianness and cache the answer" + + (self initialImageFormatVersion bitAnd: 1) = 1 + ifTrue: ["Low order bit set, indicating that the image was saved from + a StackInterpreter (Cog) VM. Storage of all Float objects must be + returned to older object memory format." + self normalizeFloatOrderingInImage]. + ! Item was changed: InterpreterPrimitives subclass: #Interpreter + instanceVariableNames: 'semaphoresUseBufferA semaphoresToSignalA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB extraVMMemory' - instanceVariableNames: 'semaphoresUseBufferA semaphoresToSignalA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB' classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase MaxExternalPrimitiveTableSize MaxPrimitiveIndex SemaphoresToSignalSize' poolDictionaries: '' category: 'VMMaker-Interpreter'! !Interpreter commentStamp: 'dtl 4/22/2016 22:14' prior: 0! This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas. ContextInterpreter is the Squeak interpreter VM as originally implemented by Dan Ingalls. StackInterpreter is the stack mapped interpreter by Eliot Miranda, which provides the basis for later Cog and Spur VMs.! Item was changed: Interpreter subclass: #StackInterpreter + instanceVariableNames: 'currentBytecode localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue primitiveFunctionPointer methodCache atCache lkupClass highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals interpreterProxy showSurfaceFn externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBytes interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunni ngPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals classByteArrayCompactIndex messageSelector profileProcess nextProfileTick profileMethod profileSemaphore' - instanceVariableNames: 'currentBytecode localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue primitiveFunctionPointer methodCache atCache lkupClass highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBytes interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNu mber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals classByteArrayCompactIndex messageSelector profileProcess nextProfileTick profileMethod profileSemaphore' classVariableNames: 'BytecodeTable BytesPerWord COGMTVM COGVM CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition IMMUTABILITY MULTIPLEBYTECODESETS MaxJumpBuf MaxQuickPrimitiveIndex MixinIndex NewspeakVM STACKVM VMBIGENDIAN' poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets' category: 'VMMaker-Interpreter'! !StackInterpreter commentStamp: '<historical>' prior: 0! This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas. This VM supports Closures but *not* old-style BlockContexts. It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms. The VM does not use Contexts directly. Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image. There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the…. The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations. A send establishes a new frame in the current stack page, a return returns to the previous frame. This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return. Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together). Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse f rame has been returned from (died). A married context is specially marked (more details in the code) and refers to its frame. Likewise a married frame is specially marked and refers to its context. In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case. NOTE: Here follows a list of things to be borne in mind when working on this code, or when making changes for the future. 1. There are a number of things that should be done the next time we plan to release a completely incompatible image format. These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:. Also, contexts should be given a special format code (see next item). 2. There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change. This is necessary because the oops may change during a compaction when the oops are being adjusted. It's important to be aware of this when writing a new image using the SystemTracer. A better solution would be to reserve one of the format codes for Contexts only. 3. We have made normal files tolerant to size and positions up to 32 bits. This has not been done for async files, since they are still experimental. The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes. 4. Note that 0 is used in a couple of places as an impossible oop. This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment). The places include the method cache and the at cache. 5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT 6. If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images.! Item was changed: ----- Method: VMMaker class>>versionString (in category 'version testing') ----- versionString "VMMaker versionString" ^'4.16.6'!

1 0

VM Maker Inbox: VMMakerTests-GuillermoPolito.1.mcz
by commits＠source.squeak.org 07 May '19

07 May '19

A new version of VMMakerTests was added to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMakerTests-GuillermoPolito.1.mcz ==================== Summary ==================== Name: VMMakerTests-GuillermoPolito.1 Author: GuillermoPolito Time: 7 May 2019, 11:27:14.195596 am UUID: 77f9288f-aa44-0d00-873a-d0970059f8ce Ancestors: Tests for AST translation and C code generation ==================== Snapshot ==================== SystemOrganization addCategory: #VMMakerTests! TestCase subclass: #VMCodeGenerationTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'VMMakerTests'! ----- Method: VMCodeGenerationTest>>methodWithIfNil (in category 'generation-targets') ----- methodWithIfNil self something ifNil: [ 1 ] ifNotNil: [ 2 ]! ----- Method: VMCodeGenerationTest>>methodWithIfNilAssignment (in category 'generation-targets') ----- methodWithIfNilAssignment | variable | variable := self something ifNil: [ 1 ] ifNotNil: [ 2 ]! ----- Method: VMCodeGenerationTest>>methodWithIfNilAssignmentOfComplexStatements (in category 'generation-targets') ----- methodWithIfNilAssignmentOfComplexStatements | variable | variable := self something ifNil: [ | temp | temp := 1. temp := temp + 1. temp * 3 ] ifNotNil: [ | temp | temp := 2. temp := temp + 5. temp * 3 ]! ----- Method: VMCodeGenerationTest>>methodWithLoop (in category 'generation-targets') ----- methodWithLoop 1 to: 10 do: [ :i | self foo: i ]! ----- Method: VMCodeGenerationTest>>methodWithNilIfNil (in category 'generation-targets') ----- methodWithNilIfNil ^ nil ifNil: [ 1 ] ifNotNil: [ 2 ]! ----- Method: VMCodeGenerationTest>>testComplexIfNilAssignment (in category 'tests') ----- testComplexIfNilAssignment | translation thisAST codeGenerator result | thisAST := (self class >> #methodWithIfNilAssignmentOfComplexStatements) ast. translation := thisAST asTranslationMethodOfClass: TMethod. codeGenerator := CCodeGeneratorGlobalStructure new. codeGenerator addMethod: translation. codeGenerator doInlining: true. result := String streamContents: [ :stream | translation parseTree statements first emitCCodeOn: stream level: 0 generator: codeGenerator. ]. self assert: result equals: 'if ((something()) == null) { temp = 1; temp += 1; variable = temp * 3; } else { temp = 2; temp += 5; variable = temp * 3; }'! ----- Method: VMCodeGenerationTest>>testLoopVariableIsTemp (in category 'tests') ----- testLoopVariableIsTemp | translation thisAST codeGenerator result | thisAST := (self class >> #methodWithLoop) ast. translation := thisAST asTranslationMethodOfClass: TMethod. codeGenerator := CCodeGeneratorGlobalStructure new. codeGenerator doInlining: true. result := String streamContents: [ :stream | translation emitCCodeOn: stream generator: codeGenerator. ]. self assert: result equals: ' /* VMCodeGenerationTest>>#methodWithLoop */ static sqInt methodWithLoop(void) { sqInt i; for (i = 1; i <= 10; i += 1) { foo(i); } return self; } '! ----- Method: VMCodeGenerationTest>>testNilIfNilGeneratesOnlyFirstBranch (in category 'tests') ----- testNilIfNilGeneratesOnlyFirstBranch | translation thisAST codeGenerator result | thisAST := (self class >> #methodWithNilIfNil) ast. translation := thisAST asTranslationMethodOfClass: TMethod. codeGenerator := CCodeGeneratorGlobalStructure new. codeGenerator generateDeadCode: false. codeGenerator addMethod: translation. codeGenerator doInlining: true. result := String streamContents: [ :stream | translation parseTree statements first emitCCodeOn: stream level: 0 generator: codeGenerator. ]. self assert: result equals: 'return 1'! ----- Method: VMCodeGenerationTest>>testSimpleIfNil (in category 'tests') ----- testSimpleIfNil | translation thisAST codeGenerator result | thisAST := (self class >> #methodWithIfNilAssignment) ast. translation := thisAST asTranslationMethodOfClass: TMethod. codeGenerator := CCodeGeneratorGlobalStructure new. codeGenerator generateDeadCode: false. codeGenerator addMethod: translation. codeGenerator doInlining: true. result := String streamContents: [ :stream | translation parseTree statements first emitCCodeOn: stream level: 0 generator: codeGenerator. ]. self assert: result equals: 'variable = ((something()) == null ? 1 : 2)'! ----- Method: VMCodeGenerationTest>>testSimpleIfNilAssignment (in category 'tests') ----- testSimpleIfNilAssignment | translation thisAST codeGenerator result | thisAST := (self class >> #methodWithIfNil) ast. translation := thisAST asTranslationMethodOfClass: TMethod. codeGenerator := CCodeGeneratorGlobalStructure new. codeGenerator generateDeadCode: false. codeGenerator addMethod: translation. codeGenerator doInlining: true. result := String streamContents: [ :stream | translation parseTree statements first emitCCodeOn: stream level: 0 generator: codeGenerator. ]. self assert: result equals: 'if ((something()) == null) { } else { }'! TestCase subclass: #VMMASTTranslationTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'VMMakerTests'! ----- Method: VMMASTTranslationTest>>+ (in category 'generation-targets') ----- + arg! ----- Method: VMMASTTranslationTest>>inlineMethodWithLoop (in category 'generation-targets') ----- inlineMethodWithLoop self methodWithLoop! ----- Method: VMMASTTranslationTest>>inlineSecondLevelMethodWithLoop (in category 'generation-targets') ----- inlineSecondLevelMethodWithLoop self inlineMethodWithLoop! ----- Method: VMMASTTranslationTest>>inlineTwiceMethodWithLoop (in category 'generation-targets') ----- inlineTwiceMethodWithLoop self methodWithLoop. self methodWithLoop! ----- Method: VMMASTTranslationTest>>inlineTwiceSecondLevelMethodWithLoop (in category 'generation-targets') ----- inlineTwiceSecondLevelMethodWithLoop self inlineMethodWithLoop. self inlineMethodWithLoop! ----- Method: VMMASTTranslationTest>>methodWithArgument: (in category 'generation-targets') ----- methodWithArgument: anArgument! ----- Method: VMMASTTranslationTest>>methodWithIfNil (in category 'generation-targets') ----- methodWithIfNil self something ifNil: [ 1 ] ifNotNil: [ 2 ]! ----- Method: VMMASTTranslationTest>>methodWithLoop (in category 'generation-targets') ----- methodWithLoop 1 to: 10 do: [ :i | self foo: i ]! ----- Method: VMMASTTranslationTest>>methodWithNoArguments (in category 'generation-targets') ----- methodWithNoArguments! ----- Method: VMMASTTranslationTest>>testArgumentIsNoTemp (in category 'tests') ----- testArgumentIsNoTemp | translation thisAST | thisAST := (self class >> #methodWithArgument:) ast. translation := thisAST asTranslationMethodOfClass: TMethod. self deny: (translation locals includes: thisAST arguments first name)! ----- Method: VMMASTTranslationTest>>testIfNilIfNotNilBecomesIfTrueIfFalse (in category 'tests') ----- testIfNilIfNotNilBecomesIfTrueIfFalse | translation thisAST | thisAST := (self class >> #methodWithIfNil) ast. translation := thisAST asTranslationMethodOfClass: TMethod. self assert: translation statements first selector equals: #ifTrue:ifFalse:! ----- Method: VMMASTTranslationTest>>testInlineMethodWithLoopDeclaresLoopIndexVariable (in category 'tests') ----- testInlineMethodWithLoopDeclaresLoopIndexVariable | translation thisAST codeGenerator inlinedMethod | thisAST := (self class >> #inlineMethodWithLoop) ast. translation := thisAST asTranslationMethodOfClass: TMethod. inlinedMethod := ((self class >> #methodWithLoop) asTranslationMethodOfClass: TMethod). codeGenerator := CCodeGeneratorGlobalStructure new. codeGenerator addMethod: translation. codeGenerator addMethod: inlinedMethod. codeGenerator doInlining: true. self assert: (translation locals includesAll: inlinedMethod locals)! ----- Method: VMMASTTranslationTest>>testInlineSecondLevelMethodWithLoopDeclaresLoopIndexVariable (in category 'tests') ----- testInlineSecondLevelMethodWithLoopDeclaresLoopIndexVariable | translation thisAST codeGenerator inlinedMethods | thisAST := (self class >> #inlineSecondLevelMethodWithLoop) ast. translation := thisAST asTranslationMethodOfClass: TMethod. inlinedMethods := #( inlineMethodWithLoop methodWithLoop ) collect: [ :s | ((self class >> s) asTranslationMethodOfClass: TMethod)]. codeGenerator := CCodeGeneratorGlobalStructure new. codeGenerator addMethod: translation. inlinedMethods do: [ :e | codeGenerator addMethod: e ]. codeGenerator doInlining: true. self assert: translation locals size equals: 1! ----- Method: VMMASTTranslationTest>>testInlineTwiceMethodWithLoopDeclaresTwiceLoopIndexVariable (in category 'tests') ----- testInlineTwiceMethodWithLoopDeclaresTwiceLoopIndexVariable | translation thisAST codeGenerator inlinedMethod | thisAST := (self class >> #inlineTwiceMethodWithLoop) ast. translation := thisAST asTranslationMethodOfClass: TMethod. inlinedMethod := ((self class >> #methodWithLoop) asTranslationMethodOfClass: TMethod). codeGenerator := CCodeGeneratorGlobalStructure new. codeGenerator addMethod: translation. codeGenerator addMethod: inlinedMethod. codeGenerator doInlining: true. self assert: translation locals size equals: 2! ----- Method: VMMASTTranslationTest>>testInlineTwiceSecondLevelMethodWithLoopDeclaresLoopIndexVariable (in category 'tests') ----- testInlineTwiceSecondLevelMethodWithLoopDeclaresLoopIndexVariable | translation thisAST codeGenerator inlinedMethods | thisAST := (self class >> #inlineTwiceSecondLevelMethodWithLoop) ast. translation := thisAST asTranslationMethodOfClass: TMethod. inlinedMethods := #( inlineMethodWithLoop methodWithLoop ) collect: [ :s | ((self class >> s) asTranslationMethodOfClass: TMethod)]. codeGenerator := CCodeGeneratorGlobalStructure new. codeGenerator addMethod: translation. inlinedMethods do: [ :e | codeGenerator addMethod: e ]. codeGenerator doInlining: true. self assert: translation locals size equals: 2! ----- Method: VMMASTTranslationTest>>testKeywordMethodHasArgument (in category 'tests') ----- testKeywordMethodHasArgument | translation thisAST | thisAST := (self class >> #methodWithArgument:) ast. translation := thisAST asTranslationMethodOfClass: TMethod. self assert: (translation args includes: thisAST arguments first name)! ----- Method: VMMASTTranslationTest>>testMethodWithLoopDeclaresLoopIndexVariable (in category 'tests') ----- testMethodWithLoopDeclaresLoopIndexVariable | translation thisAST block | thisAST := (self class >> #methodWithLoop) ast. translation := thisAST asTranslationMethodOfClass: TMethod. block := thisAST statements first arguments second. self deny: (translation locals includes: block arguments first)! ----- Method: VMMASTTranslationTest>>testTranslateBinaryMethodHasSameName (in category 'tests') ----- testTranslateBinaryMethodHasSameName | translation thisAST | thisAST := self class >> #+. translation := thisAST asTranslationMethodOfClass: TMethod. self assert: translation selector equals: thisAST selector.! ----- Method: VMMASTTranslationTest>>testTranslateKeywordMethodHasSameName (in category 'tests') ----- testTranslateKeywordMethodHasSameName | translation thisAST | thisAST := self class >> #methodWithArgument:. translation := thisAST asTranslationMethodOfClass: TMethod. self assert: translation selector equals: thisAST selector.! ----- Method: VMMASTTranslationTest>>testTranslateUnaryMethodHasSameName (in category 'tests') ----- testTranslateUnaryMethodHasSameName | translation thisAST | thisAST := self class >> #methodWithNoArguments. translation := thisAST asTranslationMethodOfClass: TMethod. self assert: translation selector equals: thisAST selector.!

1 0

VM Maker Inbox: VMMakerCompatibilityForPharo6-GuillermoPolito.10.mcz
by commits＠source.squeak.org 07 May '19

07 May '19

A new version of VMMakerCompatibilityForPharo6 was added to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMakerCompatibilityForPharo6-Guiller… ==================== Summary ==================== Name: VMMakerCompatibilityForPharo6-GuillermoPolito.10 Author: GuillermoPolito Time: 7 May 2019, 11:03:08.229705 am UUID: 4f49f938-aa44-0d00-8739-04000059f8ce Ancestors: VMMakerCompatibilityForPharo6-eem.9 Fixes in AST translation to make it work as in Squeak - to:do: => to:by:do: with extra arguments - ifNil:ifNotNil: => ifTrue:ifFalse: - fix arguments in TMethods - fix comments in TMethods - add name at the level of TParseNode (#name is not defined in Object anymore in Pharo) Other - Added FileDirectory compatibility layer using FileSystem behind the scenes (see FileDirectory and VMMakerFile classes). - Added PackageOrganizer compatibility layer using RPackage behind the scenes. - Extending Scanner and SystemNavigation with compatibility methods - Extending Time with compatibility method =============== Diff against VMMakerCompatibilityForPharo6-eem.9 =============== Item was changed: SystemOrganization addCategory: #VMMakerCompatibilityForPharo6! + SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-FileDirectoryToFileSystem'! SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-Kernel-Methods'! + SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-PackageOrganizer'! SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-SUnit-Extensions'! SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-System'! Item was added: + Object subclass: #FileDirectory + instanceVariableNames: 'fileReference' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMakerCompatibilityForPharo6-FileDirectoryToFileSystem'! Item was added: + ----- Method: FileDirectory class>>default (in category 'instance creation') ----- + default + + ^ self! Item was added: + ----- Method: FileDirectory class>>directoryExists: (in category 'testing') ----- + directoryExists: aString + + | ref | + ref := aString asFileReference. + ^ ref exists and: [ ref isDirectory ]! Item was added: + ----- Method: FileDirectory class>>directoryNamed: (in category 'instance-creation') ----- + directoryNamed: aString + + ^ self on: aString! Item was added: + ----- Method: FileDirectory class>>fileExists: (in category 'testing') ----- + fileExists: aString + + | ref | + ref := aString asFileReference. + ^ ref exists and: [ ref isFile ]! Item was added: + ----- Method: FileDirectory class>>oldFileNamed: (in category 'file-opening') ----- + oldFileNamed: aString + + ^ VMMakerFile on: aString! Item was added: + ----- Method: FileDirectory class>>on: (in category 'instance-creation') ----- + on: aString + + ^ self new + fileReference: aString asFileReference; + yourself! Item was added: + ----- Method: FileDirectory>>assureExistence (in category 'checking') ----- + assureExistence + + fileReference ensureCreateDirectory! Item was added: + ----- Method: FileDirectory>>deleteFileNamed: (in category 'file-system') ----- + deleteFileNamed: aString + + (self fileNamed: aString) delete! Item was added: + ----- Method: FileDirectory>>directoryNamed: (in category 'accessing') ----- + directoryNamed: aString + + ^ self class on: fileReference / aString! Item was added: + ----- Method: FileDirectory>>entryAt:ifAbsent: (in category 'accessing') ----- + entryAt: aString ifAbsent: aBlockClosure + + | ref | + ref := fileReference / aString. + ref exists ifFalse: [ ^ aBlockClosure value ]. + ^ ref! Item was added: + ----- Method: FileDirectory>>fileExists: (in category 'testing') ----- + fileExists: aString + + ^ (VMMakerFile on: (fileReference / aString)) exists! Item was added: + ----- Method: FileDirectory>>fileNamed: (in category 'accessing') ----- + fileNamed: aString + + ^ fileReference / aString! Item was added: + ----- Method: FileDirectory>>fileNamesMatching: (in category 'accessing') ----- + fileNamesMatching: aString + + ^ fileReference children + select: [ :e | e basename match: aString ] + thenCollect: [ :e | e halt ]! Item was added: + ----- Method: FileDirectory>>fileReference: (in category 'accessing') ----- + fileReference: aFileReference + + fileReference := aFileReference! Item was added: + ----- Method: FileDirectory>>fullNameFor: (in category 'accessing') ----- + fullNameFor: aString + + ^ (self fileNamed: aString) fullName! Item was added: + ----- Method: FileDirectory>>oldFileNamed: (in category 'file-opening') ----- + oldFileNamed: aString + + ^ (self fileNamed: aString) readStream! Item was removed: - ----- Method: GtTranscript>>ensureCr (in category '*VMMakerCompatibilityForPharo6') ----- - ensureCr - "do nothing" - (self text isEmpty or: [ self text last == Character cr]) ifFalse: - [ self cr ]! Item was removed: - ----- Method: GtTranscript>>flush (in category '*VMMakerCompatibilityForPharo6') ----- - flush - "do nothing"! Item was removed: - ----- Method: GtTranscript>>next:put: (in category '*VMMakerCompatibilityForPharo6') ----- - next: anInteger put: aCharacter - "Make anObject be the next anInteger number of objects accessible by the - receiver. Answer anObject." - - 1 to: anInteger do: [:i| self nextPut: aCharacter ]. - ^ aCharacter! Item was added: + Object subclass: #PackageOrganizer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMakerCompatibilityForPharo6-PackageOrganizer'! Item was added: + ----- Method: PackageOrganizer class>>default (in category 'accessing') ----- + default + + ^ self new! Item was added: + ----- Method: PackageOrganizer>>packageOfClass: (in category 'accessing') ----- + packageOfClass: aClass + + ^ aClass package! Item was changed: ----- Method: RBMessageNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of me" "selector is sometimes a Symbol, sometimes a SelectorNode!! On top of this, numArgs is needed due to the (truly grody) use of arguments as a place to store the extra expressions needed to generate code for in-line to:by:do:, etc. see below, where it is used. Expand super nodes in place. Elide sends of halt so that halts can be sprinkled through the simulator but will be eliminated from the generated C." + | usedSelector rcvrOrNil args | + usedSelector := selector. - | rcvrOrNil args ifNotNilBlock | rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod]. (rcvrOrNil notNil and: [rcvrOrNil isVariable and: [rcvrOrNil name = 'super']]) ifTrue: + [^aTMethod superExpansionNodeFor: usedSelector args: arguments]. + usedSelector == #halt ifTrue: [^rcvrOrNil]. + (usedSelector == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." + or: [usedSelector == #cCode:]) ifTrue: - [^aTMethod superExpansionNodeFor: selector args: arguments]. - selector == #halt ifTrue: [^rcvrOrNil]. - (selector == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." - or: [selector == #cCode:]) ifTrue: [arguments first isBlockNode ifTrue: [| block | ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1 ifTrue: [block statements first] ifFalse: [block]]. (arguments first isLiteralNode and: [arguments first value isString and: [arguments first value isEmpty]]) ifTrue: [^arguments first asTranslatorNodeIn: aTMethod]]. args := arguments collect: [:arg| arg asTranslatorNodeIn: aTMethod]. + + (usedSelector == #to:do:) ifTrue: [ | block | + usedSelector := #to:by:do:. + block := args second. + args := OrderedCollection + with: args first + with: (TConstantNode new setValue: 1) + with: args second + with: (TAssignmentNode new + setVariable: (arguments first asTranslatorNodeIn: aTMethod) + expression: (TConstantNode new setValue: 1); + yourself) + with: (TSendNode new + setSelector: #<= + receiver: (TVariableNode new setName: block args first) + arguments: { receiver asTranslatorNodeIn: aTMethod }) + with: (TAssignmentNode new + setVariable: (TVariableNode new setName: block args first) + expression: (TSendNode new + setSelector: #+ + receiver: (TVariableNode new setName: block args first) + arguments: { TConstantNode new setValue: 1 }); + yourself) + ]. + + (usedSelector == #ifNil:ifNotNil:) ifTrue: [ + usedSelector := #ifTrue:ifFalse:. + rcvrOrNil := TSendNode new + setSelector: #== + receiver: rcvrOrNil + arguments: { TVariableNode new setName: 'nil' } ]. + + (usedSelector == #ifTrue:ifFalse: and: [arguments first statements isEmpty]) ifTrue: + [usedSelector := #ifFalse:. args := {args last}]. + (usedSelector == #ifTrue:ifFalse: and: [arguments last statements isEmpty]) ifTrue: + [usedSelector := #ifTrue:. args := {args first}]. + (usedSelector == #ifFalse:ifTrue: and: [arguments first statements isEmpty]) ifTrue: + [usedSelector := #ifTrue:. args := {args last}]. + (usedSelector == #ifFalse:ifTrue: and: [arguments last statements isEmpty]) ifTrue: + [usedSelector := #ifTrue:. args := {args first}]. + + ((usedSelector == #ifFalse: or: [usedSelector == #or:]) + and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue: + ["Restore argument block that got moved by transformOr: or transformIfFalse:" + args := {(arguments at: 2) asTranslatorNodeIn: aTMethod}]. + (args size > usedSelector numArgs and: [usedSelector ~~ #to:by:do:]) ifTrue: "to:by:do: has iLimiT hidden in last arg" + ["prune the extra blocks left by ifTrue:, ifFalse:, and: & or:" + self assert: args size - usedSelector numArgs = 1. + self assert: (args last isStmtList + and: [args last statements size = 1 + and: [(args last statements first isVariable + or: [args last statements first isConstant]) + and: [#('nil' true false) includes: args last statements first nameOrValue]]]). + args := args first: usedSelector numArgs]. + + ((CCodeGenerator isVarargsSelector: usedSelector) - (selector == #ifTrue:ifFalse: and: [arguments first statements isEmpty]) ifTrue: - [selector := #ifFalse:. args := {args last}]. - (selector == #ifTrue:ifFalse: and: [arguments last statements isEmpty]) ifTrue: - [selector := #ifTrue:. args := {args first}]. - (selector == #ifFalse:ifTrue: and: [arguments first statements isEmpty]) ifTrue: - [selector := #ifTrue:. args := {args last}]. - (selector == #ifFalse:ifTrue: and: [arguments last statements isEmpty]) ifTrue: - [selector := #ifTrue:. args := {args first}]. - ((CCodeGenerator isVarargsSelector: selector) and: [args last isCollection and: [args last isSequenceable]]) ifTrue: [args := args allButLast, args last]. ^TSendNode new + setSelector: usedSelector - setSelector: selector receiver: rcvrOrNil arguments: args! Item was changed: ----- Method: RBMethodNode>>asTranslationMethodOfClass: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslationMethodOfClass: aTMethodClass "Answer a TMethod (or subclass) derived from the receiver." | additionalMethodState | additionalMethodState := AdditionalMethodState forMethod: nil selector: selector. pragmas ifNotNil: [pragmas do: [:pragmaNode| additionalMethodState := additionalMethodState copyWith: pragmaNode asPragma]]. + ^aTMethodClass new setSelector: selector definingClass: compilationContext getClass args: arguments + locals: ((self allDefinedVariables copyWithoutAll: (arguments collect: #name)) collect: [:string| string -> string]) - locals: ((self allDefinedVariables copyWithoutAll: arguments) collect: [:string| string -> string]) block: (body lastIsReturn ifTrue: [body] ifFalse: [body shallowCopy addSelfReturn; yourself]) primitive: ((pragmas ifNotNil: [pragmas detect: [:pragmaNode| pragmaNode selector beginsWith: #primitve:] ifNone: []]) ifNil: [0] ifNotNil: [:pragmaNode| pragmaNode arguments first value]) properties: additionalMethodState comment: self commentOrNil! Item was changed: ----- Method: RBProgramNode>>commentOrNil (in category '*VMMakerCompatibilityForPharo6-C translation') ----- commentOrNil + + | comments | + comments := self propertyAt: #comments ifAbsent: [ ^ nil ]. + ^ comments collect: #contents! - ^self propertyAt: #comments ifAbsent: []! Item was added: + ----- Method: Scanner>>typedScanTokens: (in category '*VMMakerCompatibilityForPharo6') ----- + typedScanTokens: textOrString + "Answer an Array that has been tokenized with literals mapped to literals, + special characters mapped to symbols and variable names and keywords + to strings. This methiod accepts _ (underscore) as an assignment token + irrespective of whether the system prefers := as the assignment token." + | s | + self initScannerForTokenization. + self scan: (ReadStream on: textOrString asString). + s := WriteStream on: (Array new: 16). + [tokenType == #doIt] whileFalse: + [(token == #- + and: [(self typeTableAt: hereChar) == #xDigit]) ifTrue: + [self scanToken. + token := token negated]. + s nextPut: token. + self scanToken]. + ^s contents + + "Scanner new typedScanTokens: (Scanner sourceCodeAt: #typedScanTokens:)"! Item was added: + ----- Method: SystemNavigation>>allCallsOn:localTo: (in category '*VMMakerCompatibilityForPharo6') ----- + allCallsOn: aSymbol localTo: aClass + + ^ self allCallsOn: aSymbol from: aClass! Item was added: + ----- Method: TParseNode>>name (in category '*VMMakerCompatibilityForPharo6') ----- + name + + ^ self printString! Item was added: + ----- Method: Time class>>dateAndTimeNow (in category '*VMMakerCompatibilityForPharo6') ----- + dateAndTimeNow + + | now | + now := DateAndTime now. + ^ { now asDate . now asTime }! Item was added: + Object subclass: #VMMakerFile + instanceVariableNames: 'fileReference' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMakerCompatibilityForPharo6-FileDirectoryToFileSystem'! Item was added: + ----- Method: VMMakerFile class>>on: (in category 'instance-creation') ----- + on: aString + + ^ self new + fileReference: aString asFileReference; + yourself! Item was added: + ----- Method: VMMakerFile>>contentsOfEntireFile (in category 'accessing') ----- + contentsOfEntireFile + + ^ fileReference contents! Item was added: + ----- Method: VMMakerFile>>exists (in category 'testing') ----- + exists + + ^ fileReference exists and: [ fileReference isFile ]! Item was added: + ----- Method: VMMakerFile>>fileReference: (in category 'accessing') ----- + fileReference: aFileReference + fileReference := aFileReference!

1 0

VM Maker Inbox: VMMaker.oscog-GAP.2533.mcz
by commits＠source.squeak.org 07 May '19

07 May '19

A new version of VMMaker was added to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMaker.oscog-GAP.2533.mcz ==================== Summary ==================== Name: VMMaker.oscog-GAP.2533 Author: GAP Time: 7 May 2019, 10:57:16.034354 am UUID: 3209319f-60f3-4586-8d03-cfac3c9fddee Ancestors: VMMaker.oscog-eem.2532 Convert numeric constants to strings for concatenation. Required for Pharo compatibility, where the arguments of concatenation are not automatically coerced to strings. =============== Diff against VMMaker.oscog-eem.2532 =============== Item was changed: ----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock "Enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct." "(CogAbstractInstruction withAllSubclasses reject: [:c| c name includesSubString: 'ForTests']) do: [:c| Transcript print: c; cr. c printTypedefOn: Transcript]" (self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do: [:ivn| aBinaryBlock value: ivn value: (ivn caseOf: { ['address'] -> [#usqInt]. "usqInt is always large enough to contain a pointer; we do not need to use usqIntptr_t" ['machineCode'] -> [self machineCodeDeclaration]. + ['operands'] -> [{#usqInt. '[', NumOperands asString, ']'}]. - ['operands'] -> [{#usqInt. '[', NumOperands, ']'}]. ['dependent'] -> ['struct _AbstractInstruction *']} otherwise: [#'unsigned char'])]! Item was changed: ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator #( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation' 'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass' 'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses' 'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters' 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do: [:simulationVariableNotNeededForRealVM| aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM]. NewspeakVM ifFalse: [#( 'selfSendTrampolines' 'dynamicSuperSendTrampolines' 'implicitReceiverSendTrampolines' 'outerSendTrampolines' 'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do: [:variableNotNeededInNormalVM| aCCodeGenerator removeVariable: variableNotNeededInNormalVM]]. aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time" aCCodeGenerator addHeaderFile:'<stddef.h>'; "for e.g. offsetof" addHeaderFile:'"sqCogStackAlignment.h"'; addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up" addHeaderFile:'"cogmethod.h"'. NewspeakVM ifTrue: [aCCodeGenerator addHeaderFile:'"nssendcache.h"']. aCCodeGenerator addHeaderFile:'#if COGMTVM'; addHeaderFile:'"cointerpmt.h"'; addHeaderFile:'#else'; addHeaderFile:'"cointerp.h"'; addHeaderFile:'#endif'; addHeaderFile:'"cogit.h"'. aCCodeGenerator var: #ceGetFP declareC: 'usqIntptr_t (*ceGetFP)(void)'; var: #ceGetSP declareC: 'usqIntptr_t (*ceGetSP)(void)'; var: #ceCaptureCStackPointers declareC: 'void (*ceCaptureCStackPointers)(void)'; var: #ceEnterCogCodePopReceiverReg declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)'; var: #realCEEnterCogCodePopReceiverReg declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)'; var: #ceCallCogCodePopReceiverReg declareC: 'void (*ceCallCogCodePopReceiverReg)(void)'; var: #realCECallCogCodePopReceiverReg declareC: 'void (*realCECallCogCodePopReceiverReg)(void)'; var: #ceCallCogCodePopReceiverAndClassRegs declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)'; var: #realCECallCogCodePopReceiverAndClassRegs declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)'; var: #ceFlushICache declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)'; var: #ceCheckFeaturesFunction declareC: 'static usqIntptr_t (*ceCheckFeaturesFunction)(void)'; var: #ceTryLockVMOwner declareC: 'usqIntptr_t (*ceTryLockVMOwner)(void)'; var: #ceUnlockVMOwner declareC: 'void (*ceUnlockVMOwner)(void)'; var: #postCompileHook declareC: 'void (*postCompileHook)(CogMethod *)'; var: #openPICList declareC: 'CogMethod *openPICList = 0'; var: #maxMethodBefore type: #'CogBlockMethod *'; var: 'enumeratingCogMethod' type: #'CogMethod *'. aCCodeGenerator declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel" var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel'; var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'. self declareC: #(abstractOpcodes stackCheckLabel blockEntryLabel blockEntryNoContextSwitch stackOverflowCall sendMiss entry noCheckEntry selfSendEntry dynSuperEntry fullBlockNoContextSwitchEntry fullBlockEntry picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 cPICEndOfCodeLabel) as: #'AbstractInstruction *' in: aCCodeGenerator. aCCodeGenerator declareVar: #blockStarts type: #'BlockStart *'; declareVar: #fixups type: #'BytecodeFixup *'. aCCodeGenerator var: #ordinarySendTrampolines declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]'; var: #superSendTrampolines declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'. BytecodeSetHasDirectedSuperSend ifTrue: [aCCodeGenerator var: #directedSuperSendTrampolines declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]'; var: #directedSuperBindingSendTrampolines declareC: 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]']. NewspeakVM ifTrue: [aCCodeGenerator var: #selfSendTrampolines declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]'; var: #dynamicSuperSendTrampolines declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]'; var: #implicitReceiverSendTrampolines declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]'; var: #outerSendTrampolines declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]']. aCCodeGenerator var: #trampolineAddresses declareC: 'static char *trampolineAddresses[NumTrampolines*2]'; var: #objectReferencesInRuntime declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]'; var: #labelCounter type: #int; var: #traceFlags declareC: 'int traceFlags = 8 /* prim trace log on by default */'; var: #cStackAlignment declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'. aCCodeGenerator declareVar: #CFramePointer type: #'void *'; declareVar: #CStackPointer type: #'void *'; declareVar: #minValidCallAddress type: #'usqIntptr_t'; declareVar: #debugPrimCallStackOffset type: #'usqIntptr_t'. aCCodeGenerator vmClass generatorTable ifNotNil: [:bytecodeGenTable| aCCodeGenerator var: #generatorTable + declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size asString, ']', - declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']', (self tableInitializerFor: bytecodeGenTable in: aCCodeGenerator)]. "In C the abstract opcode names clash with the Smalltak generator syntactic sugar. Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic sugar to avoid the clash." (self organization listAtCategoryNamed: #'abstract instructions') do: [:s| aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)]. aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev May 2019