[Vm-dev] VM Maker: VMMaker.oscog-eem.1776.mcz

Eliot Miranda eliot.miranda at gmail.com
Fri Apr 8 21:58:24 UTC 2016


Hi Nicolas,

On Fri, Apr 8, 2016 at 2:07 PM, Nicolas Cellier <
nicolas.cellier.aka.nice at gmail.com> wrote:

>
>
>
> 2016-04-07 3:16 GMT+02:00 <commits at source.squeak.org>:
>
>>
>> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
>> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1776.mcz
>>
>> ==================== Summary ====================
>>
>> Name: VMMaker.oscog-eem.1776
>> Author: eem
>> Time: 6 April 2016, 6:15:12.993129 pm
>> UUID: ffb1c333-7c42-4f80-a951-74db178aab65
>> Ancestors: VMMaker.oscog-eem.1775
>>
>> Simulator:
>> Several fixes for coercion given Nicolas' new 32-bit LargeInteger plugin
>> code.
>> The LargeIntegersPlugin needs to coerce the arguments to
>> cDigitOf:at:[put:] correctly during simulation.
>> Coercion needs to support #'unsigned int *'.
>> Hack read & write in the FilePluginSimulator which should declare the
>> pointer args byteArrayIndex correctly and access them via at: but for
>> historical reasons treated them as integers.
>>
>> =============== Diff against VMMaker.oscog-eem.1775 ===============
>>
>> Item was added:
>> + ----- Method: CArray>>asCArrayAccessorUnitSize: (in category
>> 'converting') -----
>> + asCArrayAccessorUnitSize: requiredUnitSize
>> +       self assert: ptrOffset = 0.
>> +       ^CArrayAccessor on: (requiredUnitSize = unitSize
>> +                                                               ifTrue:
>> [self]
>> +                                                               ifFalse:
>> [self shallowCopy unitSize: requiredUnitSize])!
>>
>>
> Hi Eliot,
> I wonder why there is an offset correction in asCArrayAccessor
>
>     ^ (CArrayAccessor on: self)
>             += -1   "Defeat the +1 offset in the accessor"
>
> while there it is none here.
> Are you sure it works?
>
> Should we assert some alignment props too?
>

All I know is that the simulator sort-of works.  I know it doesn't work
perfectly (large fonts in the Squeak 5.0 workspace are not rendered
correctly), but LargeInteger operations work correctly.  I think we need to
write some tests.  The CArray stuff is not at all specified or commented.


>
>> Item was added:
>> + ----- Method: CArray>>cPtrAsOop (in category 'accessing') -----
>> + cPtrAsOop
>> +       ^arrayBaseAddress + ptrOffset!
>>
>> Item was changed:
>>   ----- Method: CArray>>coerceTo:sim: (in category 'converting') -----
>>   coerceTo: cTypeString sim: interpreterSimulator
>>
>>         ^cTypeString caseOf: {
>>                 ['int']                         -> [self ptrAddress].
>> +               ['float *']                     -> [(self
>> asCArrayAccessorUnitSize: 4) asFloatAccessor].
>> +               ['unsigned int *']      -> [(self
>> asCArrayAccessorUnitSize: 4) asUnsignedIntAccessor].
>> +               ['int *']                               -> [(self
>> asCArrayAccessorUnitSize: 4) asIntAccessor].
>> -               ['float *']                     -> [self asCArrayAccessor
>> asFloatAccessor].
>> -               ['int *']                               -> [self
>> asCArrayAccessor asIntAccessor].
>>                 ['char *']                      -> [self shallowCopy
>> unitSize: 1; yourself].
>>                 ['unsigned char *']     -> [self shallowCopy unitSize: 1;
>> yourself].
>>                 ['unsigned']                    -> [self ptrAddress].
>>                 ['sqInt']                               -> [self
>> ptrAddress].
>>                 ['usqInt']                      -> [self ptrAddress] }!
>>
>> Item was added:
>> + ----- Method: CArray>>unsignedIntAt: (in category 'accessing') -----
>> + unsignedIntAt: index
>> +       ^self at: index!
>>
>> Item was added:
>> + ----- Method: CArray>>unsignedIntAt:put: (in category 'accessing') -----
>> + unsignedIntAt: index put: unsignedInt
>> +       ^ self at: index put: unsignedInt!
>>
>> Item was added:
>> + ----- Method: CObjectAccessor>>asUnsignedIntAccessor (in category
>> 'converting') -----
>> + asUnsignedIntAccessor
>> +
>> +       ^ self asPluggableAccessor
>> +               atBlock: [:obj :index | obj unsignedIntAt: index]
>> +               atPutBlock: [:obj :index :value | obj unsignedIntAt:
>> index put: value]!
>>
>> Item was changed:
>>   ----- Method: FilePluginSimulator>>sqFile:Read:Into:At: (in category
>> 'simulation') -----
>> + sqFile: file Read: count Into: byteArrayIndexArg At: startIndex
>> +       | interpreter byteArrayIndex |
>> - sqFile: file Read: count Into: byteArrayIndex At: startIndex
>> -       | interpreter |
>>         interpreter := interpreterProxy interpreter.
>> +       byteArrayIndex := byteArrayIndexArg isInteger ifTrue:
>> [byteArrayIndexArg] ifFalse: [byteArrayIndexArg cPtrAsOop].
>>         [[startIndex to: startIndex + count - 1 do:
>>                 [ :i |
>>                 file atEnd ifTrue:
>>                         [(file isKindOf: FakeStdinStream) ifTrue: [file
>> atEnd: false].
>>                          ^i - startIndex].
>>                 interpreter
>>                         byteAt: byteArrayIndex + i
>>                         put: file next asInteger]]
>>                         on: Error
>>                         do: [:ex|
>>                                 (file isKindOf: TranscriptStream)
>> ifFalse: [ex pass].
>>                                 ^0]]
>>                 ensure: [self recordStateOf: file].
>>         ^count!
>>
>> Item was changed:
>>   ----- Method: FilePluginSimulator>>sqFile:Write:From:At: (in category
>> 'simulation') -----
>> + sqFile: file Write: count From: byteArrayIndexArg At: startIndex
>> +       | interpreter byteArrayIndex |
>> - sqFile: file Write: count From: byteArrayIndex At: startIndex
>> -       | interpreter |
>>         interpreter := interpreterProxy interpreter.
>> +       byteArrayIndex := byteArrayIndexArg isInteger ifTrue:
>> [byteArrayIndexArg] ifFalse: [byteArrayIndexArg cPtrAsOop].
>>         file isBinary
>>                 ifTrue:
>>                         [startIndex to: startIndex + count - 1 do:
>>                                 [ :i | file nextPut: (interpreter byteAt:
>> byteArrayIndex + i)]]
>>                 ifFalse:
>>                         [startIndex to: startIndex + count - 1 do:
>>                                 [ :i | | byte |
>>                                 byte := interpreter byteAt:
>> byteArrayIndex + i.
>>                                 file nextPut: (Character value: (byte ==
>> 12 "lf" ifTrue: [15"cr"] ifFalse: [byte]))]].
>>         self recordStateOf: file.
>>         ^count!
>>
>> Item was changed:
>>   ----- Method: Integer>>coerceTo:sim: (in category '*VMMaker-interpreter
>> simulator') -----
>>   coerceTo: cTypeString sim: interpreter
>>
>>         | unitSize |
>> +       cTypeString last = $* ifTrue:  "C pointer"
>> +               [unitSize := cTypeString caseOf: {
>> -       cTypeString last = $* ifTrue: [  "C pointer"
>> -               unitSize := cTypeString caseOf: {
>>                 ['char *'] -> [1].
>>                 ['short *'] -> [2].
>>                 ['int *'] -> [4].
>>                 ['long *'] -> [interpreter wordSize].
>>                 ['float *'] -> [4].
>>                 ['double *'] -> [8].
>>                 ['unsigned *'] -> [4].
>> +               ['unsigned int *'] -> [4].
>> +               ['unsigned char *'] -> [4].
>> +               ['unsigned short *'] -> [4].
>>                 ['oop *'] -> [interpreter bytesPerOop].
>>                 }
>>                 otherwise: [ (cTypeString beginsWith: 'char') ifTrue: [1]
>> ifFalse: [interpreter wordSize] ].
>> +               ^CArray basicNew
>> -               ^(CArray basicNew)
>>                         interpreter: interpreter address: self unitSize:
>> unitSize;
>> +                       yourself].
>> -                       yourself.
>> -       ].
>>         ^ self  "C number (int, char, float, etc)"!
>>
>> Item was changed:
>>   ----- Method: LargeIntegersPlugin>>cDigitOf:at: (in category 'C core
>> util') -----
>>   cDigitOf: cPointer at: zeroBasedDigitIndex
>>         <inline: true>
>>         <returnTypeC: #'unsigned int'>
>>         <var: 'cPointer' type: #'unsigned int *'>
>> +       ^self byteSwapped32IfBigEndian: ((self cCode: [cPointer]
>> inSmalltalk: [interpreterProxy cCoerce: cPointer to: #'unsigned int *'])
>> at: zeroBasedDigitIndex)!
>> -       ^self byteSwapped32IfBigEndian: (cPointer at:
>> zeroBasedDigitIndex)!
>>
>> Item was changed:
>>   ----- Method: LargeIntegersPlugin>>cDigitOf:at:put: (in category 'C
>> core util') -----
>>   cDigitOf: cPointer at: zeroBasedDigitIndex put: aValue
>>         <inline: true>
>>         <returnTypeC: #'unsigned int'>
>>         <var: 'cPointer' type: #'unsigned int *'>
>>         <var: 'aValue' type: #'unsigned int'>
>> +       ^(self cCode: [cPointer] inSmalltalk: [interpreterProxy cCoerce:
>> cPointer to: #'unsigned int *'])
>> +               at: zeroBasedDigitIndex
>> +               put: (self byteSwapped32IfBigEndian: aValue)!
>> -       ^cPointer at: zeroBasedDigitIndex put: (self
>> byteSwapped32IfBigEndian: aValue)!
>>
>>
>
>


-- 
_,,,^..^,,,_
best, Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20160408/5d11cebd/attachment-0001.htm


More information about the Vm-dev mailing list