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

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

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

Name: VMMaker.oscog-eem.2805
Author: eem
Time: 12 September 2020, 1:39:18.721879 pm
UUID: 48a26aae-6514-45a0-a30b-47c80fb69888
Ancestors: VMMaker.oscog-eem.2804

Plugins: Add isWordsOrShorts: for faster sound primitive marshalling. Squeak currently uses a hacked 32-bit WordArray to hold 16-bit signed sound samples.  But Spur supports native 16-bit arrays.  Soi using isWordasOrShorts: keeps backwards compatibility while allowing us to migrate to 16-bit native sound buffers when we choose.  Use WordsOrShorts in the relevant SoundPlugin & SoundCodecPlugin primitives.

Slang: include InterpreterProxy's typed methods in VMPluginCodeGenerator's kernelReturnTypes for improved type inferrence.  Fix a slip in inferTypesForImplicitlyTypedVariablesIn:.  We should only avoid typing variables assigned a null type if that null type came from a send (and we must do so because types are assigned to methods until we reach a fixed point).

Fix a typo.

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

Item was changed:
  ----- Method: InterpreterProxy>>isLong64s: (in category 'testing') -----
  isLong64s: oop
  <option: #(atLeastVMProxyMajor:minor: 1 17)>
+ ^oop class isLongs!
- ^oop class isPointers not and:[oop class isLongs]!

Item was changed:
  ----- Method: InterpreterProxy>>isShorts: (in category 'testing') -----
  isShorts: oop
  <option: #(atLeastVMProxyMajor:minor: 1 17)>
+ ^oop class isShorts!
- ^oop class isPointers not and:[oop class isShorts]!

Item was changed:
  ----- Method: InterpreterProxy>>isWords: (in category 'testing') -----
  isWords: oop
+ ^oop class isWords!
- ^oop class isPointers not and:[oop class isBytes not]!

Item was added:
+ ----- Method: InterpreterProxy>>isWordsOrShorts: (in category 'testing') -----
+ isWordsOrShorts: oop
+ <option: #(atLeastVMProxyMajor:minor: 1 17)>
+ ^oop class isWords or: [oop class isShorts]!

Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>ccgValBlock:or: (in category 'coercing') -----
+ ccgValBlock: valString or: valorString
+
+ ^[:index | String streamContents:
+ [:aStream | aStream
+ nextPutAll: 'interpreterProxy success: ((interpreterProxy ';
+ nextPutAll: valString;
+ nextPutAll: ': (interpreterProxy stackValue: ';
+ nextPutAll: index asString;
+ nextPutAll: ')) || (interpreterProxy ';
+ nextPutAll: valorString;
+ nextPutAll: ': (interpreterProxy stackValue: ';
+ nextPutAll: index asString;
+ nextPutAll: ')))']] !

Item was changed:
  ----- Method: SoundCodecPlugin>>primitiveGSMDecode (in category 'gsm 6.10 codec') -----
  primitiveGSMDecode
 
  | dstIndex dst srcIndex src frameCount state srcSize dstSize result srcDelta dstDelta |
  <export: true>
  dstIndex := interpreterProxy stackIntegerValue: 0.
  dst := interpreterProxy stackValue: 1.
  srcIndex := interpreterProxy stackIntegerValue: 2.
  src := interpreterProxy stackValue: 3.
  frameCount := interpreterProxy stackIntegerValue: 4.
  state := interpreterProxy stackValue: 5.
+ interpreterProxy success: ((interpreterProxy isWordsOrShorts: dst)
+ and: [(interpreterProxy isBytes: src)
+ and: [interpreterProxy isBytes: state]]).
- interpreterProxy success: (interpreterProxy isWords: dst).
- interpreterProxy success: (interpreterProxy isBytes: src).
- interpreterProxy success: (interpreterProxy isBytes: state).
  interpreterProxy failed ifTrue:[^ nil].
+ srcSize := interpreterProxy byteSizeOf: src.
+ dstSize := (interpreterProxy byteSizeOf: dst) / 2.
+ self gsmDecode: state + BaseHeaderSize _: frameCount _: src _: srcIndex _: srcSize _: dst _: dstIndex _: dstSize _: (self addressOf: srcDelta) _: (self addressOf: dstDelta).
- srcSize := interpreterProxy slotSizeOf: src.
- dstSize := (interpreterProxy slotSizeOf: dst) * 2.
- self cCode: 'gsmDecode(state + BaseHeaderSize, frameCount, src, srcIndex, srcSize, dst, dstIndex, dstSize, &srcDelta, &dstDelta)'.
  interpreterProxy failed ifTrue:[^ nil].
  result := interpreterProxy makePointwithxValue: srcDelta yValue: dstDelta.
  interpreterProxy failed ifTrue:[^ nil].
+ interpreterProxy methodReturnValue: result!
- interpreterProxy pop: 6 thenPush: result!

Item was changed:
  ----- Method: SoundCodecPlugin>>primitiveGSMEncode (in category 'gsm 6.10 codec') -----
  primitiveGSMEncode
 
  | dstIndex dst srcIndex src frameCount state srcSize dstSize result srcDelta dstDelta |
  <export: true>
  dstIndex := interpreterProxy stackIntegerValue: 0.
  dst := interpreterProxy stackValue: 1.
  srcIndex := interpreterProxy stackIntegerValue: 2.
  src := interpreterProxy stackValue: 3.
  frameCount := interpreterProxy stackIntegerValue: 4.
  state := interpreterProxy stackValue: 5.
+ interpreterProxy success: ((interpreterProxy isBytes: dst)
+ and: [(interpreterProxy isWordsOrShorts: src)
+ and: [interpreterProxy isBytes: state]]).
- interpreterProxy success: (interpreterProxy isBytes: dst).
- interpreterProxy success: (interpreterProxy isWords: src).
- interpreterProxy success: (interpreterProxy isBytes: state).
  interpreterProxy failed ifTrue:[^ nil].
+ srcSize := (interpreterProxy byteSizeOf: src) / 2.
+ dstSize := interpreterProxy byteSizeOf: dst.
+ self gsmEncode: state + BaseHeaderSize _: frameCount _: src _: srcIndex _: srcSize _: dst _: dstIndex _: dstSize _: (self addressOf: srcDelta) _: (self addressOf: dstDelta).
- srcSize := (interpreterProxy slotSizeOf: src) * 2.
- dstSize := interpreterProxy slotSizeOf: dst.
- self cCode: 'gsmEncode(state + BaseHeaderSize, frameCount, src, srcIndex, srcSize, dst, dstIndex, dstSize, &srcDelta, &dstDelta)'.
  interpreterProxy failed ifTrue:[^ nil].
  result := interpreterProxy makePointwithxValue: srcDelta yValue: dstDelta.
  interpreterProxy failed ifTrue:[^ nil].
+ interpreterProxy methodReturnValue: result!
- interpreterProxy pop: 6 thenPush: result!

Item was changed:
  ----- Method: SoundCodecPlugin>>primitiveGSMNewState (in category 'gsm 6.10 codec') -----
  primitiveGSMNewState
 
- | state |
  <export: true>
+ (interpreterProxy
- state := interpreterProxy
  instantiateClass: interpreterProxy classByteArray
+ indexableSize: self gsmStateBytes)
+ ifNil: [self primitiveFailFor: PrimErrNoMemory]
+ ifNotNil:
+ [:state|
+ self gsmInitState: state + BaseHeaderSize.
+ interpreterProxy methodReturnValue: state]!
- indexableSize: self gsmStateBytes.
- self gsmInitState: state + interpreterProxy baseHeaderSize.
- interpreterProxy pop: 1 thenPush: state!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundInsertSamples:from:leadTime: (in category 'primitives') -----
  primitiveSoundInsertSamples: frameCount from: buf leadTime: leadTime
  "Insert a buffer's worth of sound samples into the currently playing  
  buffer. Used to make a sound start playing as quickly as possible. The  
  new sound is mixed with the previously buffered sampled."
  "Details: Unlike primitiveSoundPlaySamples, this primitive always starts  
  with the first sample the given sample buffer. Its third argument  
  specifies the number of samples past the estimated sound output buffer  
  position the inserted sound should start. If successful, it returns the  
  number of samples inserted."
  | framesPlayed |
  self primitive: 'primitiveSoundInsertSamples'
+ parameters: #(SmallInteger WordsOrShorts SmallInteger).
- parameters: #(SmallInteger WordArray SmallInteger).
  (self cCoerce: frameCount to: #usqInt) > (interpreterProxy slotSizeOf: buf cPtrAsOop) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
 
  framesPlayed := self snd_InsertSamplesFromLeadTime: frameCount _: buf _: leadTime.
  framesPlayed >= 0
  ifTrue: [interpreterProxy methodReturnInteger: framesPlayed]
  ifFalse: [interpreterProxy primitiveFail]!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundPlaySamples:from:startingAt: (in category 'primitives') -----
  primitiveSoundPlaySamples: frameCount from: buf startingAt: startIndex
+ "Output a buffer's worth of stereo sound samples."
- "Output a buffer's worth of sound samples."
  | framesPlayed |
  self primitive: 'primitiveSoundPlaySamples'
+ parameters: #(SmallInteger WordsOrShorts SmallInteger).
- parameters: #(SmallInteger WordArray SmallInteger).
  (startIndex >= 1 and: [startIndex + frameCount - 1 <= (interpreterProxy slotSizeOf: buf cPtrAsOop)]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
 
  framesPlayed := self snd_PlaySamplesFromAtLength: frameCount _: buf _: startIndex - 1.
  framesPlayed >= 0
  ifTrue: [interpreterProxy methodReturnInteger: framesPlayed]
  ifFalse: [interpreterProxy primitiveFail]!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundRecordSamplesInto:startingAt: (in category 'primitives') -----
  primitiveSoundRecordSamplesInto: buf startingAt: startWordIndex
  "Record a buffer's worth of 16-bit sound samples."
  | bufSizeInBytes samplesRecorded bufPtr byteOffset |
  <var: #bufPtr type: #'char*'>
  self primitive: 'primitiveSoundRecordSamples'
+ parameters: #(WordsOrShorts SmallInteger).
- parameters: #(WordArray SmallInteger).
 
  bufSizeInBytes := (interpreterProxy slotSizeOf: buf cPtrAsOop) * 4.
  byteOffset := (startWordIndex - 1) * 2.
 
  (startWordIndex >= 1 and: [byteOffset < bufSizeInBytes]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
 
  bufPtr := (self cCoerce: buf to: #'char *') + byteOffset.
  samplesRecorded := self snd_RecordSamplesIntoAtLength: bufPtr _: 0 _: bufSizeInBytes - byteOffset.
  interpreterProxy failed ifFalse:
  [^samplesRecorded asPositiveIntegerObj]!

Item was added:
+ ----- Method: SpurMemoryManager>>isWordsOrShorts: (in category 'object testing') -----
+ isWordsOrShorts: oop
+ "Answer if the argument contains only indexable 16-bit half words or 32-bit indexable words (no oops).
+ See comment in formatOf:"
+
+ <api>
+ ^(self isNonImmediate: oop)
+  and: [self isWordsOrShortsNonImm: oop]!

Item was added:
+ ----- Method: SpurMemoryManager>>isWordsOrShortsNonImm: (in category 'object testing') -----
+ isWordsOrShortsNonImm: objOop
+ "Answer if the argument contains only indexable 16-bit half words or 32-bit words (no oops).
+ See comment in formatOf:"
+
+ ^(self formatOf: objOop) between: self firstLongFormat and: self firstByteFormat - 1!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>isAppropriateForCopyObject: (in category 'object access primitives') -----
  isAppropriateForCopyObject: oop
  (objectMemory isPointersNonImm: oop) ifFalse:
  [^false].
  (objectMemory isContext: oop) ifTrue:
  [^(self isStillMarriedContext: oop) not].
+ "Note there is no version in CoInterpreterPrimitives such as
- "Note there is no version in CoInterpreterPrimtiives such as
  (objectMemory isCompiledMethod: oop) ifTrue:
  [^(self methodHasCogMethod: oop) not].
  because isPointersNonImm: excludes compiled methods and the
  copy loop in primitiveCopyObject cannot handle compiled methods."
  ^true!

Item was changed:
  ----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesIn: aCodeGen
  "infer types for untyped variables from assignments and arithmetic uses.
  For debugging answer a Dictionary from var to the nodes that determined types
  This for debugging:
  (self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
  | alreadyExplicitlyTypedOrNotToBeTyped asYetUntyped mustBeSigned newDeclarations effectiveNodes |
  aCodeGen maybeBreakForTestToInline: selector in: self.
  alreadyExplicitlyTypedOrNotToBeTyped := declarations keys asSet.
  asYetUntyped := locals copyWithoutAll: alreadyExplicitlyTypedOrNotToBeTyped.
  mustBeSigned := Set new.
  newDeclarations := Dictionary new.
  effectiveNodes := Dictionary new. "this for debugging"
  parseTree nodesDo:
  [:node| | type var |
  "If there is something of the form i >= 0, then i should be signed, not unsigned."
  (node isSend
  and: [(locals includes: (var := node receiver variableNameOrNil))
  and: [(#(<= < >= >) includes: node selector)
  and: [node args first isConstant
  and: [node args first value = 0]]]]) ifTrue:
  [mustBeSigned add: var.
  effectiveNodes at: var put: { #signed. node }, (effectiveNodes at: var ifAbsent: [#()])].
  "if an assignment to an untyped local of a known type, set the local's type to that type.
  Only observe known sends (methods in the current set) and typed local variables."
  (node isAssignment
  and: [(locals includes: (var := node variable name))
  and: [(alreadyExplicitlyTypedOrNotToBeTyped includes: var) not]]) ifTrue: "don't be fooled by previously inferred types"
  [type := node expression isSend
  ifTrue: [aCodeGen returnTypeForSend: node expression in: self ifNil: nil]
  ifFalse: [self typeFor: (node expression isAssignment
  ifTrue: [node expression variable]
  ifFalse: [node expression]) in: aCodeGen].
  type "If untyped, then cannot type the variable yet. A subsequent assignment may assign a subtype of what this type ends up being"
  ifNil: "Further, if the type derives from an as-yet-untyped method, we must defer."
+ [node expression isSend ifTrue:
+ [alreadyExplicitlyTypedOrNotToBeTyped add: var.
+ (aCodeGen methodNamed: node expression selector) ifNotNil:
+ [newDeclarations removeKey: var ifAbsent: nil]]]
- [alreadyExplicitlyTypedOrNotToBeTyped add: var.
- (node expression isSend
- and: [(aCodeGen methodNamed: node expression selector) notNil]) ifTrue:
- [newDeclarations removeKey: var ifAbsent: nil]]
  ifNotNil: "Merge simple types (but *don't* merge untyped vars); complex types must be defined by the programmer."
  [((aCodeGen isSimpleType: type) or: [aCodeGen isFloatingPointCType: type]) ifTrue:
  [(asYetUntyped includes: var)
  ifTrue: [newDeclarations at: var put: type, ' ', var. asYetUntyped remove: var]
  ifFalse:
  [aCodeGen mergeTypeOf: var in: newDeclarations with: type method: self].
  effectiveNodes at: var put: { newDeclarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]]]].
  mustBeSigned do:
  [:var|
  (newDeclarations at: var ifAbsent: nil) ifNotNil:
  [:decl| | type |
  type := aCodeGen extractTypeFor: var fromDeclaration: decl.
  type first == $u ifTrue:
  [newDeclarations at: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var]]].
  newDeclarations keysAndValuesDo:
  [:var :decl| declarations at: var put: decl].
  ^effectiveNodes!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>computeKernelReturnTypes (in category 'public') -----
+ computeKernelReturnTypes
+ | dictionary |
+ dictionary :=super computeKernelReturnTypes.
+ InterpreterProxy methodsDo:
+ [:method|
+ (method pragmaAt: #returnTypeC:) ifNotNil:
+ [:pragma|
+ dictionary at: method selector put: pragma arguments first]].
+ ^dictionary!

Item was added:
+ Behavior subclass: #WordsOrShorts
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SmartSyntaxPlugins'!
+
+ !WordsOrShorts commentStamp: 'eem 9/10/2020 12:45' prior: 0!
+ Coercion specification for bits objects organized in either 32-bit or 16-bit units like WordArray, DoubleByteArray, etc. Specifically this supports the sound primitives which were built assuming the original 32-bit SoundBuffer.  But now with Spur we can more conveniently use a DoubleByteArray like SoundBuffer with proper signed 16-bit elements.!

Item was added:
+ ----- Method: WordsOrShorts class>>ccg:prolog:expr:index: (in category 'plugin generation') -----
+ ccg: cg prolog: aBlock expr: aString index: anInteger
+
+ ^cg
+ ccgLoad: aBlock
+ expr: aString
+ asCharPtrFrom: anInteger
+ andThen: (cg ccgValBlock: 'isWordsOrShorts')!

Item was added:
+ ----- Method: WordsOrShorts class>>ccgCanConvertFrom: (in category 'plugin generation') -----
+ ccgCanConvertFrom: anObject
+
+ ^anObject class isLongs or: [anObject class isShorts]!

Item was added:
+ ----- Method: WordsOrShorts class>>ccgDeclareCForVar: (in category 'plugin generation') -----
+ ccgDeclareCForVar: aSymbolOrString
+
+ ^'short *', aSymbolOrString!