VM Maker: VMMaker.oscog-AlistairGrant.2455.mcz

 
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.
+
+ !