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

 
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2827.mcz

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

Name: VMMaker.oscog-eem.2827
Author: eem
Time: 27 September 2020, 2:49:51.898729 pm
UUID: 2c352285-e689-4bd4-ae0b-8527b2957a63
Ancestors: VMMaker.oscog-eem.2826

Plugins:
Fix InterpreterPlugin isAlien:, I find is:KindOf: misleading (arguably it should be called is:KindOfClassNamed:); the right mehtod is is:KindOfClass:

Add primAlienCopyInto, a slightly more4 convenient way of getting data out of aliens.

A few minor simplifications.  Use the canonical symbl for const char * in a few more places.

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

Item was changed:
  ----- Method: IA32ABIPlugin>>primAddressField (in category 'primitives-accessing') -----
  primAddressField
  "Answer the unsigned 32-bit (or 64-bit) integer comprising the address field (the second 32-bit or 64-bit field)."
  "<Alien> primAddressField ^<Integer>
  <primitive: 'primAddressField' error: errorCode module: 'IA32ABI'>"
+ | rcvr value |
- | rcvr value valueOop |
  <export: true>
  rcvr := interpreterProxy stackValue: 0.
  value := self longAt: rcvr + interpreterProxy baseHeaderSize + interpreterProxy bytesPerOop.
+ ^interpreterProxy methodReturnValue: (self positiveMachineIntegerFor: value)!
- valueOop := self positiveMachineIntegerFor: value.
- ^interpreterProxy methodReturnValue: valueOop!

Item was added:
+ ----- Method: IA32ABIPlugin>>primAlienCopyInto (in category 'primitives-accessing') -----
+ primAlienCopyInto
+ "Copy some number of bytes from the receiver starting at the first index into some destination
+ object starting at the second index.  The  destination may be an Aliens or a bit-indexable object.
+ The primitive will have the following signature:
+ <Alien>
+ primCopyFrom: start <Integer>
+ to: stop <Integer>
+ into: destination <Alien | indexableByteSubclass et al>
+ startingAt: destStart <Integer> ^<self>
+ <primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'>
+ "
+ <export: true>
+ | alien start stop dest destStart src totalLength destAddr myLength |
+ alien := interpreterProxy stackValue: 4.  "Unchecked!!"
+ start := interpreterProxy stackIntegerValue: 3.
+ stop := interpreterProxy stackIntegerValue: 2.
+ dest := interpreterProxy stackValue: 1.
+ destStart := interpreterProxy stackIntegerValue: 0.
+
+ (interpreterProxy failed
+ or: [(interpreterProxy isWordsOrBytes: dest) not]) ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+
+ myLength := self sizeField: alien.
+ src := (self startOfData: dest withSize: myLength) + start - 1.
+
+ (self isAlien: dest)
+ ifTrue:
+ [totalLength := self sizeField: dest.
+ destAddr := (self startOfData: dest withSize: totalLength) + start - 1.
+ totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens"
+ ifTrue: [totalLength := stop]
+ ifFalse: [totalLength := totalLength abs]]
+ ifFalse:
+ [totalLength := interpreterProxy byteSizeOf: dest.
+ destAddr := (self startOfByteData: dest) + start - 1].
+
+ ((start >= 1 and: [start - 1 <= stop and: [stop <= myLength]])
+ and: [stop - start + 1 <= totalLength]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+
+ (interpreterProxy isOopImmutable: dest) ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrNoModification].
+
+ "Use memmove to allow source and desition to overlap"
+ self memmove: destAddr asVoidPointer _: src asVoidPointer _: stop - start + 1.
+
+ interpreterProxy methodReturnReceiver!

Item was changed:
  ----- Method: IA32ABIPlugin>>primAlienReplace (in category 'primitives-accessing') -----
  primAlienReplace
  "Copy some number of bytes from some source object starting at the index
  into the receiver destination object from startIndex to stopIndex.  The  source
  and destination may be Aliens or byte-indexable objects.  The primitive wll have
  either of the following signatures:
  <Alien | indexableByteSubclass | indexableWordSubclass>
  primReplaceFrom: start <Integer>
  to: stop <Integer>
  with: replacement <Alien | indexableByteSubclass | indexableWordSubclass | Integer>
  startingAt: repStart <Integer> ^<self>
  <primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'>
  <Anywhere>
  primReplaceIn: dest <Alien | indexableByteSubclass | indexableWordSubclass>
  from: start <Integer>
  to: stop <Integer>
  with: replacement <Alien | indexableByteSubclass | indexableWordSubclass | Integer>
  startingAt: repStart <Integer> ^<self>
  <primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'>
  "
+ | array start stop repl replStart dest src totalLength |
- | array start stop repl replStart dest src totalLength count |
  <export: true>
  array := interpreterProxy stackValue: 4.
  start := interpreterProxy stackIntegerValue: 3.
  stop := interpreterProxy stackIntegerValue: 2.
  repl := interpreterProxy stackValue: 1.
  replStart := interpreterProxy stackIntegerValue: 0.
 
  (interpreterProxy failed
  or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
 
  (self isAlien: array)
  ifTrue:
  [totalLength := self sizeField: array.
  dest := (self startOfData: array withSize: totalLength) + start - 1.
  totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens"
  ifTrue: [totalLength := stop]
  ifFalse: [totalLength := totalLength abs]]
  ifFalse:
  [totalLength := interpreterProxy byteSizeOf: array.
  dest := (self startOfByteData: array) + start - 1].
  (start >= 1 and: [start - 1 <= stop and: [stop <= totalLength]]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
 
  (interpreterProxy isKindOfInteger: repl)
  ifTrue:
  [src := (interpreterProxy positiveMachineIntegerValueOf: repl) + replStart - 1.
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument]]
  ifFalse:
  [(self isAlien: repl)
  ifTrue:
  [totalLength := self sizeField: repl.
  src := (self startOfData: repl withSize: totalLength) + replStart - 1.
  totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens"
  ifTrue: [totalLength := stop - start + replStart]
  ifFalse: [totalLength := totalLength abs]]
  ifFalse:
  [(interpreterProxy isWordsOrBytes: repl) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  totalLength := interpreterProxy byteSizeOf: repl.
  src := (self startOfByteData: repl) + replStart - 1].
  (replStart >= 1 and: [stop - start + replStart <= totalLength]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex]].
 
  (interpreterProxy isOopImmutable: array) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrNoModification].
 
+ "Use memmove to allow source and desition to overlap"
+ self memmove: dest asVoidPointer _: src asVoidPointer _: stop - start + 1.
- count := stop - start + 1.
- self memmove: dest asVoidPointer _: src asVoidPointer _: count.
 
+ interpreterProxy methodReturnReceiver!
- interpreterProxy pop: interpreterProxy methodArgumentCount!

Item was changed:
  ----- Method: IA32ABIPlugin>>primBoxedFree (in category 'primitives-memory management') -----
  primBoxedFree
  "Free the memory referenced by the receiver, an Alien."
  "proxy <Alien> primFree ^<Alien>
  <primitive: 'primBoxedFree' error: errorCode module: 'IA32ABI'>"
  | addr rcvr ptr sizeField |
  <export: true>
  <var: #ptr type: #'sqIntptr_t *'>
  <var: #addr type: #'sqIntptr_t'>
  <var: #sizeField type: #'sqIntptr_t'>
 
  rcvr := interpreterProxy stackValue: 0.
  (interpreterProxy byteSizeOf: rcvr) >= (2 * interpreterProxy bytesPerOop) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  ptr := interpreterProxy firstIndexableField: rcvr.
  sizeField := ptr at: 0.
  addr := ptr at: 1.
  "Don't you dare to free Squeak's memory!!"
  (sizeField >= 0 or: [addr = 0 or: [interpreterProxy isInMemory: addr]]) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrInappropriate].
+ self free: addr asVoidPointer.
- self cCode: 'free((void *)addr)'
- inSmalltalk: [self Cfree: addr].
  ptr
  at: 0 put: 0;
  at: 1 put: 0 "cleanup"!

Item was changed:
  ----- Method: IA32ABIPlugin>>primCalloc (in category 'primitives-memory management') -----
  primCalloc
  "calloc (malloc + zero-fill) arg bytes."
  "primCalloc: byteSize <Integer> ^<Integer>
  <primitive: 'primCalloc' error: errorCode module: 'IA32ABI'>"
  | byteSize addr |
  <export: true>
 
  byteSize := interpreterProxy stackIntegerValue: 0.
  (interpreterProxy failed
  or: [byteSize <= 0 "some mallocs can't deal with malloc(0) bytes"]) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ addr := (self calloc: 1 _: byteSize) asUnsignedInteger.
- addr := self cCode: [(self c: 1 alloc: byteSize) asUnsignedInteger] inSmalltalk: [Alien Ccalloc: byteSize].
  addr = 0 ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrNoCMemory].
  interpreterProxy methodReturnValue: (self positiveMachineIntegerFor: addr)!

Item was changed:
  ----- Method: IA32ABIPlugin>>primDoubleAt (in category 'primitives-accessing') -----
  primDoubleAt
  "Answer the 64-bit double starting at the given byte offset (little endian)."
  "<Alien> doubleAt: index <Integer> ^<Float>
  <primitive: 'primDoubleAt' error: errorCode module: 'IA32ABI'>"
  | byteOffset rcvr startAddr addr floatValue |
  <export: true>
  <var: #floatValue type: #double>
 
  byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 0) - 1.
  rcvr := interpreterProxy stackObjectValue: 1.
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  (self index: byteOffset length: 8 inRange: rcvr) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  (startAddr := self startOfData: rcvr) = 0 ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  addr := startAddr + byteOffset.
+ self memcpy: (self addressOf: floatValue put: [:v| floatValue := v]) _: addr _: (self sizeof: floatValue).
+ interpreterProxy methodReturnFloat: floatValue!
- self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue).
- interpreterProxy pop: 2.
- ^interpreterProxy pushFloat: floatValue!

Item was changed:
  ----- Method: IA32ABIPlugin>>primFloatAt (in category 'primitives-accessing') -----
  primFloatAt
  "Answer the 32-bit float starting at the given byte offset (little endian)."
  "<Alien> floatAt: index <Integer> ^<Float>
  <primitive: 'primFloatAt' error: errorCode module: 'IA32ABI'>"
  | byteOffset rcvr startAddr addr floatValue |
  <export: true>
  <var: #floatValue type: #float>
 
  byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 0) - 1.
  rcvr := interpreterProxy stackObjectValue: 1.
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  (self index: byteOffset length: 4 inRange: rcvr) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  (startAddr := self startOfData: rcvr) = 0 ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  addr := startAddr + byteOffset.
+ self memcpy: (self addressOf: floatValue put: [:v| floatValue := v]) _: addr _: (self sizeof: floatValue).
+ interpreterProxy methodReturnFloat: floatValue!
- self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue).
- interpreterProxy pop: 2.
- ^interpreterProxy pushFloat: floatValue!

Item was changed:
  ----- Method: IA32ABIPlugin>>primFree (in category 'primitives-memory management') -----
  primFree
  "Free the memory referenced by the argument, an integer."
  "<Anywhere> primFree: address <Integer>
  <primitive: 'primFree' error: errorCode module: 'IA32ABI'>"
  | addr |
  <export: true>
  addr := interpreterProxy stackPositiveMachineIntegerValue: 0.
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  "Don't you dare to free Squeak's memory!!"
  (addr = 0 or: [interpreterProxy isInMemory: addr]) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrInappropriate].
+ self free: addr asVoidPointer.
- self cCode: 'free((void *)addr)'
- inSmalltalk: [self Cfree: addr].
  interpreterProxy pop: 1!

Item was changed:
  ----- Method: IA32ABIPlugin>>primMalloc (in category 'primitives-memory management') -----
  primMalloc
  "Malloc arg bytes."
  "primMalloc: byteSize <Integer> <^Integer>
  <primitive: 'primMalloc' error: errorCode module: 'IA32ABI'>"
  | byteSize addr |
  <export: true>
 
  byteSize := interpreterProxy stackIntegerValue: 0.
  (interpreterProxy failed
  or: [byteSize <= 0 "some mallocs can't deal with malloc(0) bytes"]) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ addr := (self malloc: byteSize) asUnsignedInteger.
- addr := self cCode: [(self malloc: byteSize) asUnsignedInteger] inSmalltalk: [Alien Cmalloc: byteSize].
  addr = 0 ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrNoCMemory].
  interpreterProxy methodReturnValue: (self positiveMachineIntegerFor: addr)!

Item was changed:
  ----- Method: IA32ABIPlugin>>primStrlenFromStartIndex (in category 'primitives-accessing') -----
  primStrlenFromStartIndex
  "Answer the number of non-null bytes starting at index.  If
  there isn't a null byte before the end of the object then the
  result will be the number of bytes from index to the end of
  the object, i.e. the result will be within the bounds of the object."
  "<Alien> primStrlenFrom: index <Integer> ^<Integer>
  <primitive: 'primStrlenFromStartIndex' error: errorCode module: 'IA32ABI'>"
  | byteOffset rcvr index limit ptr |
  <export: true>
  <var: #ptr type: #'char *'>
 
  byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 0) - 1.
  rcvr := interpreterProxy stackObjectValue: 1.
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  (self index: byteOffset length: 1 inRange: rcvr) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  limit := self sizeField: rcvr.
  ptr := self cCoerce: ((self startOfData: rcvr withSize: limit) + byteOffset) to: #'char *'.
  limit = 0
  ifTrue: [index := self strlen: ptr]
  ifFalse:
  [limit := limit abs.
  index := 0.
+ [index < limit and: [(ptr at: index) ~= 0]] whileTrue:
- [index < limit
-  and: [(self cCode: 'ptr[index]' inSmalltalk: [ptr byteAt: index]) ~= 0]] whileTrue:
  [index := index + 1]].
+ interpreterProxy methodReturnInteger: index!
- ^interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: index)!

Item was changed:
  ----- Method: IA32ABIPlugin>>primStrlenThroughPointerAtIndex (in category 'primitives-accessing') -----
  primStrlenThroughPointerAtIndex
  "Answer the number of non-null bytes starting at the byte addressed by
  the 4-byte pointer at index."
  "<Alien> strlenThroughPointerAt: index <Integer> ^<Integer>
  <primitive: 'primStrlenThroughPointerAtIndex' error: errorCode module: 'IA32ABI'>"
+ | byteOffset rcvr addr |
- | byteOffset rcvr ptr addr |
  <export: true>
  <var: #ptr type: #'char *'>
 
  byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 0) - 1.
  rcvr := interpreterProxy stackObjectValue: 1.
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  (self index: byteOffset length: interpreterProxy bytesPerOop inRange: rcvr) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  addr := (self startOfData: rcvr) + byteOffset.
+ ^interpreterProxy methodReturnInteger: (self strlen: (self cCoerce: (self longAt: addr) to: #'char *'))!
- ptr := self cCoerce: (self longAt: addr) to: #'char *'.
- ^interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: (self strlen: ptr))!

Item was changed:
  ----- Method: InterpreterPlugin>>getModuleName (in category 'initialize') -----
  getModuleName
  "Note: This is hardcoded so it can be run from Squeak.
+ The module name is used for validating a module *after*
+ it is loaded to check if it does really contain the module
+ we're thinking it contains. This is important!!  Note also
+ that if a plugin does not implement getModuleName then
+ loading is allowed but a warning may be printed. See
+ platforms/Cross/vm/sqNamedPrims.c"
+ <returnTypeC: #'const char *'>
- The module name is used for validating a module *after*
- it is loaded to check if it does really contain the module
- we're thinking it contains. This is important!!"
- <returnTypeC:'const char*'>
  <export: true>
  ^self cCode: [moduleName]
  inSmalltalk:
  [| string index |
  string := ((self class codeGeneratorClass new pluginClass: self class) variableDeclarationStringsForVariable: 'moduleName') first.
  index := (string indexOfSubCollection: 'moduleName = "') + 14.
  (string copyFrom: index to: (string indexOf: $" startingAt: index + 1) - 1), '(i)']!

Item was changed:
  ----- Method: InterpreterPlugin>>isAlien: (in category 'alien support') -----
  isAlien: oop
  "Answer if oop is an Alien.  We could ask if isWordsOrBytes: first, but that doesn't help.  We still have to do the is:KindOf: walk.
  We're not interested in fast falsehood, but as fast as possible truth, and with the current API this is it."
  <inline: true>
+ ^interpreterProxy is: oop KindOfClass: interpreterProxy classAlien!
- ^interpreterProxy is: oop KindOf: interpreterProxy classAlien!

Item was changed:
  ----- Method: ObjectMemory>>stringForCString: (in category 'primitive support') -----
  stringForCString: aCString
  "Answer a new String copied from a null-terminated C string,
  or nil if out of memory.
  Caution: This may invoke the garbage collector."
  <api>
+ <var: 'aCString' type: #'const char *'>
- <var: 'aCString' type: 'const char *'>
  <inline: false>
  | len newString |
  len := self strlen: aCString.
  newString := self instantiateClass: (self splObj: ClassByteString) indexableSize: len.
  newString ifNotNil:
  [self strncpy: (self cCoerceSimple: newString + self baseHeaderSize to: #'char *')
  _: aCString
  _: len]. "(char *)strncpy()"
  ^newString!

Item was changed:
  ----- Method: SpurMemoryManager>>stringForCString: (in category 'primitive support') -----
  stringForCString: aCString
  "Answer a new String copied from a null-terminated C string,
  or nil if out of memory."
  <api>
+ <var: 'aCString' type: #'const char *'>
- <var: 'aCString' type: 'const char *'>
  <inline: false>
  | len newString |
  len := self strlen: aCString.
  newString := self
  allocateSlots: (self numSlotsForBytes: len)
  format: (self byteFormatForNumBytes: len)
  classIndex: ClassByteStringCompactIndex.
  newString ifNotNil:
  [self strncpy: (self cCoerceSimple: newString + self baseHeaderSize to: #'char *')
  _: aCString
  _: len]. "(char *)strncpy()"
  ^newString!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>getModuleName (in category 'initialize') -----
  getModuleName
  "Note: This is hardcoded so it can be run from Squeak.
  The module name is used for validating a module *after*
  it is loaded to check if it does really contain the module
  we're thinking it contains. This is important!!"
+ <returnTypeC: #'const char *'>
- <returnTypeC: 'const char *'>
  <export: true>
  ^'SqueakFFIPrims', PluginVersionInfo!