[Vm-dev] VM Maker: VMMaker.oscog-AlistairGrant.2455.mcz

Eliot Miranda eliot.miranda at gmail.com
Mon Oct 15 19:57:52 UTC 2018


Hi Alistair,

also
    var := (self getenv: (self cCode: [key] inSmalltalk: [key allButLast]))
ifNil: [0].
doesn't make sense to me.  In C nil == 0.  So ifNil: [0] is a no-op in C.
Either the genenv: simulation should answer 0 or it should answer nil.  But
we shouldn't fix the primitive two handle incorrect simulation; we should
instead implement the simulated getenv: to match what the primitive
expects.  Make sense?

On Mon, Oct 15, 2018 at 11:18 AM <commits at source.squeak.org> wrote:

>
> Alistair Grant uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-AlistairGrant.2455.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-AlistairGrant.2455
> Author: AlistairGrant
> Time: 14 October 2018, 8:59:01.383815 pm
> UUID: 9e8e4134-b30b-4734-9477-95d556650155
> Ancestors: VMMaker.oscog-eem.2454
>
> VMClass strlen, strncpy and getenv
>
> Pharo stores UTF8 encoded strings in ByteArrays (ByteString, strictly
> speaking, expects to only store characters that can be represented as a
> single byte in UTF8).  ByteArrays are also used within the simulator to
> represent buffers allocated by the simulator.  As such, the strings may
> either be the length of the ByteArray or less than the ByteArray size and
> null terminated.
>
> These changes extend strlen: and strncpy:_:_: to handle ByteArrays and add
> some tests (tests for strings in the object memory are todo).
>
> InterpreterPrimitives>>primitiveGetenv: returned nil rather than 0 in the
> simulator when a variable that isn't defined is requested.
>
> =============== Diff against VMMaker.oscog-eem.2454 ===============
>
> Item was changed:
>   ----- Method: InterpreterPrimitives>>primitiveGetenv (in category 'other
> primitives') -----
>   primitiveGetenv
>         "Access to environment variables via getenv.  No putenv or setenv
> as yet."
>         | key var result |
>         <export: true>
>         <var: #key type: #'char *'>
>         <var: #var type: #'char *'>
>         sHEAFn ~= 0 ifTrue: "secHasEnvironmentAccess"
>                 [self sHEAFn ifFalse: [^self primitiveFailFor:
> PrimErrInappropriate]].
>         key := self cStringOrNullFor: self stackTop.
>         key = 0 ifTrue:
>                 [self successful ifTrue:
>                         [^self primitiveFailFor: PrimErrBadArgument].
>                  ^self primitiveFailFor: primFailCode].
> +       var := (self getenv: (self cCode: [key] inSmalltalk: [key
> allButLast])) ifNil: [0].
> -       var := self getenv: (self cCode: [key] inSmalltalk: [key
> allButLast]).
>         self free: key.
>         var ~= 0 ifTrue:
>                 [result := objectMemory stringForCString: var.
>                  result ifNil:
>                         [^self primitiveFailFor: PrimErrNoMemory]].
>         self assert: primFailCode = 0.
>         self pop: 2 thenPush: (var = 0 ifTrue: [objectMemory nilObject]
> ifFalse: [result])!
>
> Item was changed:
>   ----- Method: VMClass>>strlen: (in category 'C library simulation') -----
>   strlen: aCString
>         "Simulate strlen(3)"
>         <doNotGenerate>
>         | len |
>         aCString isString ifTrue:
>                 [^aCString size].
> +       aCString class == ByteArray ifTrue: [
> +               "ByteArrays may be 0 terminated or the correct length (in
> the simulator)"
> +               len := 0.
> +               [(len = aCString size or: [(aCString at: len+1) = 0])
> ifTrue: [^len].
> +               len := len + 1] repeat].
> +       "Must be an address"
>         len := 0.
>         [(self byteAt: aCString + len) = 0 ifTrue: [^len].
>         len := len + 1] repeat!
>
> Item was changed:
>   ----- Method: VMClass>>strncpy:_:_: (in category 'C library simulation')
> -----
>   strncpy: aString _: bString _: n
>         <doNotGenerate>
>         "implementation of strncpy(3)"
> +
> +       | getBlock setBlock count |
> +
> +       count := n.
> +       aString isString ifTrue: [setBlock := [ :idx :ch | aString at: idx
> put: ch asCharacter]].
> +       aString class == ByteArray ifTrue:
> +                       [setBlock := [ :idx :ch | aString at: idx put:
> ch]].
> +       aString isInteger ifTrue: [setBlock := [ :idx :ch | self byteAt:
> aString + idx - 1 put: ch]].
> +       bString isString ifTrue: [
> +               getBlock := [ :idx | (bString at: idx) asInteger ].
> +               count := count min: bString size].
> +       bString class == ByteArray ifTrue: [
> +               getBlock := [ :idx | bString at: idx].
> +               count := count min: bString size].
> +       bString isInteger ifTrue: [getBlock := [ :idx | self byteAt:
> bString + idx - 1]].
> +       bString class == CArray ifTrue:
> +                       [getBlock := [ :idx | bString at: idx - 1]].
> +       self assert: getBlock ~= nil.
> +       self assert: setBlock ~= nil.
> +       1 to: count do: [ :i | | v |
> +               v := getBlock value: i.
> +               setBlock value: i value: v.
> +               v = 0 ifTrue: [^aString] ].
> -       aString isString
> -               ifTrue:
> -                       [1 to: n do:
> -                               [:i| | v |
> -                               v := bString isString
> -                                               ifTrue: [bString at: i]
> -                                               ifFalse: [Character value:
> (self byteAt: bString + i - 1)].
> -                               aString at: i put: v.
> -                               v asInteger = 0 ifTrue: [^aString]]]
> -               ifFalse:
> -                       [1 to: n do:
> -                               [:i| | v |
> -                               v := bString isString
> -                                               ifTrue: [(bString at: i)
> asInteger]
> -                                               ifFalse: [self byteAt:
> bString + i - 1].
> -                               self byteAt: aString + i - 1 put: v.
> -                               v = 0 ifTrue: [^aString]]].
>         ^aString!
>
> Item was added:
> + TestCase subclass: #VMClassTests
> +       instanceVariableNames: 'testString vmclass'
> +       classVariableNames: ''
> +       poolDictionaries: ''
> +       category: 'VMMaker-Tests'!
>
> Item was added:
> + ----- Method: VMClassTests>>initialize (in category
> 'initialize-release') -----
> + initialize
> +
> +       super initialize.
> +       testString := 'hello world'.!
>
> Item was added:
> + ----- Method: VMClassTests>>setUp (in category 'running') -----
> + setUp
> +
> +       super setUp.
> +       vmclass := VMClass new.
> + !
>
> Item was added:
> + ----- Method: VMClassTests>>testStrlen (in category 'tests') -----
> + testStrlen
> +
> +       | testByteArray |
> +
> +       "Instances of String must be the correct length"
> +       self assert: (vmclass strlen: testString) equals: testString size.
> +
> +       "Instances of ByteArray can optionally have trailing nulls"
> +       testByteArray := testString asByteArray.
> +       self assert: (vmclass strlen: testByteArray) equals: testString
> size.
> +       testByteArray := testByteArray, (ByteArray new: 3).
> +       self assert: (vmclass strlen: testByteArray) equals: testString
> size.
> + !
>
> Item was added:
> + ----- Method: VMClassTests>>testStrncpy (in category 'tests') -----
> + testStrncpy
> +
> +       | stringA byteArrayA |
> +
> +       stringA := String new: 5.
> +       vmclass strncpy: stringA _: testString _: stringA size.
> +       self assert: stringA equals: 'hello'.
> +
> +       stringA := String new: testString size + 3.
> +       vmclass strncpy: stringA _: testString _: stringA size.
> +       self assert: stringA equals: (testString, (String new: 3)).
> +
> +       byteArrayA := ByteArray new: 5.
> +       vmclass strncpy: byteArrayA _: testString _: byteArrayA size.
> +       self assert: byteArrayA equals: 'hello' asByteArray.
> +
> +       byteArrayA := ByteArray new: testString size + 3.
> +       vmclass strncpy: byteArrayA _: testString _: byteArrayA size.
> +       self assert: byteArrayA equals: (testString, (String new: 3))
> asByteArray.
> +
> + !
>
>

-- 
_,,,^..^,,,_
best, Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20181015/de5bd18f/attachment.html>


More information about the Vm-dev mailing list