[Vm-dev] Re: VM Maker: VMMaker.oscog-tfel.1677.mcz

timfelgentreff timfelgentreff at gmail.com
Sun Feb 21 17:48:36 UTC 2016


Hi Eliot,

yes, maybe we can find a time to discuss this in a call. These changes I did
were also done to fix the two simulation tests
(testAlphaCompositingSimulated and testAlphaCompositingSimulated2) which
were failing on a fresh image with VMMaker loaded for me. Were they not
failing for you? These tests have been there since 2009, and I assumed they
use a valid entry point into the simulation (namely
BitBlt>>copyBitsSimulated). Were not actually running an entire simulator,
we're just running the Slang code directly in the system (like those tests
to), and ideally I'd like this to be done in a way that would work on any
Squeak VM (if you don't use the Balloon or BitBlt plugins, for example).

Using your latest version, these BitBltSimulation tests are failing again
for me, do they work for you?

Cheers,
Tim


Eliot Miranda-2 wrote
> Hi Tim,
> 
> On Fri, Feb 19, 2016 at 3:36 PM, Eliot Miranda <

> eliot.miranda@

> >
> wrote:
> 
>> Hi Tim,
>>
>>     alas this:
>>
>> + ----- Method: BitBltSimulator>>halftoneAt: (in category 'memory
>> access')
>> -----
>> + halftoneAt: idx
>> +
>> +       ^ (halftoneBase + (idx \\ halftoneHeight * 4)) long32At: 0!
>>
>> breaks the VM simulator, my main development environment for the VM.  I
>> know you need to progress but can I ask you to test your changes against
>> some valid simulation before committing?  Here's an expression that
>> should
>> run the standard VM simulator and given a suitable image should run
>> without
>> problems:
>>
>>
>> | vm om |
>> vm := StackInterpreterSimulator newWithOptions: #(#ObjectMemory
>> #Spur32BitMemoryManager ).
>> om := vm objectMemory.
>> vm desiredNumStackPages: 8. "*Makes simulation faster by creating fewer
>> stack pages.*"
>> vm openOn: '/Users/eliot/Cog/spurreader.image'. "*Choose any image but if
>> you use one created
>> by
>> http://www.squeakvm.org/svn/squeak/branches/Cog/image/buildspurtrunkreaderimage.sh
>> <http://www.squeakvm.org/svn/squeak/branches/Cog/image/buildspurtrunkreaderimage.sh>
>> you'll be able to interact with it throguh a little dialog box that reads
>> chunk format expressions, simulating the reader in the image that reads
>> chunk expressions from stdin.*"
>> vm instVarNamed: 'assertVEPAES' put: false. "*This makes the simulation
>> faster by turning off some expensive asserts*"
>> ^ [vm openAsMorph; halt; run]
>> on: Halt , ProvideAnswerNotification "This exception handler i*gnores
>> some halts and confirmers occurring during simulation*"
>> do: [:ex |
>> ex messageText == #primitiveExecuteMethodArgsArray
>> ifTrue: [ex resume].
>> ex messageText = 'clear transcript?'
>> ifTrue: [ex resume: false].
>> ex pass]
>>
>> Thanks!  I'm about to commit a merge.  I've no idea whether my change,
>> which is:
>>
>> halftoneAt: idx
>>
>> ^self
>> cCode: [(halftoneBase + (idx \\ halftoneHeight * 4)) long32At: 0]
>> inSmalltalk: [self long32At: halftoneBase + (idx \\ halftoneHeight * 4)]
>>
>> will break RSqueak.  Apologies if it does.  Perhaps we can fund time to
>> discuss the differences.  I still don't understand how RSqueak uses
>> primitive simulations, or why, if it does, we can't use a different
>> subclass to isolate RSqueak and the VMSimulator from each other.  This
>> treading on each other's toes is getting painful ;-).
>>
>> For example if you used a consistent naming such as RSqueakFooSimulator
>> and simply copied all the relevant simulation-specific plugin subclasses
>> we
>> would avoid treading on each other's toes and the system would be easier
>> to
>> understand.
>>
>> HTH
>>
> 
> and this also breaks simulation:
> 
> 
> Item was changed:
>   ----- Method: VMClass>>oopForPointer: (in category 'memory access')
> -----
>   oopForPointer: pointerOrSurrogate
>         "This gets implemented by Macros in C, where its types will also
> be
> checked.
>          oop is the width of a machine word, and pointer is a raw
> address."
>         
> <doNotGenerate>
> +       ^pointerOrSurrogate!
> -       ^pointerOrSurrogate asInteger!
> 
> The asInteger is absolutely required.  Again you could override in an
> RSqueak-specific subclass.
> 
> 
>>
>>
>> On Thu, Feb 11, 2016 at 12:56 AM, &lt;

> commits at .squeak

> &gt; wrote:
>>
>>>
>>> Tim Felgentreff uploaded a new version of VMMaker to project VM Maker:
>>> http://source.squeak.org/VMMaker/VMMaker.oscog-tfel.1677.mcz
>>>
>>> ==================== Summary ====================
>>>
>>> Name: VMMaker.oscog-tfel.1677
>>> Author: tfel
>>> Time: 11 February 2016, 9:48:04.961 am
>>> UUID: e845ffd7-66b9-594f-b02c-350f015e9cbf
>>> Ancestors: VMMaker.oscog-EstebanLorenzano.1676
>>>
>>> Fix BitBltSimulation (for RSqueak on Spur)
>>>
>>> =============== Diff against VMMaker.oscog-EstebanLorenzano.1676
>>> ===============
>>>
>>> Item was changed:
>>>   ----- Method: BitBlt>>simulatePrimitive:args: (in category
>>> '*VMMaker-Interpreter') -----
>>>   simulatePrimitive: aString args: args
>>>         "simulate primitives in RSqueak"
>>>         aString = 'primitiveCopyBits'
>>> +               ifTrue: [
>>> +                       args size = 1
>>> +                               ifTrue: [^ self copyBitsSimulated: (args
>>> at: 1)]
>>> +                               ifFalse: [^ self copyBitsSimulated]].
>>> -               ifTrue: [^ self copyBitsSimulated].
>>>         aString = 'primitiveWarpBits'
>>>                 ifTrue: [^ self
>>>                                 warpBitsSimulated: (args at: 1)
>>>                                 sourceMap: (args at: 2)].
>>>         ^ InterpreterProxy new primitiveFailFor: 255
>>>   !
>>>
>>> Item was changed:
>>>   ----- Method: BitBltSimulation>>loadColorMap (in category 'interpreter
>>> interface') -----
>>>   loadColorMap
>>>         "ColorMap, if not nil, must be longWords, and
>>>         2^N long, where N = sourceDepth for 1, 2, 4, 8 bits,
>>>         or N = 9, 12, or 15 (3, 4, 5 bits per color) for 16 or 32 bits."
>>>         | cmSize oldStyle oop cmOop |
>>>         
> <inline: true>
>>>         cmFlags := cmMask := cmBitsPerColor := 0.
>>>         cmShiftTable := nil.
>>>         cmMaskTable := nil.
>>>         cmLookupTable := nil.
>>>         cmOop := interpreterProxy fetchPointer: BBColorMapIndex
>>> ofObject:
>>> bitBltOop.
>>>         cmOop = interpreterProxy nilObject ifTrue:[^true].
>>>         cmFlags := ColorMapPresent. "even if identity or somesuch - may
>>> be cleared later"
>>>         oldStyle := false.
>>>         (interpreterProxy isWords: cmOop) ifTrue:[
>>>                 "This is an old-style color map (indexed only, with
>>> implicit RGBA conversion)"
>>>                 cmSize := interpreterProxy slotSizeOf: cmOop.
>>>                 cmLookupTable := interpreterProxy firstIndexableField:
>>> cmOop.
>>>                 oldStyle := true.
>>>         ] ifFalse: [
>>>                 "A new-style color map (fully qualified)"
>>>                 ((interpreterProxy isPointers: cmOop)
>>>                         and:[(interpreterProxy slotSizeOf: cmOop) >= 3])
>>> ifFalse:[^false].
>>>                 cmShiftTable := self loadColorMapShiftOrMaskFrom:
>>>                         (interpreterProxy fetchPointer: 0 ofObject:
>>> cmOop).
>>>                 cmMaskTable := self loadColorMapShiftOrMaskFrom:
>>>                         (interpreterProxy fetchPointer: 1 ofObject:
>>> cmOop).
>>>                 oop := interpreterProxy fetchPointer: 2 ofObject: cmOop.
>>>                 oop = interpreterProxy nilObject
>>>                         ifTrue:[cmSize := 0]
>>>                         ifFalse:[(interpreterProxy isWords: oop)
>>> ifFalse:[^false].
>>>                                         cmSize := (interpreterProxy
>>> slotSizeOf: oop).
>>>                                         cmLookupTable :=
>>> interpreterProxy
>>> firstIndexableField: oop].
>>>                 cmFlags := cmFlags bitOr: ColorMapNewStyle.
>>>                 self cCode: '' inSmalltalk:
>>> +                       [].
>>> -                       [self assert: cmShiftTable unitSize = 4.
>>> -                        self assert: cmMaskTable unitSize = 4.
>>> -                        self assert: cmLookupTable unitSize = 4].
>>>         ].
>>>         (cmSize bitAnd: cmSize - 1) = 0 ifFalse:[^false].
>>>         cmMask := cmSize - 1.
>>>         cmBitsPerColor := 0.
>>>         cmSize = 512 ifTrue: [cmBitsPerColor := 3].
>>>         cmSize = 4096 ifTrue: [cmBitsPerColor := 4].
>>>         cmSize = 32768 ifTrue: [cmBitsPerColor := 5].
>>>         cmSize = 0
>>>                 ifTrue:[cmLookupTable := nil. cmMask := 0]
>>>                 ifFalse:[cmFlags := cmFlags bitOr: ColorMapIndexedPart].
>>>         oldStyle "needs implicit conversion"
>>>                 ifTrue:[        self setupColorMasks].
>>>         "Check if colorMap is just identity mapping for RGBA parts"
>>>         (self isIdentityMap: cmShiftTable with: cmMaskTable)
>>>                 ifTrue:[ cmMaskTable := nil. cmShiftTable := nil ]
>>>                 ifFalse:[ cmFlags := cmFlags bitOr: ColorMapFixedPart].
>>>         ^true!
>>>
>>> Item was added:
>>> + ----- Method: BitBltSimulator>>halftoneAt: (in category 'memory
>>> access') -----
>>> + halftoneAt: idx
>>> +
>>> +       ^ (halftoneBase + (idx \\ halftoneHeight * 4)) long32At: 0!
>>>
>>> Item was added:
>>> + ----- Method: InterpreterProxy>>isNonImmediate: (in category
>>> 'testing')
>>> -----
>>> + isNonImmediate: anObject
>>> +
>>> +       ^ (self isImmediate: anObject) not!
>>>
>>> Item was changed:
>>>   ----- Method: InterpreterProxy>>majorVersion (in category 'other')
>>> -----
>>>   majorVersion
>>> +       ^ 1!
>>> -       self notYetImplemented!
>>>
>>> Item was changed:
>>>   ----- Method: InterpreterProxy>>minorVersion (in category 'other')
>>> -----
>>>   minorVersion
>>> +       ^ 8!
>>> -       self notYetImplemented!
>>>
>>> Item was changed:
>>>   Object subclass: #TMethod
>>>         instanceVariableNames: 'args comment complete declarations
>>> definingClass export extraVariableNumber
>>> globalStructureBuildMethodHasFoo
>>> inline labels locals parseTree primitive properties returnType selector
>>> sharedCase sharedLabel static writtenToGlobalVarsCache
>>> functionAttributes'
>>>         classVariableNames: 'CaseStatements'
>>>         poolDictionaries: ''
>>>         category: 'VMMaker-Translation to C'!
>>> +
>>> + !TMethod commentStamp: 'dtl 9/15/2008 09:06' prior: 0!
>>> + A TMethod is a translation method, representing a MethodNode that is
>>> to
>>> be translated to C source. It has a parseTree of translation nodes that
>>> mirrors the parse tree of the corresponding Smalltalk method.!
>>>
>>> Item was changed:
>>>   Object subclass: #TParseNode
>>>         instanceVariableNames: 'comment'
>>>         classVariableNames: ''
>>>         poolDictionaries: ''
>>>         category: 'VMMaker-Translation to C'!
>>> +
>>> + !TParseNode commentStamp: 'dtl 9/15/2008 09:05' prior: 0!
>>> + A TParseNode is node in the parse tree of a TMethod. Subclasses
>>> correspond to different types of nodes in a method parse tree. The tree
>>> of
>>> translation parse nodes mirrors the parse tree of a Smalltalk method,
>>> and
>>> is used for translating a Smalltalk method to C source.!
>>>
>>> Item was changed:
>>>   ----- Method: VMClass>>oopForPointer: (in category 'memory access')
>>> -----
>>>   oopForPointer: pointerOrSurrogate
>>>         "This gets implemented by Macros in C, where its types will also
>>> be checked.
>>>          oop is the width of a machine word, and pointer is a raw
>>> address."
>>>         
> <doNotGenerate>
>>> +       ^pointerOrSurrogate!
>>> -       ^pointerOrSurrogate asInteger!
>>>
>>>
>>
>>
>> --
>> _,,,^..^,,,_
>> best, Eliot
>>
> 
> 
> 
> -- 
> _,,,^..^,,,_
> best, Eliot





--
View this message in context: http://forum.world.st/Re-VM-Maker-VMMaker-oscog-tfel-1677-mcz-tp4879122p4879395.html
Sent from the Squeak VM mailing list archive at Nabble.com.


More information about the Vm-dev mailing list