VM Maker: VMMaker.oscog-eem.2458.mcz

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

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

Name: VMMaker.oscog-eem.2458
Author: eem
Time: 15 October 2018, 5:46:57.236688 pm
UUID: 48c3dc2d-47b2-4834-aeca-83e4c8cebf3e
Ancestors: VMMaker.oscog-eem.2457

InterpreterPrimitives
Rewrite the getenv: simulation so that the original primitiveGetenv can be used.

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

Item was added:
+ ----- Method: BitBltSimulation>>lockSurfaceFn: (in category 'surface support') -----
+ lockSurfaceFn: sourceHandle _: pitchPtr _: x _: y _: w _: h
+ "Simulate the lockSurfaceFn function call as a failure to load the surface."
+ <doNotGenerate>
+ ^0!

Item was removed:
- ----- Method: BitBltSimulation>>lockSurfaceFn:_:_:_:_:_: (in category 'surface support') -----
- lockSurfaceFn: sourceHandle _: pitchPtr _: x _: y _: w _: h
- "Simulate the lockSurfaceFn function call as a failure to load the surface."
- <doNotGenerate>
- ^0!

Item was added:
+ ----- Method: BitBltSimulation>>querySurfaceFn: (in category 'surface support') -----
+ querySurfaceFn: handle _: widthPtr _: heightPtr _: depthPtr _: endianPtr
+ "Query the dimension of an OS surface.
+ This method is provided so that in case the inst vars of the
+ source form are broken, *actual* values of the OS surface
+ can be obtained. This might, for instance, happen if the user
+ resizes the main window.
+ This is a simulation of the querySurfaceFn function call; simulate as a failure."
+ <doNotGenerate>
+ ^false!

Item was removed:
- ----- Method: BitBltSimulation>>querySurfaceFn:_:_:_:_: (in category 'surface support') -----
- querySurfaceFn: handle _: widthPtr _: heightPtr _: depthPtr _: endianPtr
- "Query the dimension of an OS surface.
- This method is provided so that in case the inst vars of the
- source form are broken, *actual* values of the OS surface
- can be obtained. This might, for instance, happen if the user
- resizes the main window.
- This is a simulation of the querySurfaceFn function call; simulate as a failure."
- <doNotGenerate>
- ^false!

Item was added:
+ ----- Method: FilePluginSimulator>>dir_Create: (in category 'simulation') -----
+ dir_Create: dirNameIndex _: dirNameSize
+ ^[FileDirectory default
+ primCreateDirectory: (interpreterProxy interpreter
+ asString: dirNameIndex
+ size: dirNameSize).
+   true]
+ on: Error
+ do: [:ex| false]!

Item was removed:
- ----- Method: FilePluginSimulator>>dir_Create:_: (in category 'simulation') -----
- dir_Create: dirNameIndex _: dirNameSize
- ^[FileDirectory default
- primCreateDirectory: (interpreterProxy interpreter
- asString: dirNameIndex
- size: dirNameSize).
-   true]
- on: Error
- do: [:ex| false]!

Item was added:
+ ----- Method: FilePluginSimulator>>dir_EntryLookup: (in category 'simulation') -----
+ dir_EntryLookup: pathString _: pathStringLength _: entryNameString _: entryNameStringLength _: name _: nameLength _: creationDate _: modificationDate _: isDirectory _: sizeIfFile _: posixPermissions _: isSymlink
+ "sqInt dir_EntryLookup(char *pathString, sqInt pathStringLength, char *nameString, sqInt nameStringLength,
+ /* outputs: */ char *name, sqInt *nameLength, sqInt *creationDate, sqInt *modificationDate,
+        sqInt *isDirectory, squeakFileOffsetType *sizeIfFile, sqInt *posixPermissions, sqInt *isSymlink)"
+ | result pathName entryName |
+ pathName := ((0 to: pathStringLength - 1) collect: [:i| (pathString at: i) asCharacter]) as: ByteString.
+ entryName := ((0 to: entryNameStringLength - 1) collect: [:i| (entryNameString at: i) asCharacter]) as: ByteString.
+ result := self primLookupEntryIn: pathName name: entryName.
+ result ifNil: [^DirNoMoreEntries].
+ result isInteger ifTrue:
+ [result > 1 ifTrue:
+ [interpreterProxy primitiveFailFor: result].
+ ^DirBadPath].
+ name replaceFrom: 1 to: result first size with: result first startingAt: 1.
+ nameLength at: 0 put: result first size.
+ creationDate at: 0 put: (result at: 2).
+ modificationDate at: 0 put: (result at: 3).
+ isDirectory at: 0 put: (result at: 4).
+ sizeIfFile at: 0 put: (result at: 5).
+ posixPermissions at: 0 put: (result at: 6 ifAbsent: [(result at: 4) ifTrue: [8r755] ifFalse: [8r644]]).
+ isSymlink at: 0 put: (result at: 7 ifAbsent: [false]).
+ ^DirEntryFound!

Item was removed:
- ----- Method: FilePluginSimulator>>dir_EntryLookup:_:_:_:_:_:_:_:_:_:_:_: (in category 'simulation') -----
- dir_EntryLookup: pathString _: pathStringLength _: entryNameString _: entryNameStringLength _: name _: nameLength _: creationDate _: modificationDate _: isDirectory _: sizeIfFile _: posixPermissions _: isSymlink
- "sqInt dir_EntryLookup(char *pathString, sqInt pathStringLength, char *nameString, sqInt nameStringLength,
- /* outputs: */ char *name, sqInt *nameLength, sqInt *creationDate, sqInt *modificationDate,
-        sqInt *isDirectory, squeakFileOffsetType *sizeIfFile, sqInt *posixPermissions, sqInt *isSymlink)"
- | result pathName entryName |
- pathName := ((0 to: pathStringLength - 1) collect: [:i| (pathString at: i) asCharacter]) as: ByteString.
- entryName := ((0 to: entryNameStringLength - 1) collect: [:i| (entryNameString at: i) asCharacter]) as: ByteString.
- result := self primLookupEntryIn: pathName name: entryName.
- result ifNil: [^DirNoMoreEntries].
- result isInteger ifTrue:
- [result > 1 ifTrue:
- [interpreterProxy primitiveFailFor: result].
- ^DirBadPath].
- name replaceFrom: 1 to: result first size with: result first startingAt: 1.
- nameLength at: 0 put: result first size.
- creationDate at: 0 put: (result at: 2).
- modificationDate at: 0 put: (result at: 3).
- isDirectory at: 0 put: (result at: 4).
- sizeIfFile at: 0 put: (result at: 5).
- posixPermissions at: 0 put: (result at: 6 ifAbsent: [(result at: 4) ifTrue: [8r755] ifFalse: [8r644]]).
- isSymlink at: 0 put: (result at: 7 ifAbsent: [false]).
- ^DirEntryFound!

Item was added:
+ ----- Method: FilePluginSimulator>>dir_Lookup: (in category 'simulation') -----
+ dir_Lookup: pathString _: pathStringLength _: index _: name _: nameLength _: creationDate _: modificationDate _: isDirectory _: sizeIfFile _: posixPermissions _: isSymlink
+ "sqInt dir_Lookup( char *pathString, sqInt pathStringLength, sqInt index,
+ /* outputs: */ char *name, sqInt *nameLength, sqInt *creationDate, sqInt *modificationDate,
+   sqInt *isDirectory, squeakFileOffsetType *sizeIfFile, sqInt * posixPermissions, sqInt *isSymlink)"
+ | result pathName |
+ pathName := ((0 to: pathStringLength - 1) collect: [:i| (pathString at: i) asCharacter]) as: ByteString.
+ result := self primLookupEntryIn: pathName index: index.
+ result ifNil: [^DirNoMoreEntries].
+ result isInteger ifTrue:
+ [result > 1 ifTrue:
+ [interpreterProxy primitiveFailFor: result].
+ ^DirBadPath].
+ name replaceFrom: 1 to: result first size with: result first startingAt: 1.
+ nameLength at: 0 put: result first size.
+ creationDate at: 0 put: (result at: 2).
+ modificationDate at: 0 put: (result at: 3).
+ isDirectory at: 0 put: (result at: 4).
+ sizeIfFile at: 0 put: (result at: 5).
+ posixPermissions at: 0 put: (result at: 6 ifAbsent: [(result at: 4) ifTrue: [8r755] ifFalse: [8r644]]).
+ isSymlink at: 0 put: (result at: 7 ifAbsent: [false]).
+ ^DirEntryFound!

Item was removed:
- ----- Method: FilePluginSimulator>>dir_Lookup:_:_:_:_:_:_:_:_:_:_: (in category 'simulation') -----
- dir_Lookup: pathString _: pathStringLength _: index _: name _: nameLength _: creationDate _: modificationDate _: isDirectory _: sizeIfFile _: posixPermissions _: isSymlink
- "sqInt dir_Lookup( char *pathString, sqInt pathStringLength, sqInt index,
- /* outputs: */ char *name, sqInt *nameLength, sqInt *creationDate, sqInt *modificationDate,
-   sqInt *isDirectory, squeakFileOffsetType *sizeIfFile, sqInt * posixPermissions, sqInt *isSymlink)"
- | result pathName |
- pathName := ((0 to: pathStringLength - 1) collect: [:i| (pathString at: i) asCharacter]) as: ByteString.
- result := self primLookupEntryIn: pathName index: index.
- result ifNil: [^DirNoMoreEntries].
- result isInteger ifTrue:
- [result > 1 ifTrue:
- [interpreterProxy primitiveFailFor: result].
- ^DirBadPath].
- name replaceFrom: 1 to: result first size with: result first startingAt: 1.
- nameLength at: 0 put: result first size.
- creationDate at: 0 put: (result at: 2).
- modificationDate at: 0 put: (result at: 3).
- isDirectory at: 0 put: (result at: 4).
- sizeIfFile at: 0 put: (result at: 5).
- posixPermissions at: 0 put: (result at: 6 ifAbsent: [(result at: 4) ifTrue: [8r755] ifFalse: [8r644]]).
- isSymlink at: 0 put: (result at: 7 ifAbsent: [false]).
- ^DirEntryFound!

Item was added:
+ ----- Method: InterpreterPlugin>>strncpy: (in category 'simulation support') -----
+ strncpy: aString _: bString _: n
+ <doNotGenerate>
+ ^interpreterProxy strncpy: aString _: bString _: n!

Item was removed:
- ----- Method: InterpreterPlugin>>strncpy:_:_: (in category 'simulation support') -----
- strncpy: aString _: bString _: n
- <doNotGenerate>
- ^interpreterProxy strncpy: aString _: bString _: n!

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."
+ ^(self primitiveGetenv: aByteStringOrByteArray) ifNil: [0]!
- <primitive: 'primitiveGetenv' module: '' error: ec>
- ec == #'bad argument' ifTrue:
- [aByteStringOrByteArray isString ifFalse:
- [^self getenv: aByteStringOrByteArray asString]].
- self primitiveFail!

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]).
- var := (self getenv: (self cCode: [key] inSmalltalk: [key allButLast])) ifNil: [0].
  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 added:
+ ----- Method: InterpreterPrimitives>>primitiveGetenv: (in category 'simulation support') -----
+ primitiveGetenv: aByteStringOrByteArray
+ <doNotGenerate>
+ <primitive: 'primitiveGetenv' module: '' error: ec>
+ ec == #'bad argument' ifTrue:
+ [aByteStringOrByteArray isString ifFalse:
+ [^self getenv: aByteStringOrByteArray asString]].
+ self primitiveFail!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>memmove: (in category 'simulation only') -----
+ memmove: destAddress _: sourceAddress _: bytes
+ <doNotGenerate>
+ | dst src  |
+ dst := destAddress asInteger.
+ src := sourceAddress asInteger.
+ "Emulate the c library memmove function"
+ self assert: bytes \\ 4 = 0.
+ destAddress > sourceAddress
+ ifTrue:
+ [bytes - 4 to: 0 by: -4 do:
+ [:i| self long32At: dst + i put: (self long32At: src + i)]]
+ ifFalse:
+ [0 to: bytes - 4 by: 4 do:
+ [:i| self long32At: dst + i put: (self long32At: src + i)]]!

Item was removed:
- ----- Method: Spur64BitMemoryManager>>memmove:_:_: (in category 'simulation only') -----
- memmove: destAddress _: sourceAddress _: bytes
- <doNotGenerate>
- | dst src  |
- dst := destAddress asInteger.
- src := sourceAddress asInteger.
- "Emulate the c library memmove function"
- self assert: bytes \\ 4 = 0.
- destAddress > sourceAddress
- ifTrue:
- [bytes - 4 to: 0 by: -4 do:
- [:i| self long32At: dst + i put: (self long32At: src + i)]]
- ifFalse:
- [0 to: bytes - 4 by: 4 do:
- [:i| self long32At: dst + i put: (self long32At: src + i)]]!

Item was added:
+ ----- 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 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>>memcpy: (in category 'C library simulation') -----
+ memcpy: dString _: sString _: bytes
+ <doNotGenerate>
+ "implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
+ (dString isString or: [sString isString]) ifFalse:
+ [| destAddress sourceAddress |
+ dString class == ByteArray ifTrue:
+ [ByteString adoptInstance: dString.
+ ^[self memcpy: dString _: sString _: bytes] ensure:
+ [ByteArray adoptInstance: dString]].
+ destAddress := dString asInteger.
+ sourceAddress := sString asInteger.
+ self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
+ or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])].
+ dString isString
+ ifTrue:
+ [1 to: bytes do:
+ [:i| | v |
+ v := sString isString
+ ifTrue: [sString at: i]
+ ifFalse: [Character value: (self byteAt: sString + i - 1)].
+ dString at: i put: v]]
+ ifFalse:
+ [1 to: bytes do:
+ [:i| | v |
+ v := sString isString
+ ifTrue: [(sString at: i) asInteger]
+ ifFalse: [self byteAt: sString + i - 1].
+ self byteAt: dString + i - 1 put: v]].
+ ^dString!

Item was removed:
- ----- Method: VMClass>>memcpy:_:_: (in category 'C library simulation') -----
- memcpy: dString _: sString _: bytes
- <doNotGenerate>
- "implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
- (dString isString or: [sString isString]) ifFalse:
- [| destAddress sourceAddress |
- dString class == ByteArray ifTrue:
- [ByteString adoptInstance: dString.
- ^[self memcpy: dString _: sString _: bytes] ensure:
- [ByteArray adoptInstance: dString]].
- destAddress := dString asInteger.
- sourceAddress := sString asInteger.
- self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
- or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])].
- dString isString
- ifTrue:
- [1 to: bytes do:
- [:i| | v |
- v := sString isString
- ifTrue: [sString at: i]
- ifFalse: [Character value: (self byteAt: sString + i - 1)].
- dString at: i put: v]]
- ifFalse:
- [1 to: bytes do:
- [:i| | v |
- v := sString isString
- ifTrue: [(sString at: i) asInteger]
- ifFalse: [self byteAt: sString + i - 1].
- self byteAt: dString + i - 1 put: v]].
- ^dString!

Item was added:
+ ----- Method: VMClass>>memmove: (in category 'C library simulation') -----
+ memmove: destAddress _: sourceAddress _: bytes
+ <doNotGenerate>
+ | dst src  |
+ dst := destAddress asInteger.
+ src := sourceAddress asInteger.
+ "Emulate the c library memmove function"
+ self assert: bytes \\ 4 = 0.
+ destAddress > sourceAddress
+ ifTrue:
+ [bytes - 4 to: 0 by: -4 do:
+ [:i| self longAt: dst + i put: (self longAt: src + i)]]
+ ifFalse:
+ [0 to: bytes - 4 by: 4 do:
+ [:i| self longAt: dst + i put: (self longAt: src + i)]]!

Item was removed:
- ----- Method: VMClass>>memmove:_:_: (in category 'C library simulation') -----
- memmove: destAddress _: sourceAddress _: bytes
- <doNotGenerate>
- | dst src  |
- dst := destAddress asInteger.
- src := sourceAddress asInteger.
- "Emulate the c library memmove function"
- self assert: bytes \\ 4 = 0.
- destAddress > sourceAddress
- ifTrue:
- [bytes - 4 to: 0 by: -4 do:
- [:i| self longAt: dst + i put: (self longAt: src + i)]]
- ifFalse:
- [0 to: bytes - 4 by: 4 do:
- [:i| self longAt: dst + i put: (self longAt: src + i)]]!

Item was added:
+ ----- Method: VMClass>>strcat: (in category 'C library simulation') -----
+ strcat: aString _: bString
+ <doNotGenerate>
+ "implementation of strcat(3)"
+ ^(self asString: aString), (self asString: bString)!

Item was removed:
- ----- Method: VMClass>>strcat:_: (in category 'C library simulation') -----
- strcat: aString _: bString
- <doNotGenerate>
- "implementation of strcat(3)"
- ^(self asString: aString), (self asString: bString)!

Item was added:
+ ----- Method: VMClass>>strncmp: (in category 'C library simulation') -----
+ strncmp: aString _: bString _: n
+ <doNotGenerate>
+ "implementation of strncmp(3)"
+ bString isString ifTrue:
+ [1 to: n do:
+ [:i|
+ (aString at: i) asCharacter ~= (bString at: i) ifTrue:
+ [^i]].
+ ^0].
+ 1 to: n do:
+ [:i| | v |
+ v := (aString at: i) asInteger - (self byteAt: bString + i - 1).
+ v ~= 0 ifTrue: [^v]].
+ ^0!

Item was removed:
- ----- Method: VMClass>>strncmp:_:_: (in category 'C library simulation') -----
- strncmp: aString _: bString _: n
- <doNotGenerate>
- "implementation of strncmp(3)"
- bString isString ifTrue:
- [1 to: n do:
- [:i|
- (aString at: i) asCharacter ~= (bString at: i) ifTrue:
- [^i]].
- ^0].
- 1 to: n do:
- [:i| | v |
- v := (aString at: i) asInteger - (self byteAt: bString + i - 1).
- v ~= 0 ifTrue: [^v]].
- ^0!

Item was added:
+ ----- 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!

Item was removed:
- ----- 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!