VM Maker: VMMaker.oscog-akg.2473.mcz

 
Alistair Grant uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-akg.2473.mcz

==================== Summary ====================

Name: VMMaker.oscog-akg.2473
Author: akg
Time: 24 October 2018, 8:21:56.15293 am
UUID: 62d7a8e5-56fb-4b35-9b4c-17096a668194
Ancestors: VMMaker.oscog-eem.2472

VM simulation fixes:

- #isCArray is true if the receiver provides the interface.
- FilePluginSimulator>>sqFileDeleteName:Size: handles UTF8 character names
-- TODO: Method to be renamed.
- Add InterpreterPlugin>>memcpy:_:_: to delegate to the interpreter proxy
- Remove SpurMemoryManager>>memcpy:_:_: this looks like it was created before VMClass>>memcpy:_:_:, but doesn't handle different argument types.
- Add InterpreterPlugin>>memmove:_:_: to delegate to the interpreter proxy.
- InterpreterPrimitives>>getenv: handle CArrayAccessor.
- InterpreterPrimitives>>primitiveGetenv remove #cCode:inSmalltalk:.
- Add VMClass>>asByteArray: to handle UTF8 strings (which shouldn't be a String)
- VMClass>>memcpy:_:_: handle different parameter types
- VMClass>>strlen: handle CArray(Accessor)s
- VMClass>>strncpy:_:_: handle CArrayAccessors

=============== Diff against VMMaker.oscog-eem.2472 ===============

Item was changed:
  ----- Method: CArray>>isCArray (in category 'testing') -----
  isCArray
+ "Answer a boolean indicating whether the receiver responds to the CArray interface"
+
  ^true!

Item was added:
+ ----- Method: CObjectAccessor>>isCArray (in category 'testing') -----
+ isCArray
+ "Answer a boolean indicating whether the receiver responds to the CArray interface"
+
+ ^true!

Item was changed:
  ----- Method: FilePluginSimulator>>sqFileDeleteName:Size: (in category 'simulation') -----
  sqFileDeleteName: nameIndex Size: nameSize
  | path |
+
+ path := (interpreterProxy asString: nameIndex size: nameSize) asByteArray utf8Decoded.
- path := interpreterProxy asString: nameIndex size: nameSize.
  (StandardFileStream isAFileNamed: path) ifFalse:
  [^interpreterProxy primitiveFail].
  [FileDirectory deleteFilePath: path]
  on: Error
  do: [:ex| interpreterProxy primitiveFail]!

Item was added:
+ ----- Method: InterpreterPlugin>>memcpy:_:_: (in category 'simulation support') -----
+ memcpy: dest _: src _: bytes
+ <doNotGenerate>
+ "implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
+
+ ^interpreterProxy memcpy: dest _: src _: bytes
+ !

Item was added:
+ ----- Method: InterpreterPlugin>>memmove:_:_: (in category 'simulation support') -----
+ memmove: destAddress _: sourceAddress _: bytes
+ <doNotGenerate>
+ "implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
+
+ ^interpreterProxy memmove: destAddress _: sourceAddress _: bytes!

Item was changed:
  ----- Method: InterpreterPrimitives>>getenv: (in category 'simulation support') -----
  getenv: aByteStringOrByteArray
  <doNotGenerate>
  "The primitiveGetenv: primitive answers nil for undefined variables.
  The primitiveGetenv implementation is written to expect getenv: to
  answer 0, not nil,  for undefined variables.  Map nil to 0 for simulation."
+
+ "aByteStringOrByteArray is probably null terminated, convert to non-null-terminated"
+ ^(self primitiveGetenv: (self asString: aByteStringOrByteArray)) ifNil: [0]!
- ^(self primitiveGetenv: aByteStringOrByteArray) ifNil: [0]!

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: key.
- 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: Object>>isCArray (in category '*VMMaker-testing') -----
  isCArray
+ "Answer a boolean indicating whether the receiver responds to the CArray interface"
+
  ^false!

Item was removed:
- ----- Method: SpurMemoryManager>>memcpy:_:_: (in category 'simulation') -----
- memcpy: destAddress _: sourceAddress _: bytes
- "For SpurGenerationScavenger>>copyToFutureSpace:bytes:. N.B. If ranges overlap, must use memmove."
- <doNotGenerate>
- self deny: ((destAddress <= sourceAddress and: [destAddress asInteger + bytes > sourceAddress])
- or: [sourceAddress <= destAddress and: [sourceAddress asInteger + bytes > destAddress]]).
- ^self memmove: destAddress _: sourceAddress _: bytes!

Item was added:
+ ----- Method: VMClass>>asByteArray: (in category 'C library extensions') -----
+ asByteArray: aStringOrStringIndex
+ "aStringOrStringIndex is either a string or an address in the heap.
+ Create a ByteArray of the requested length form the bytes in the
+ heap starting at stringIndex."
+ <doNotGenerate>
+ | sz |
+ aStringOrStringIndex isString ifTrue:
+ [^aStringOrStringIndex asByteArray].
+ sz := self strlen: aStringOrStringIndex.
+ ^self strncpy: (ByteArray new: sz) _: aStringOrStringIndex _: sz!

Item was changed:
  ----- Method: VMClass>>memcpy:_:_: (in category 'C library simulation') -----
+ memcpy: dest _: src _: bytes
- memcpy: dString _: sString _: bytes
  <doNotGenerate>
  "implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
+ | getBlock setBlock |
+
+ (src isInteger and: [dest isInteger]) ifTrue:
+ [ self deny: ((dest <= src and: [dest + bytes > src])
+ or: [src <= dest and: [src + bytes > dest]])].
+
+ "Determine the source and destination access blocks based on the parameter type"
+ getBlock := src isCollection ifTrue:
+ [src isString ifTrue:
+ "basicAt: answers integers"
+ [[ :idx | src basicAt: idx]]
+ ifFalse:
+ [src class == ByteArray ifTrue:
+ [[ :idx | src at: idx]]]]
+ ifFalse:
+ [src isInteger ifTrue:
+ [[ :idx | self byteAt: src + idx - 1]]
+ ifFalse:
+ [src isCArray ifTrue:
+ [[ :idx | src at: idx - 1]]]].
+ getBlock ifNil: [self error: 'unhandled type of source string'].
+ setBlock := dest isCollection ifTrue:
+ [dest isString ifTrue:
+ "basicAt:put: stores integers"
+ [[ :idx | dest basicAt: idx put: (getBlock value: idx)]]
+ ifFalse:
+ [dest class == ByteArray ifTrue:
+ [[ :idx | dest at: idx put: (getBlock value: idx)]]]]
+ ifFalse:
+ [dest isInteger ifTrue:
+ [[ :idx | self byteAt: dest + idx - 1 put: (getBlock value: idx)]]
- (dString isCollection or: [sString isCollection]) ifFalse:
- [| destAddress sourceAddress |
- destAddress := dString asInteger.
- sourceAddress := sString asInteger.
- self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
- or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])].
- dString isInteger
- ifTrue:
- [1 to: bytes do:
- [:i| | v |
- v := sString isString
- ifTrue: [sString basicAt: i]
- ifFalse: [self byteAt: sString + i - 1].
- self byteAt: dString + i - 1 put: v]]
  ifFalse:
+ [dest isCArray ifTrue:
+ [[ :idx | dest at: idx - 1 put: (getBlock value: idx)]]]].
+ setBlock ifNil: [self error: 'unhandled type of destination string'].
+ 1 to: bytes do: setBlock.
+
+ ^dest!
- [1 to: bytes do:
- [:i| | v |
- v := sString isString
- ifTrue: [sString basicAt: i]
- ifFalse: [self byteAt: sString + i - 1].
- dString basicAt: i put: v]].
- ^dString!

Item was changed:
  ----- Method: VMClass>>strlen: (in category 'C library simulation') -----
  strlen: aCString
  "Simulate strlen(3)"
  <doNotGenerate>
  | len |
+
+ aCString isCArray ifTrue:
+ ["CArrays may be 0 terminated or the correct length (in the simulator)"
- 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) = 0]) ifTrue: [^len].
+ len := len + 1] repeat]
+ ifFalse:
+ [aCString isString ifTrue:
+ [^aCString size]
+ ifFalse:
+ [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]]].
- [(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: dest _: src _: n
  <doNotGenerate>
  "implementation of strncpy(3).
  See e.g. https://manpages.debian.org/stretch/manpages-dev/strncpy.3.en.html
  The C version always takes an address; the simulation allows a String, ByteArray,
  CArray or address within the simulation object memory (Positive Integer)"
  | getBlock setBlock count |
  count := n.
  "Determine the source and destination access blocks based on the parameter type"
  getBlock := src isCollection
  ifTrue:
  [count := count min: src size.
  src isString
  ifTrue: [[ :idx | src basicAt: idx]] "basicAt: answers integers"
  ifFalse:
  [src class == ByteArray ifTrue:
  [[ :idx | src at: idx]]]]
  ifFalse:
  [src isInteger
  ifTrue: [[ :idx | self byteAt: src + idx - 1]]
  ifFalse:
+ [src isCArray ifTrue:
- [src class == CArray ifTrue:
  [[ :idx | src at: idx - 1]]]].
  getBlock ifNil: [self error: 'unhandled type of source string'].
  setBlock := dest isCollection
  ifTrue:
  [dest isString
  ifTrue: [[ :idx | dest basicAt: idx put: (getBlock value: idx)]] "basicAt:put: stores integers"
  ifFalse:
  [dest class == ByteArray ifTrue:
  [[ :idx | dest at: idx put: (getBlock value: idx)]]]]
  ifFalse:
  [dest isInteger ifTrue:
  [[ :idx | self byteAt: dest + idx - 1 put: (getBlock value: idx)]]].
  setBlock ifNil: [self error: 'unhandled type of destination string'].
  1 to: count do: setBlock.
  "SVr4, 4.3BSD, C89, C99 require the remainder of the buffer be filled with nulls"
  getBlock := [:idx| 0].
  count + 1 to: n do: setBlock.
  ^dest!