[Vm-dev] VM Maker: VMMaker.oscog-eem.2785.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Aug 1 02:45:24 UTC 2020


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

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

Name: VMMaker.oscog-eem.2785
Author: eem
Time: 31 July 2020, 7:45:15.985473 pm
UUID: 9fa77ef1-7255-47f3-9dd1-c500f9529cbb
Ancestors: VMMaker.oscog-eem.2784

Plugins: Clean up the SoundPlugin, eloiminating almost all cCode:'s, making it potentially simulateable once the internal API is implemented.  Use the methodRetur...: API to simplify a number of primitives.  Change primitiveSoundEnableAEC to take either 0, 1 or a boolean.

Slang: eliminate the arguments to addressOf:put: blocks via nodeIsDeadCode:withParent:

Simulation: implement unsigned coercion in cCoerce:to: to support this form in primitiveSoundEnableAEC
	(interpreterProxy isIntegerObject: (arg := interpreterProxy stackValue: 0))
		ifTrue:
			[arg := interpreterProxy integerValueOf: arg.
			 (interpreterProxy cCoerce: arg to: #unsigned) > 1 ifTrue:
				[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
			 trueOrFalse := arg = 1]
		ifFalse:
			[(interpreterProxy isBooleanObject: arg) ifFalse:
				[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
			trueOrFalse := interpreterProxy booleanValueOf: arg].

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

Item was changed:
  ----- Method: CCodeGenerator>>nodeIsDeadCode:withParent: (in category 'utilities') -----
  nodeIsDeadCode: aNode withParent: parentNode
  	"Answer if aNode would not be generated due to dead code elimination."
+ 	(aNode isLiteralBlock and: [parentNode isSend and: [parentNode selector == #addressOf:put:]]) ifTrue:
+ 		[^true].
  	^(self nilOrBooleanConditionFor: parentNode)
  		ifNil: [false]
  		ifNotNil:
  			[:cond| | filter |
  			filter := parentNode selector caseOf:
  							{   "First element is accessor for filtered (eliminated) node if expression is true.
  								Second element is accessor for filtered (eliminated) node if expression is false."
  								[#ifFalse:]				-> [#(first nil)].
  								[#ifFalse:ifTrue:] 		-> [#(first last)].
  								[#ifTrue:]				-> [#(nil first)].
  								[#ifTrue:ifFalse:]			-> [#(last first)].
  								[#and:]					-> [#(nil first)].
  								[#or:]					-> [#(last nil)].
  								[#cppIf:ifTrue:]			-> [#(nil #second)].
  								[#cppIf:ifTrue:ifFalse:]	-> [#(third #second)] }.
  			(cond ifTrue: [filter first] ifFalse: [filter last])
  				ifNil: [false]
  				ifNotNil: [:accessor| aNode == (parentNode args perform: accessor)]]!

Item was changed:
  ----- Method: Integer>>coerceTo:sim: (in category '*VMMaker-interpreter simulator') -----
  coerceTo: cTypeString sim: interpreter
  
  	| unitSize |
+ 	cTypeString last == $* ifTrue:  "C pointer"
- 	cTypeString last = $* ifTrue:  "C pointer"
  		[unitSize := cTypeString caseOf: {
  		[#'char *'] -> [1].
  		[#'short *'] -> [2].
  		[#'int *'] -> [4].
  		[#'long long *'] -> [8].
  		[#'float *'] -> [^CFloatArray basicNew interpreter: interpreter address: self unitSize: 4; yourself].
  		[#'double *'] -> [^CFloatArray basicNew interpreter: interpreter address: self unitSize: 8; yourself].
  		[#'unsigned *'] -> [4].
  		[#'unsigned int *'] -> [4].
  		[#'unsigned char *'] -> [1].
  		[#'signed char *'] -> [1].
  		[#'unsigned short *'] -> [2].
  		[#'unsigned long long *'] -> [8].
  		[#'oop *'] -> [interpreter objectMemory bytesPerOop].
  		}
  		otherwise: [interpreter objectMemory wordSize].
  		^CArray basicNew
  			interpreter: interpreter address: self unitSize: unitSize;
  			yourself].
+ 	cTypeString first == $u ifTrue:
+ 		[unitSize := cTypeString caseOf: {
+ 		[#usqInt] -> [interpreter objectMemory wordSize].
+ 		[#usqLong] -> [8].
+ 		[#unsigned] -> [4].
+ 		[#'unsigned int'] -> [4].
+ 		[#'unsigned char'] -> [1].
+ 		[#'unsigned long'] -> [6].
+ 		[#'unsigned short'] -> [2].
+ 		[#'unsigned long long'] -> [8].
+ 		}
+ 		otherwise: [self error: 'unknown unsigned type name'].
+ 		^self bitAnd: 1 << (8 * unitSize) - 1].
+ 	^self  "C number (int, char, etc)"!
- 	^self  "C number (int, char, float, etc)"!

Item was added:
+ ----- Method: InterpreterProxy>>cCoerce:to: (in category 'simulation only') -----
+ cCoerce: value to: cTypeString
+ 	"Type coercion. For translation a cast will be emitted. When running in Smalltalk
+ 	  answer a suitable wrapper for correct indexing."
+ 	^value
+ 		ifNil: [value]
+ 		ifNotNil: [value coerceTo: cTypeString sim: self]!

Item was changed:
  ----- Method: RePlugin>>rcvrMatchSpacePtr (in category 'rcvr linkage') -----
  rcvrMatchSpacePtr
  
  	<inline: true>
  	<returnTypeC: 'int *'>
  	^self
  		cCoerce: (interpreterProxy fetchArray: 7 ofObject: rcvr)
+ 		to: #'int *'!
- 		to: 'int *'.!

Item was changed:
  ----- Method: RePlugin>>rcvrPatternStrPtr (in category 'rcvr linkage') -----
  rcvrPatternStrPtr
  
  	<inline: true>
  	<returnTypeC: 'char *'>
  	^self 
  		cCoerce: (interpreterProxy fetchArray: 0 ofObject: rcvr) 
+ 		to: #'char *'.!
- 		to: 'char *'.!

Item was changed:
  ----- Method: SoundPlugin>>primitiveGetDefaultSoundPlayer (in category 'primitives') -----
  primitiveGetDefaultSoundPlayer
  	"Answer a String with the operating system name of the default output device, or nil"
  	"no arguments"
- 	| cDeviceName sz newString newStringPtr |
  	<export: true>
+ 	| cDeviceName |
+ 	<var: #cDeviceName type: #'char*'>
- 	<var: #cDeviceName type: 'char*'>
- 	<var: #newStringPtr type: 'char*'>
  
- 	"Parse arguments"
- 	interpreterProxy methodArgumentCount = 0 
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	
  	"Get the answer."
+ 	cDeviceName := self getDefaultSoundPlayer.
+ 	cDeviceName = 0 ifTrue:
+ 		[^interpreterProxy methodReturnValue: interpreterProxy nilObject].
- 	cDeviceName := self cCode: 'getDefaultSoundPlayer()'.
- 	cDeviceName == 0 ifTrue: [
- 		^interpreterProxy pop: 1 thenPush: interpreterProxy nilObject
- 		].
  
+ 	^interpreterProxy methodReturnString: cDeviceName!
- 	"Copy the answer to a Squeak String."
- 	sz :=  self cCode: 'strlen(cDeviceName)'.
- 	newString := interpreterProxy 
- 								instantiateClass: interpreterProxy classString
- 								indexableSize: sz.
- 	newStringPtr := interpreterProxy firstIndexableField: newString.
- 	self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'.
- 
- 	self touch: newStringPtr.
- 	self touch: cDeviceName.
- 	"Pop the receiver, and answer the new string."
- 	^interpreterProxy pop: 1 thenPush: newString!

Item was changed:
  ----- Method: SoundPlugin>>primitiveGetDefaultSoundRecorder (in category 'primitives') -----
  primitiveGetDefaultSoundRecorder
  	"Answer a String with the operating system name of the default input device, or nil"
  	"no arguments"
- 	| cDeviceName sz newString newStringPtr |
  	<export: true>
+ 	| cDeviceName |
+ 	<var: #cDeviceName type: #'char*'>
- 	<var: #cDeviceName type: 'char*'>
- 	<var: #newStringPtr type: 'char*'>
  
- 	"Parse arguments"
- 	interpreterProxy methodArgumentCount = 0 
- 		ifFalse:[^interpreterProxy primitiveFail].
- 
  	"Get the answer."
+ 	cDeviceName := self getDefaultSoundRecorder.
+ 	cDeviceName = 0 ifTrue:
+ 		[^interpreterProxy methodReturnValue: interpreterProxy nilObject].
- 	cDeviceName := self cCode: 'getDefaultSoundRecorder()'.
- 	cDeviceName == 0 ifTrue: [
- 		^interpreterProxy pop: 1 thenPush: interpreterProxy nilObject
- 		].
  
+ 	^interpreterProxy methodReturnString: cDeviceName!
- 	"Copy the answer to a Squeak String."
- 	sz :=  self cCode: 'strlen(cDeviceName)'.
- 	newString := interpreterProxy 
- 								instantiateClass: interpreterProxy classString
- 								indexableSize: sz.
- 	newStringPtr := interpreterProxy firstIndexableField: newString.
- 	self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'.
- 
- 	self touch: newStringPtr.
- 	self touch: cDeviceName.
- 	"Pop the receiver, and answer the new string."
- 	^interpreterProxy pop: 1 thenPush: newString!

Item was changed:
  ----- Method: SoundPlugin>>primitiveGetNumberOfSoundPlayerDevices (in category 'primitives') -----
  primitiveGetNumberOfSoundPlayerDevices
- 	"arguments: name(type, stack offset)
- 		dialString(String, 0)"
- 	"answers an Integer"
- 	| result |
  	<export: true>
  
+ 	^interpreterProxy methodReturnInteger: self getNumberOfSoundPlayerDevices!
- 	"Parse arguments"
- 	interpreterProxy methodArgumentCount = 0 
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	
- 	"get result"
- 	result := self cCode: 'getNumberOfSoundPlayerDevices()'.
- 
- 	"answer it"
- 	result := interpreterProxy signed32BitIntegerFor: result.
- 	^interpreterProxy pop: 1 thenPush: result. "pop receiver, return result"!

Item was changed:
  ----- Method: SoundPlugin>>primitiveGetNumberOfSoundRecorderDevices (in category 'primitives') -----
  primitiveGetNumberOfSoundRecorderDevices
- 	"arguments: name(type, stack offset)
- 		dialString(String, 0)"
- 	"answers an Integer"
- 	| result |
  	<export: true>
  
+ 	^interpreterProxy methodReturnInteger: self getNumberOfSoundRecorderDevices!
- 	"Parse arguments"
- 	interpreterProxy methodArgumentCount = 0 
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	
- 	"get result"
- 	result := self cCode: 'getNumberOfSoundRecorderDevices()'.
- 
- 	"answer it"
- 	result := interpreterProxy signed32BitIntegerFor: result.
- 	^interpreterProxy pop: 1 thenPush: result. "pop receiver, return result"!

Item was changed:
  ----- Method: SoundPlugin>>primitiveGetSoundPlayerDeviceName (in category 'primitives') -----
  primitiveGetSoundPlayerDeviceName
  	"arguments: name(type, stack offset)
  		deviceNumber(Integer, 0)"
  	"answers a string or nil"
- 	| deviceNumber sz cDeviceName newString newStringPtr |
  	<export: true>
+ 	| deviceNumber cDeviceName |
+ 	<var: #cDeviceName type: #'char *'>
- 	<var: #cDeviceName type: 'char*'>
- 	<var: #newStringPtr type: 'char*'>
  
  	"Parse arguments" 
+ 	interpreterProxy methodArgumentCount = 1 ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- 	interpreterProxy methodArgumentCount = 1 
- 		ifFalse:[^interpreterProxy primitiveFail].
  
  	deviceNumber := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
+ 	interpreterProxy failed ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 	interpreterProxy failed ifTrue: [^nil].
  	
  	"Get the answer."
+ 	cDeviceName := self getSoundPlayerDeviceName: deviceNumber - 1.
+ 	cDeviceName = 0 ifTrue:
+ 		[^interpreterProxy methodReturnValue: interpreterProxy nilObject].
- 	cDeviceName := self cCode: 'getSoundPlayerDeviceName(deviceNumber - 1)'.
- 	cDeviceName == 0 ifTrue: [
- 		^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject
- 		].
  
+ 	^interpreterProxy methodReturnString: cDeviceName!
- 	"Copy the answer to a Squeak String."
- 	sz :=  self cCode: 'strlen(cDeviceName)'.
- 	newString := interpreterProxy 
- 								instantiateClass: interpreterProxy classString
- 								indexableSize: sz.
- 	newStringPtr := interpreterProxy firstIndexableField: newString.
- 	self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'.
- 
- 	self touch: deviceNumber.
- 	self touch: newStringPtr.
- 	self touch: cDeviceName.
- 	"Pop the receiver and arg, and answer the new string."
- 	^interpreterProxy pop: 2 thenPush: newString!

Item was changed:
  ----- Method: SoundPlugin>>primitiveGetSoundRecorderDeviceName (in category 'primitives') -----
  primitiveGetSoundRecorderDeviceName
  	"arguments: name(type, stack offset)
  		deviceNumber(Integer, 0)"
  	"answers a string or nil"
- 	| deviceNumber sz cDeviceName newString newStringPtr |
  	<export: true>
+ 	| deviceNumber cDeviceName |
+ 	<var: #cDeviceName type: #'char *'>
- 	<var: #cDeviceName type: 'char*'>
- 	<var: #newStringPtr type: 'char*'>
  
  	"Parse arguments" 
+ 	interpreterProxy methodArgumentCount = 1 ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- 	interpreterProxy methodArgumentCount = 1 
- 		ifFalse:[^interpreterProxy primitiveFail].
  
- 
  	deviceNumber := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
+ 	interpreterProxy failed ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 	interpreterProxy failed ifTrue: [^nil].
  	
  	"Get the answer."
+ 	cDeviceName := self getSoundRecorderDeviceName: deviceNumber - 1.
+ 	cDeviceName = 0 ifTrue:
+ 		[^interpreterProxy methodReturnValue: interpreterProxy nilObject].
- 	cDeviceName := self cCode: 'getSoundRecorderDeviceName(deviceNumber - 1)'.
- 	cDeviceName == 0 ifTrue: [
- 		^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject
- 		].
  
+ 	^interpreterProxy methodReturnString: cDeviceName!
- 	"Copy the answer to a Squeak String."
- 	sz :=  self cCode: 'strlen(cDeviceName)'.
- 	newString := interpreterProxy 
- 								instantiateClass: interpreterProxy classString
- 								indexableSize: sz.
- 	newStringPtr := interpreterProxy firstIndexableField: newString.
- 	self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'.
- 
- 	self touch: deviceNumber.
- 	self touch: newStringPtr.
- 	self touch: cDeviceName.
- 	"Pop the receiver and arg, and answer the new string."
- 	^interpreterProxy pop: 2 thenPush: newString!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSetDefaultSoundPlayer (in category 'primitives') -----
  primitiveSetDefaultSoundPlayer
  	"Tell the operating system to use the specified device name as the output device for sound."
  	"arg at top of stack is the String"
- 	| deviceName obj srcPtr sz |
  	<export: true>
+ 	| deviceName obj srcPtr sz |
  	<var: 'deviceName' declareC: 'char deviceName[257]'>
  	<var: 'srcPtr' type: #'char *'>
+ 	self cCode: [] inSmalltalk: [deviceName := ByteString new: 257].
- 
  	"Parse arguments"
  	interpreterProxy methodArgumentCount = 1 ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ 	((interpreterProxy isBytes: (obj := interpreterProxy stackValue: 0))
+ 	and: [(sz := interpreterProxy byteSizeOf: obj) <= 256]) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 
+ 	srcPtr := self cCoerce: (interpreterProxy firstIndexableField: obj) to: #'char *'.
+ 	self strncpy: deviceName _: srcPtr _: sz.
+ 	deviceName at: sz put: 0.
+ 	self setDefaultSoundPlayer: deviceName.
+ 
+ 	interpreterProxy failed ifFalse:
+ 		[interpreterProxy methodReturnReceiver]!
- 		[^interpreterProxy primitiveFail].
- 	obj := interpreterProxy stackValue: 0.
- 	(interpreterProxy isBytes: obj) ifFalse:
- 		[^interpreterProxy primitiveFail].
- 	(sz := interpreterProxy byteSizeOf: obj) <= 256 ifFalse:
- 		[^interpreterProxy primitiveFail].
- 	srcPtr := interpreterProxy firstIndexableField: obj.
- 	self touch: srcPtr.
- 	self touch: deviceName.
- 	self touch: sz.
- 	self cCode: 'strncpy(deviceName, srcPtr, sz)'.
- 	self cCode: 'deviceName[sz] = 0'.
- 	
- 	"do the work"
- 	self cCode: 'setDefaultSoundPlayer(deviceName)'.
- 	interpreterProxy failed ifFalse: "pop arg, leave receiver"
- 		[interpreterProxy pop: 1]!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSetDefaultSoundRecorder (in category 'primitives') -----
  primitiveSetDefaultSoundRecorder
  	"Tell the operating system to use the specified device name as the input device for sound."
  	"arg at top of stack is the String"
- 	| deviceName obj srcPtr sz |
  	<export: true>
+ 	| deviceName obj srcPtr sz |
  	<var: 'deviceName' declareC: 'char deviceName[257]'>
  	<var: 'srcPtr' type: #'char *'>
+ 	self cCode: [] inSmalltalk: [deviceName := ByteString new: 257].
- 
  	"Parse arguments"
  	interpreterProxy methodArgumentCount = 1 ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ 	((interpreterProxy isBytes: (obj := interpreterProxy stackValue: 0))
+ 	and: [(sz := interpreterProxy byteSizeOf: obj) <= 256]) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 
+ 	srcPtr := self cCoerce: (interpreterProxy firstIndexableField: obj) to: #'char *'.
+ 	self strncpy: deviceName _: srcPtr _: sz.
+ 	deviceName at: sz put: 0.
+ 	self setDefaultSoundRecorder: deviceName.
+ 
+ 	interpreterProxy failed ifFalse:
+ 		[interpreterProxy methodReturnReceiver]!
- 		[^interpreterProxy primitiveFail].
- 	obj := interpreterProxy stackValue: 0.
- 	(interpreterProxy isBytes: obj) ifFalse:
- 		[^interpreterProxy primitiveFail].
- 	(sz := interpreterProxy byteSizeOf: obj) <= 256 ifFalse:
- 		[^interpreterProxy primitiveFail].
- 	srcPtr := interpreterProxy firstIndexableField: obj.
- 	self touch: srcPtr.
- 	self touch: deviceName.
- 	self touch: sz.
- 	self cCode: 'strncpy(deviceName, srcPtr, sz)'.
- 	self cCode: 'deviceName[sz] = 0'.
- 	
- 	"do the work"
- 	self cCode: 'setDefaultSoundRecorder(deviceName)'.
- 	interpreterProxy failed ifFalse: "pop arg, leave receiver"
- 		[interpreterProxy pop: 1]!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundAvailableSpace (in category 'primitives') -----
  primitiveSoundAvailableSpace
+ 	"Returns the number of bytes of available sound output buffer space.
+ 	 This should be (frames*4) if the device is in stereo mode, or (frames*2) otherwise"
- 	"Returns the number of bytes of available sound output buffer space.  This should be (frames*4) if the device is in stereo mode, or (frames*2) otherwise"
  
+ 	<export: true>
  	| frames |
+ 	frames := self snd_AvailableSpace.  "-1 if sound output not started"
+ 	frames >= 0
+ 		ifTrue: [interpreterProxy methodReturnInteger: frames]
+ 		ifFalse: [interpreterProxy primitiveFail]!
- 	self primitive: 'primitiveSoundAvailableSpace'.
- 	frames := self cCode: 'snd_AvailableSpace()'.  "-1 if sound output not started"
- 	interpreterProxy success: frames >= 0.
- 	^frames asPositiveIntegerObj!

Item was added:
+ ----- Method: SoundPlugin>>primitiveSoundEnableAEC (in category 'primitives') -----
+ primitiveSoundEnableAEC
+ 	"Enable or disable acoustic echo-cancellation (AEC).
+ 	 Arg is a boolean or 1 for true and 0 for false."
+ 	<export: true>
+ 	| arg trueOrFalse errorCode |
+ 	interpreterProxy methodArgumentCount = 1 ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ 	"Parse arguments"
+ 	(interpreterProxy isIntegerObject: (arg := interpreterProxy stackValue: 0))
+ 		ifTrue:
+ 			[arg := interpreterProxy integerValueOf: arg.
+ 			 (interpreterProxy cCoerce: arg to: #unsigned) > 1 ifTrue:
+ 				[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 			 trueOrFalse := arg = 1]
+ 		ifFalse:
+ 			[(interpreterProxy isBooleanObject: arg) ifFalse:
+ 				[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 			trueOrFalse := interpreterProxy booleanValueOf: arg].
+ 	"Set AEC"
+ 	(errorCode := self snd_EnableAEC: trueOrFalse) ~= 0 ifTrue:
+ 		[interpreterProxy primitiveFailFor: (errorCode < 0 ifTrue: [PrimErrGenericFailure] ifFalse: [errorCode])]!

Item was removed:
- ----- Method: SoundPlugin>>primitiveSoundEnableAEC: (in category 'primitives') -----
- primitiveSoundEnableAEC: trueOrFalse 
- 	"Enable or disable acoustic echo-cancellation (AEC).  trueOrFalse should be 0 for false, and 1 for true."
- 	| result |
- 	self primitive: 'primitiveSoundEnableAEC' parameters: #(SmallInteger ).
- 	interpreterProxy failed ifFalse: [
- 		result := self cCode: 'snd_EnableAEC(trueOrFalse)'.
- 		result == 0 ifFalse: [interpreterProxy primitiveFailFor: result].
- 	].!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundGetRecordLevel (in category 'primitives') -----
  primitiveSoundGetRecordLevel
+ 	"Get the default input device's volume level in the range 0-1000."
+ 	<export: true>
- 	"Get the sound input recording level  in the range 0-1000."
  	| level |
  	<var: 'level' type: #int>
+ 	level := self snd_GetRecordLevel.
+ 	^level >= 0
+ 		ifTrue: [interpreterProxy methodReturnInteger: level]
+ 		ifFalse: [interpreterProxy primitiveFail]!
- 	self primitive: 'primitiveSoundGetRecordLevel'.
- 	level := self cCode: 'snd_GetRecordLevel()'.
- 	^level asPositiveIntegerObj
- !

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundGetRecordingSampleRate (in category 'primitives') -----
  primitiveSoundGetRecordingSampleRate
  	"Return a float representing the actual sampling rate during recording. Fail if not currently recording."
  
+ 	<export: true>
  	| rate |
+ 	<var: #rate type: #double>
+ 	rate := self snd_GetRecordingSampleRate.  "fails if not recording"
+ 	interpreterProxy failed ifFalse:
+ 		[^interpreterProxy methodReturnFloat: rate]!
- 	<var: #rate type: 'double '>
- 	self primitive: 'primitiveSoundGetRecordingSampleRate'.
- 	rate := self cCode: 'snd_GetRecordingSampleRate()'.  "fail if not recording"
- 	^rate asFloatObj!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundGetVolume (in category 'primitives') -----
  primitiveSoundGetVolume
+ 	"Get the default output device's volume level as a left/right pair of floats in the range 0-1."
+ 	<export: true>
+ 	| left right leftOop rightOop results |
- 	"Get the sound input recording level."
- 	| left right results |
  	<var: #left type: #double>
  	<var: #right type: #double>
+ 	left := 0.0.
+ 	right := 0.0.
+ 	self snd_Volume: (self addressOf: left put: [:v| left := v]) _: (self addressOf: right put: [:v| right := v]).
+ 	interpreterProxy failed ifTrue:
+ 		[^self].
+ 	results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
+ 	results ifNil:
+ 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
+ 	self remapOop: results in:
+ 		[leftOop := interpreterProxy floatObjectOf: left.
+ 		 self remapOop: leftOop in:
+ 			[rightOop := interpreterProxy floatObjectOf: right]].
+ 	interpreterProxy
+ 		storePointer: 0 ofObject: results withValue: leftOop;
+ 		storePointer: 1 ofObject: results withValue: rightOop;
+ 		methodReturnValue: results!
- 	self primitive: 'primitiveSoundGetVolume'
- 		parameters: #( ).
- 	left := 0.
- 	right := 0.
- 	self cCode: 'snd_Volume((double *) &left,(double *) &right)'.
- 	interpreterProxy pushRemappableOop: (right asOop: Float).
- 	interpreterProxy pushRemappableOop: (left asOop: Float).
- 	results := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2.
- 	interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
- 	interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
- 	^results!

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 WordArray SmallInteger).
+ 	frameCount <= (interpreterProxy slotSizeOf: buf cPtrAsOop) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 		parameters: #(SmallInteger WordArray SmallInteger ).
- 	interpreterProxy success: frameCount <= (interpreterProxy slotSizeOf: buf cPtrAsOop).
  
+ 	framesPlayed := self snd_InsertSamplesFromLeadTime: frameCount _: buf _: leadTime.
+ 	framesPlayed >= 0
+ 		ifTrue: [interpreterProxy methodReturnInteger: framesPlayed]
+ 		ifFalse: [interpreterProxy primitiveFail]!
- 	interpreterProxy failed
- 		ifFalse: [framesPlayed := self cCode: 'snd_InsertSamplesFromLeadTime(frameCount, (void *)buf, leadTime)'.
- 			interpreterProxy success: framesPlayed >= 0].
- 	^ framesPlayed asPositiveIntegerObj!

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

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundPlaySilence (in category 'primitives') -----
  primitiveSoundPlaySilence
  	"Output a buffer's worth of silence. Returns the number of sample frames played."
  
+ 	<export: true>
  	| framesPlayed |
+ 	framesPlayed := self snd_PlaySilence.  "-1 if sound output not started"
+ 	framesPlayed >= 0
+ 		ifTrue: [interpreterProxy methodReturnInteger: framesPlayed]
+ 		ifFalse: [interpreterProxy primitiveFail]!
- 	self primitive: 'primitiveSoundPlaySilence'.
- 	framesPlayed := self cCode: 'snd_PlaySilence()'.  "-1 if sound output not started"
- 	interpreterProxy success: framesPlayed >= 0.
- 	^framesPlayed asPositiveIntegerObj!

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 |
- 	| bufSizeInBytes samplesRecorded bufPtr byteOffset bufLen |
  	<var: #bufPtr type: #'char*'>
  	self primitive: 'primitiveSoundRecordSamples'
+ 		parameters: #(WordArray SmallInteger).
- 		parameters: #(WordArray SmallInteger ).
  
+ 	bufSizeInBytes := (interpreterProxy slotSizeOf: buf cPtrAsOop) * 4.
+ 	byteOffset := (startWordIndex - 1) * 2.
- 	interpreterProxy failed ifFalse:
- 		[bufSizeInBytes := (interpreterProxy slotSizeOf: buf cPtrAsOop) * 4.
- 		 interpreterProxy success: (startWordIndex >= 1 and: [startWordIndex - 1 * 2 < bufSizeInBytes])].
  
+ 	(startWordIndex >= 1 and: [byteOffset < bufSizeInBytes]) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
- 	interpreterProxy failed ifFalse:[
- 		byteOffset := (startWordIndex - 1) * 2.
- 		bufPtr := (self cCoerce: buf to: 'char*') + byteOffset.
- 		bufLen := bufSizeInBytes - byteOffset.
- 		samplesRecorded := self cCode: 'snd_RecordSamplesIntoAtLength(bufPtr, 0, bufLen)' inSmalltalk:[bufPtr. bufLen. 0].
- 	].
  
+ 	bufPtr := (self cCoerce: buf to: #'char *') + byteOffset.
+ 	samplesRecorded := self snd_RecordSamplesIntoAtLength: bufPtr _: 0 _: bufSizeInBytes - byteOffset.
+ 	interpreterProxy failed ifFalse:
+ 		[^samplesRecorded asPositiveIntegerObj]!
- 	^ samplesRecorded asPositiveIntegerObj!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundSetLeftVolume:rightVolume: (in category 'primitives') -----
  primitiveSoundSetLeftVolume: aLeftVolume rightVolume: aRightVolume
  	"Set the sound input recording level."
  
  	self primitive: 'primitiveSoundSetLeftVolume'
  		parameters: #(Float Float).
+ 	self snd_SetVolume: aLeftVolume _: aRightVolume!
- 	interpreterProxy failed ifFalse: [self cCode: 'snd_SetVolume(aLeftVolume,aRightVolume)'].
- !

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundSetRecordLevel: (in category 'primitives') -----
  primitiveSoundSetRecordLevel: level 
  	"Set the sound input recording level."
  	self primitive: 'primitiveSoundSetRecordLevel'
+ 		parameters: #(SmallInteger).
+ 	self snd_SetRecordLevel: level!
- 		parameters: #(SmallInteger ).
- 	interpreterProxy failed ifFalse: [self cCode: 'snd_SetRecordLevel(level)']!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundStartBufferSize:rate:stereo: (in category 'primitives') -----
  primitiveSoundStartBufferSize: bufFrames rate: samplesPerSec stereo: stereoFlag
  	"Start the double-buffered sound output with the given buffer size, sample rate, and stereo flag."
  
  	self primitive: 'primitiveSoundStart'
  		parameters: #(SmallInteger SmallInteger Boolean).
+ 	interpreterProxy success: (self snd_Start: bufFrames _: samplesPerSec _: stereoFlag _: 0)!
- 	interpreterProxy success: (self cCode: 'snd_Start(bufFrames, samplesPerSec, stereoFlag, 0)')!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundStartBufferSize:rate:stereo:semaIndex: (in category 'primitives') -----
  primitiveSoundStartBufferSize: bufFrames rate: samplesPerSec stereo: stereoFlag semaIndex: semaIndex
  	"Start the double-buffered sound output with the given buffer size, sample rate, stereo flag, and semaphore index."
  
  	self primitive: 'primitiveSoundStartWithSemaphore'
  		parameters: #(SmallInteger SmallInteger Boolean SmallInteger).
+ 	interpreterProxy success: (self snd_Start: bufFrames _: samplesPerSec _: stereoFlag _: semaIndex)!
- 	interpreterProxy success: (self cCode: 'snd_Start(bufFrames, samplesPerSec, stereoFlag, semaIndex)')!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundStartRecordingDesiredSampleRate:stereo:semaIndex: (in category 'primitives') -----
  primitiveSoundStartRecordingDesiredSampleRate: desiredSamplesPerSec stereo: stereoFlag semaIndex: semaIndex
  	"Start recording sound with the given parameters."
  
  	self primitive: 'primitiveSoundStartRecording'
  		parameters: #(SmallInteger Boolean SmallInteger).
+ 	self snd_StartRecording: desiredSamplesPerSec _: stereoFlag _: semaIndex!
- 	self cCode: 'snd_StartRecording(desiredSamplesPerSec, stereoFlag, semaIndex)'!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundStop (in category 'primitives') -----
  primitiveSoundStop
  	"Stop double-buffered sound output."
+ 	<export: true>
+ 	self snd_Stop!
- 
- 	self primitive: 'primitiveSoundStop'.
- 
- 	self cCode: 'snd_Stop()'.  "leave rcvr on stack"!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundStopRecording (in category 'primitives') -----
  primitiveSoundStopRecording
  	"Stop recording sound."
+ 	<export: true>
+ 	self snd_StopRecording!
- 
- 	self primitive: 'primitiveSoundStopRecording'.
- 	self cCode: 'snd_StopRecording()'.  "leave rcvr on stack"!

Item was changed:
  ----- Method: SoundPlugin>>primitiveSoundSupportsAEC (in category 'primitives') -----
  primitiveSoundSupportsAEC
+ 	"Answer if the OS/hardware supports echo-cancellation."
+ 	<export: true>
- 	"Answer true if the OS/hardware supports echo-cancellation, and false otherwise."
  	| result |
+ 	result := self snd_SupportsAEC.
+ 	interpreterProxy failed ifFalse:
+ 		[interpreterProxy methodReturnBool: result ~= 0]!
- 	self primitive: 'primitiveSoundSupportsAEC'.
- 	interpreterProxy failed ifFalse: [
- 		result := self cCode: 'snd_SupportsAEC()'.
- 		result == 0 ifTrue: [^interpreterProxy falseObject] ifFalse: [^interpreterProxy trueObject]
- 	].
- !

Item was changed:
  ----- Method: VMClass>>cCoerce:to: (in category 'memory access') -----
  cCoerce: value to: cTypeString
+ 	"Type coercion. For translation a cast will be emitted. When running in Smalltalk
- 	"Type coercion. For translation a cast will be emmitted. When running in Smalltalk
  	  answer a suitable wrapper for correct indexing."
  	<doNotGenerate>
  	^value
  		ifNil: [value]
  		ifNotNil: [value coerceTo: cTypeString sim: self]!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>shouldGenerateAsInterpreterProxySend: (in category 'utilities') -----
  shouldGenerateAsInterpreterProxySend: aSendNode
  	"Answer if this send should be generated as interpreterProxy->foo or its moral equivalent (*).
  	 (*) since we now use function pointers declared in each external plugin we only indirect through
  	 interopreterProxy at plugin initialization.  But we still have to find the set of sends a plugin uses."
  	| selector |
  	(aSendNode receiver isVariable and: ['interpreterProxy' = aSendNode receiver name]) ifFalse: [^false].
  	selector := aSendNode selector.
  	"baseHeaderSize, minSmallInteger et al are #defined in each VM's interp.h"
  	(VMBasicConstants mostBasicConstantSelectors includes: selector) ifTrue: [^false].
  	"Only include genuine InterpreterProxy methods, excluding things not understood
+ 	 by InterpreterProxy and things in its initialize, private and simulation protocols."
+ 	^(#(initialize private #'simulation only') includes: (InterpreterProxy compiledMethodAt: selector ifAbsent: [^false]) protocol) not!
- 	 by InterpreterProxy and things in its initialize and private protocols."
- 	^(#(initialize private) includes: (InterpreterProxy compiledMethodAt: selector ifAbsent: [^false]) protocol) not!



More information about the Vm-dev mailing list