[Vm-dev] VM Maker: VMMaker.oscog-eem.2360.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Mar 16 23:23:59 UTC 2018
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2360.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2360
Author: eem
Time: 16 March 2018, 4:23:22.624221 pm
UUID: f605d636-c6de-4a07-967a-4d3bfa53fa3e
Ancestors: VMMaker.oscog-eem.2359
Plugin:
Deprecate the unused in-argument-order primitive argument accessors floatArg:, integerArg:, methodArg:, & objectArg:. These have never been used. Replace them with more convenient variants of methodReturnValue:, namely methodReturnBool:, methodReturnFloat:, methodReturnInteger:, and methodReturnString:. Use them in a few primitives.
Change CameraPlugin & UnicodePlugin prims to avoid use of cCode:.
=============== Diff against VMMaker.oscog-eem.2359 ===============
Item was changed:
----- Method: CameraPlugin>>primFrameExtent (in category 'primitives') -----
primFrameExtent
"Answer the frame extent of the given camera, or zero if the camera is not open. The extent is 16 bits of width and height packed into a single integer."
+ | cameraNum |
- | cameraNum e |
<export: true>
cameraNum := interpreterProxy stackIntegerValue: 0.
+ interpreterProxy failed ifFalse:
+ [interpreterProxy methodReturnInteger: (self CameraExtent: cameraNum)]!
- interpreterProxy failed ifTrue: [^ 0].
-
- e := self cCode: 'CameraExtent(cameraNum)'.
-
- interpreterProxy pop: 2 thenPush: (interpreterProxy integerObjectOf: e). "pop rcvr & arg, push int result"
- ^ 0
- !
Item was changed:
----- Method: CameraPlugin>>primGetFrame (in category 'primitives') -----
primGetFrame
"Copy a camera frame into the given Bitmap. The Bitmap should be for a Form of depth 32 that is the same width and height as the current camera frame. Fail if the camera is not open or if the bitmap is not the right size. If successful, answer the number of frames received from the camera since the last call. If this is zero, then there has been no change."
| cameraNum bitmapOop bitmap pixCount result |
<export: true>
<var: 'bitmap' type: #'unsigned char *'>
cameraNum := interpreterProxy stackIntegerValue: 1.
bitmapOop := interpreterProxy stackValue: 0.
interpreterProxy success: (interpreterProxy isWords: bitmapOop).
interpreterProxy failed ifTrue:
[^ 0].
bitmap := self cCoerce: (interpreterProxy firstIndexableField: bitmapOop) to: #'unsigned char *'.
pixCount := interpreterProxy stSizeOf: bitmapOop.
result := self Camera: cameraNum Get: bitmap Frame: pixCount.
+ result < 0 ifTrue:
+ [^interpreterProxy primitiveFail].
- result < 0 ifTrue: [
- interpreterProxy success: false.
- ^ 0].
+ interpreterProxy methodReturnInteger: result!
- interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: result). "pop rcvr & args, push int result"
- ^ 0
-
- !
Item was changed:
----- Method: CameraPlugin>>primGetParam (in category 'primitives') -----
primGetParam
"Answer the given integer parameter of the given camera."
+ | cameraNum paramNum |
- | cameraNum paramNum result |
<export: true>
cameraNum := interpreterProxy stackIntegerValue: 1.
paramNum := interpreterProxy stackIntegerValue: 0.
+ interpreterProxy failed ifFalse:
+ [interpreterProxy methodReturnInteger: (self Camera: cameraNum GetParam: paramNum)]!
- interpreterProxy failed ifTrue: [^ 0].
-
- result := self cCode: 'CameraGetParam(cameraNum, paramNum)'.
-
- interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: result). "pop rcvr & args, push int result"
- ^ 0
- !
Item was changed:
----- Method: FloatArrayPlugin>>primitiveLength (in category 'arithmetic primitives') -----
primitiveLength
"Primitive. Compute the length of the argument (sqrt of sum of component squares)."
<export: true>
| rcvr rcvrPtr length len |
<var: #rcvrPtr type: #'float *'>
<var: #len type: #double>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
len := 0.0.
0 to: length-1 do:
[:i| len := len + ((self cCoerce: (rcvrPtr at: i) to: #double) * (self cCoerce: (rcvrPtr at: i) to: #double)) ].
len > 0.0 ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ interpreterProxy methodReturnFloat: (self sqrt: len)!
- interpreterProxy pop: 1 thenPush: (interpreterProxy floatObjectOf: (self sqrt: len))!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSum (in category 'arithmetic primitives') -----
primitiveSum
"Primitive. Find the sum of each float in the receiver, a FloatArray, and stash the result into the argument Float."
| rcvr rcvrPtr length sum |
<export: true>
<var: #sum type: #double>
<var: #rcvrPtr type: #'float *'>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
sum := 0.0.
0 to: length-1 do:[:i|
sum := sum + (self cCoerce: (rcvrPtr at: i) to: #double).
].
+ interpreterProxy methodReturnFloat: sum!
- interpreterProxy pop: 1 thenPush: (interpreterProxy floatObjectOf: sum)!
Item was changed:
----- Method: FloatMathPlugin>>primitiveTimesTwoPower (in category 'float primitives') -----
primitiveTimesTwoPower
"Multiply the receiver by the power of the argument."
| rcvr arg result |
<export: true>
<var: #rcvr type: #double>
<var: #result type: #double>
arg := interpreterProxy stackIntegerValue: 0.
rcvr := interpreterProxy stackFloatValue: 1.
interpreterProxy failed ifTrue:
[^nil].
interpreterProxy bytesPerOop > 4 ifTrue:
[| twiceMaxExponent | "clip arg to at most int range; ldexp's last arg is of type int"
twiceMaxExponent := 2 * (1 << self floatExponentBits).
arg < twiceMaxExponent negated
ifTrue: [arg := twiceMaxExponent negated]
ifFalse: [arg > twiceMaxExponent ifTrue:
[arg := twiceMaxExponent]]].
result := self cCode: '__ieee754_ldexp(rcvr, (int)arg)'
inSmalltalk: [rcvr timesTwoPower: arg].
(self isnan: result) ifFalse:
+ [interpreterProxy methodReturnFloat: result].
- [interpreterProxy methodReturnValue: (interpreterProxy floatObjectOf: result)].
^nil!
Item was changed:
----- Method: InterpreterProxy>>floatArg: (in category 'stack access') -----
floatArg: offset
"Like #stackFloatValue: but access method arguments left-to-right"
+ "Obsolete; was never used; replaced with methodReturnString: in the VirtualMachine struct."
| oop |
+ <returnTypeC: #double>
+ self deprecated.
- <returnTypeC: 'double'>
oop := self methodArg: offset.
(self isFloatObject: oop) ifFalse: [self primitiveFail. ^0.0].
^oop!
Item was changed:
----- Method: InterpreterProxy>>floatObjectOf: (in category 'converting') -----
floatObjectOf: aFloat
<returnTypeC: #sqInt> "...because answering the float argument causes the type inferencer to say this answers a float."
+ <var: #aFloat type: #double>
+ aFloat isFloat ifFalse: [self error:'Not a float object'].
- <var: #aFloat type: 'double '>
- aFloat isFloat ifFalse:[self error:'Not a float object'].
^aFloat!
Item was changed:
----- Method: InterpreterProxy>>integerArg: (in category 'stack access') -----
integerArg: offset
"Like #stackIntegerValue: but access method arguments left-to-right"
+ "Obsolete; was never used; replaced with methodReturnInteger: in the VirtualMachine struct."
| oop |
+ self deprecated.
oop := self methodArg: offset.
(self isIntegerObject: oop) ifFalse: [self primitiveFail. ^0].
^oop!
Item was changed:
----- Method: InterpreterProxy>>methodArg: (in category 'stack access') -----
methodArg: offset
"Like #stackValue: but access method arguments left-to-right"
+ "Obsolete; was never used; replaced with methodReturnBool: in the VirtualMachine struct."
+ self deprecated.
offset > argumentCount + 1 ifTrue:[^self primitiveFail].
^self stackValue: argumentCount - offset!
Item was added:
+ ----- Method: InterpreterProxy>>methodReturnBool: (in category 'stack access') -----
+ methodReturnBool: boolean
+ "Sets the return value for a method"
+ self pop: argumentCount+1 thenPushBool: boolean.
+ ^0!
Item was added:
+ ----- Method: InterpreterProxy>>methodReturnFloat: (in category 'stack access') -----
+ methodReturnFloat: aFloat
+ "Sets the return value for a method"
+ <var: 'aFloat' type: #double>
+ self pop: argumentCount+1 thenPushFloat: aFloat.
+ ^0!
Item was added:
+ ----- Method: InterpreterProxy>>methodReturnInteger: (in category 'stack access') -----
+ methodReturnInteger: integer
+ "Sets the return value for a method"
+ self pop: argumentCount+1 thenPushInteger: integer.
+ ^0!
Item was added:
+ ----- Method: InterpreterProxy>>methodReturnString: (in category 'stack access') -----
+ methodReturnString: aCString
+ "Sets the return value for a method"
+ <var: 'aCString' type: #'char *'>
+ self pop: argumentCount+1 thenPush: (self stringForCString: aCString).
+ ^0!
Item was changed:
----- Method: InterpreterProxy>>objectArg: (in category 'stack access') -----
objectArg: offset
"Like #stackObjectValue: but access method arguments left-to-right"
+ "Obsolete; was never used; replaced with methodReturnFloat: in the VirtualMachine struct."
| oop |
+ self deprecated.
oop := self methodArg: offset.
+ (self isImmediate: oop) ifTrue: [self primitiveFail. ^ nil].
- (self isIntegerObject: oop) ifTrue: [self primitiveFail. ^ nil].
^oop!
Item was added:
+ ----- Method: InterpreterProxy>>pop:thenPushBool: (in category 'private') -----
+ pop: nItems thenPushBool: boolean
+ <returnTypeC: #sqInt>
+ self pop: nItems.
+ self push: (boolean ifTrue: [self trueObject] ifFalse: [self falseObject])!
Item was added:
+ ----- Method: InterpreterProxy>>pop:thenPushFloat: (in category 'private') -----
+ pop: nItems thenPushFloat: float
+ <var: #float type: #double>
+ <returnTypeC: #sqInt>
+ self pop: nItems.
+ self push: (self floatObjectOf: float)!
Item was added:
+ ----- Method: InterpreterProxy>>pop:thenPushInteger: (in category 'private') -----
+ pop: nItems thenPushInteger: integer
+ <returnTypeC: #sqInt>
+ self pop: nItems.
+ self push: (self integerObjectOf: integer)!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveCompareString (in category 'primitives') -----
primitiveCompareString
"ByteString (class) compare: string1 with: string2 collated: order"
<export: true>
| len1 len2 order string1 string2 |
<var: 'order' type: #'unsigned char *'>
<var: 'string1' type: #'unsigned char *'>
<var: 'string2' type: #'unsigned char *'>
((interpreterProxy isBytes: (interpreterProxy stackValue: 0))
and: [(interpreterProxy isBytes: (interpreterProxy stackValue: 1))
and: [interpreterProxy isBytes: (interpreterProxy stackValue: 2)]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
string1 := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 2).
string2 := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1).
order := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 0).
len1 := interpreterProxy sizeOfSTArrayFromCPrimitive: string1.
len2 := interpreterProxy sizeOfSTArrayFromCPrimitive: string2.
(interpreterProxy sizeOfSTArrayFromCPrimitive: order) < 256 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
0 to: (len1 min: len2) - 1 do:
[ :i | | c1 c2 |
c1 := order at: (string1 at: i).
c2 := order at: (string2 at: i).
c1 = c2 ifFalse:
+ [^interpreterProxy methodReturnInteger: (c1 < c2 ifTrue: [1] ifFalse: [3])]].
+ interpreterProxy methodReturnInteger:
+ (len1 = len2 ifTrue: [2] ifFalse: [len1 < len2 ifTrue: [1] ifFalse: [3]])!
- [^interpreterProxy methodReturnValue:
- (interpreterProxy integerObjectOf:
- (c1 < c2 ifTrue: [1] ifFalse: [3]))]].
- interpreterProxy methodReturnValue:
- (interpreterProxy integerObjectOf:
- (len1 = len2 ifTrue: [2] ifFalse: [len1 < len2 ifTrue: [1] ifFalse: [3]]))!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveCompressToByteArray (in category 'primitives') -----
primitiveCompressToByteArray
"Bitmap compress: bm toByteArray: ba"
<export: true>
| bm ba eqBytes i j k lowByte size destSize word |
<var: 'ba' type: #'unsigned char *'>
<var: 'bm' type: #'int *'>
bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1)]
inSmalltalk: [interpreterProxy
cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1))
to: #'int *'].
interpreterProxy failed ifTrue: [^nil].
(interpreterProxy isBytes: (interpreterProxy stackValue: 0)) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy isOopImmutable: (interpreterProxy stackValue: 0)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 0).
size := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
destSize := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
destSize < ((size * 4) + 7 + (size // 1984 * 3)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrUnsupported]. "Size may be OK but we don't know, hence fail with unsupported"
i := self encodeInt: size in: ba at: 0.
k := 0.
[k < size] whileTrue:
[word := bm at: k.
lowByte := word bitAnd: 255.
eqBytes := (word >> 8 bitAnd: 255) = lowByte and: [(word >> 16 bitAnd: 255) = lowByte and: [(word >> 24 bitAnd: 255) = lowByte]].
j := k.
[j + 1 < size and: [word = (bm at: j + 1)]] whileTrue: [j := j + 1].
j > k
ifTrue:
[eqBytes
ifTrue:
[i := self encodeInt: j - k + 1 * 4 + 1 in: ba at: i.
ba at: i put: lowByte.
i := i + 1]
ifFalse:
[i := self encodeInt: j - k + 1 * 4 + 2 in: ba at: i.
i := self encodeBytesOf: word in: ba at: i].
k := j + 1]
ifFalse:
[eqBytes
ifTrue:
[i := self encodeInt: 1 * 4 + 1 in: ba at: i.
ba at: i put: lowByte.
i := i + 1.
k := k + 1]
ifFalse:
[[j + 1 < size and: [(bm at: j) ~= (bm at: j + 1)]] whileTrue: [j := j + 1].
j + 1 = size ifTrue: [j := j + 1].
i := self encodeInt: j - k * 4 + 3 in: ba at: i.
k to: j - 1 by: 1 do: [ :m | i := self encodeBytesOf: (bm at: m) in: ba at: i].
k := j]]].
+ interpreterProxy methodReturnInteger: i!
- interpreterProxy methodReturnValue: (interpreterProxy integerObjectOf: i)!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveFindFirstInString (in category 'primitives') -----
primitiveFindFirstInString
"ByteString (class) findFirstInString: aString inSet: inclusionMap startingAt: start"
<export: true>
| aString i inclusionMap start stringSize |
<var: 'aString' type: #'unsigned char *'>
<var: 'inclusionMap' type: #'char *'>
((interpreterProxy isIntegerObject: (interpreterProxy stackValue: 0))
and: [(interpreterProxy isBytes: (interpreterProxy stackValue: 1))
and: [interpreterProxy isBytes: (interpreterProxy stackValue: 2)]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aString := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 2).
inclusionMap := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1).
start := interpreterProxy integerValueOf: (interpreterProxy stackValue: 0).
(interpreterProxy sizeOfSTArrayFromCPrimitive: inclusionMap) ~= 256 ifTrue:
+ [^interpreterProxy methodReturnInteger: 0].
- [^interpreterProxy methodReturnValue: (interpreterProxy integerObjectOf: 0)].
i := start - 1.
stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
[i < stringSize and: [(inclusionMap at: (aString at: i)) = 0]] whileTrue:
[i := i + 1].
+ interpreterProxy methodReturnInteger: (i >= stringSize ifTrue: [0] ifFalse: [i + 1])!
- interpreterProxy methodReturnValue: (interpreterProxy integerObjectOf: (i >= stringSize ifTrue: [0] ifFalse: [i + 1]))!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveFindSubstring (in category 'primitives') -----
primitiveFindSubstring
"ByteString findSubstring: key in: body startingAt: start matchTable: matchTable"
<export: true>
| body key keySize matchTable start |
<var: #key type: #'unsigned char *'>
<var: #body type: #'unsigned char *'>
<var: #matchTable type: #'unsigned char *'>
((interpreterProxy isBytes: (interpreterProxy stackValue: 0))
and: [(interpreterProxy isIntegerObject: (interpreterProxy stackValue: 1))
and: [(interpreterProxy isBytes: (interpreterProxy stackValue: 2))
and: [interpreterProxy isBytes: (interpreterProxy stackValue: 3)]]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
key := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 3).
body := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 2).
start := interpreterProxy integerValueOf: (interpreterProxy stackValue: 1).
matchTable := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 0).
(keySize := interpreterProxy sizeOfSTArrayFromCPrimitive: key) > 0 ifTrue:
[keySize := keySize - 1. "adjust for zero relative indxes"
(start max: 1) to: (interpreterProxy sizeOfSTArrayFromCPrimitive: body) - keySize do:
[ :startIndex | | index |
index := 0.
[(matchTable at: (body at: startIndex + index - 1)) = (matchTable at: (key at: index))] whileTrue:
[index = keySize ifTrue:
+ [^interpreterProxy methodReturnInteger: startIndex].
- [^interpreterProxy methodReturnValue: (interpreterProxy integerObjectOf: startIndex)].
index := index + 1]]].
+ ^interpreterProxy methodReturnInteger: 0!
- ^interpreterProxy methodReturnValue: (interpreterProxy integerObjectOf: 0)!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveIndexOfAsciiInString (in category 'primitives') -----
primitiveIndexOfAsciiInString
"ByteString indexOfAscii: anInteger inString: aString startingAt: start"
<export: true>
| anInteger aString start stringSize |
<var: #aString type: #'unsigned char *'>
((interpreterProxy isIntegerObject: (interpreterProxy stackValue: 0))
and: [(start := interpreterProxy integerValueOf: (interpreterProxy stackValue: 0)) >= 1
and: [(interpreterProxy isBytes: (interpreterProxy stackValue: 1))
and: [(interpreterProxy isIntegerObject: (interpreterProxy stackValue: 2))]]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
anInteger := interpreterProxy integerValueOf: (interpreterProxy stackValue: 2).
aString := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1).
stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
start - 1 to: stringSize - 1 do:
[ :pos |
(aString at: pos) = anInteger ifTrue:
+ [^interpreterProxy methodReturnInteger: pos + 1]].
+ ^interpreterProxy methodReturnInteger: 0!
- [^interpreterProxy methodReturnValue: (interpreterProxy integerObjectOf: pos + 1)]].
- ^interpreterProxy methodReturnValue: (interpreterProxy integerObjectOf: 0)!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveStringHash (in category 'primitives') -----
primitiveStringHash
"ByteArray (class) hashBytes: aByteArray startingWith: speciesHash"
<export: true>
| aByteArray speciesHash byteArraySize hash |
<var: 'aByteArray' type: #'unsigned char *'>
<var: 'speciesHash' type: #int>
((interpreterProxy isIntegerObject: (interpreterProxy stackValue: 0))
and: [interpreterProxy isBytes: (interpreterProxy stackValue: 1)]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aByteArray := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1).
speciesHash := interpreterProxy integerValueOf: (interpreterProxy stackValue: 0).
byteArraySize := interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray.
hash := speciesHash bitAnd: 16r0FFFFFFF.
0 to: byteArraySize - 1 do:
[ :pos |
hash := hash + (aByteArray at: pos).
hash := hash * 16r19660D bitAnd: 16r0FFFFFFF].
+ interpreterProxy methodReturnInteger: hash!
- interpreterProxy methodReturnValue:
- (interpreterProxy integerObjectOf: hash)!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>methodReturnBool: (in category 'simulation only') -----
+ methodReturnBool: boolean
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter methodReturnBool: boolean!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>methodReturnFloat: (in category 'simulation only') -----
+ methodReturnFloat: aFloat
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter methodReturnFloat: aFloat!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>methodReturnInteger: (in category 'simulation only') -----
+ methodReturnInteger: integer
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter methodReturnInteger: integer!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>methodReturnString: (in category 'simulation only') -----
+ methodReturnString: aCString
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter methodReturnString: aCString!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>methodReturnBool: (in category 'simulation only') -----
+ methodReturnBool: boolean
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter methodReturnBool: boolean!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>methodReturnFloat: (in category 'simulation only') -----
+ methodReturnFloat: aFloat
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter methodReturnFloat: aFloat!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>methodReturnInteger: (in category 'simulation only') -----
+ methodReturnInteger: integer
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter methodReturnInteger: integer!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>methodReturnString: (in category 'simulation only') -----
+ methodReturnString: aCString
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter methodReturnString: aCString!
Item was changed:
----- Method: ScratchPlugin>>primOpenPortNamed (in category 'serial port') -----
primOpenPortNamed
"Open the port with the given name and baud rate."
| nameStr src nameOop baudRate count portNum |
<export: true>
<var: 'nameStr' declareC: 'char nameStr[1000]'>
<var: 'src' type: #'char *'>
nameOop := interpreterProxy stackValue: 1.
baudRate := interpreterProxy stackIntegerValue: 0.
interpreterProxy success: (interpreterProxy isBytes: nameOop).
interpreterProxy failed ifTrue: [^ 0].
src := self cCoerce: (interpreterProxy firstIndexableField: nameOop) to: #'char *'.
count := interpreterProxy stSizeOf: nameOop.
0 to: count - 1 do: [:i | nameStr at: i put: (src at: i)].
nameStr at: count put: 0.
portNum := self SerialPortOpen: nameStr PortNamed: baudRate.
portNum = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ ^interpreterProxy methodReturnInteger: portNum!
- interpreterProxy "pop args and rcvr, push result"
- pop: 3
- thenPush: (interpreterProxy integerObjectOf: portNum).
-
- ^ 0
- !
Item was changed:
----- Method: ScratchPlugin>>primPortCount (in category 'serial port') -----
primPortCount
"Answer the number of serial ports."
| result |
<export: true>
+ result := self SerialPortCount.
- result := self cCode: 'SerialPortCount()'.
result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ ^interpreterProxy methodReturnInteger: result
- interpreterProxy
- pop: 1 thenPush: (interpreterProxy integerObjectOf: result). "pop rcvr, push result"
- ^ 0
!
Item was added:
+ ----- Method: SpurMemoryManager>>methodReturnBool: (in category 'simulation only') -----
+ methodReturnBool: boolean
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter methodReturnBool: boolean!
Item was added:
+ ----- Method: SpurMemoryManager>>methodReturnFloat: (in category 'simulation only') -----
+ methodReturnFloat: aFloat
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter methodReturnFloat: aFloat!
Item was added:
+ ----- Method: SpurMemoryManager>>methodReturnInteger: (in category 'simulation only') -----
+ methodReturnInteger: integer
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter methodReturnInteger: integer!
Item was added:
+ ----- Method: SpurMemoryManager>>methodReturnString: (in category 'simulation only') -----
+ methodReturnString: aCString
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter methodReturnString: aCString!
Item was changed:
----- Method: StackInterpreter>>floatArg: (in category 'plugin primitive support') -----
floatArg: index
"Like #stackFloatValue: but access method arguments left-to-right"
- | oop |
<returnTypeC: #double>
+ <doNotGenerate> "Obsolete; was never used; replaced with methodReturnString: in the VirtualMachine struct."
+ | oop |
+ self deprecated.
oop := self methodArg: index.
oop = 0 ifTrue:[^0.0]. "methodArg: failed"
^objectMemory floatValueOf: oop!
Item was changed:
----- Method: StackInterpreter>>integerArg: (in category 'plugin primitive support') -----
integerArg: index
"Like #stackIntegerValue: but access method arguments left-to-right"
+ <doNotGenerate> "Obsolete; was never used; replaced with methodReturnInteger: in the VirtualMachine struct."
| oop |
+ self deprecated.
oop := self methodArg: index.
oop = 0 ifTrue:[^0]. "methodArg: failed"
^self checkedIntegerValueOf: oop!
Item was changed:
----- Method: StackInterpreter>>methodArg: (in category 'plugin primitive support') -----
methodArg: index
"Like #stackValue: but access method arguments left-to-right"
+ <doNotGenerate> "Obsolete; was never used; replaced with methodReturnBool: in the VirtualMachine struct."
+ self deprecated.
+ index > argumentCount + 1 ifTrue:
+ [self cCode: 'fprintf(stderr,"[VM]: Attempt to access method args beyond range\n")'.
- index > argumentCount + 1 ifTrue:[
- self cCode: 'fprintf(stderr,"[VM]: Attempt to access method args beyond range\n")'.
self printCallStack.
self primitiveFail.
^0].
^self stackValue: argumentCount - index!
Item was added:
+ ----- Method: StackInterpreter>>methodReturnBool: (in category 'plugin primitive support') -----
+ methodReturnBool: boolean
+ "Sets the return value for a method. In the CoInterpreter we replace the cumbersome
+ primResult machinery."
+ self pop: argumentCount+1 thenPushBool: boolean.
+ ^0!
Item was added:
+ ----- Method: StackInterpreter>>methodReturnFloat: (in category 'plugin primitive support') -----
+ methodReturnFloat: aFloat
+ "Sets the return value for a method."
+ <var: 'aFloat' type: #double>
+ self pop: argumentCount+1 thenPushFloat: aFloat.
+ ^0!
Item was added:
+ ----- Method: StackInterpreter>>methodReturnInteger: (in category 'plugin primitive support') -----
+ methodReturnInteger: integer
+ "Sets the return value for a method. In the CoInterpreter we replace the cumbersome
+ primResult machinery."
+ self pop: argumentCount+1 thenPushInteger: integer.
+ ^0!
Item was added:
+ ----- Method: StackInterpreter>>methodReturnString: (in category 'plugin primitive support') -----
+ methodReturnString: aCString
+ "Sets the return value for a method."
+ <var: 'aCString' type: #'char *'>
+ self pop: argumentCount+1 thenPush: (objectMemory stringForCString: aCString).
+ ^0!
Item was changed:
----- Method: StackInterpreter>>objectArg: (in category 'plugin primitive support') -----
objectArg: index
"Like #stackObjectValue: but access method arguments left-to-right"
+ <doNotGenerate> "Obsolete; was never used; replaced with methodReturnFloat: in the VirtualMachine struct."
| oop |
+ self deprecated.
oop := self methodArg: index.
oop = 0 ifTrue:[^0]. "methodArg: failed"
(objectMemory isImmediate: oop) ifTrue: [self primitiveFail. ^ nil].
^oop!
Item was changed:
----- Method: UnicodePlugin>>primitiveClipboardGet (in category 'primitives') -----
primitiveClipboardGet
"Read the clipboard into the given UTF16 string.."
| utf16Oop utf16 utf16Length count |
<export: true>
<var: 'utf16' type: #'unsigned short *'>
utf16Oop := interpreterProxy stackValue: 0.
interpreterProxy success: (interpreterProxy isWords: utf16Oop).
interpreterProxy failed ifTrue: [^ 0].
utf16 := self cCoerce: (interpreterProxy firstIndexableField: utf16Oop) to: #'unsigned short *'.
utf16Length := 2 * (interpreterProxy stSizeOf: utf16Oop).
count := self unicodeClipboard: utf16 Get: utf16Length.
+ ^interpreterProxy methodReturnInteger: count!
- interpreterProxy pop: 2
- thenPush: (interpreterProxy integerObjectOf: count).
-
- ^ 0!
Item was changed:
----- Method: UnicodePlugin>>primitiveClipboardSize (in category 'primitives') -----
primitiveClipboardSize
- | count |
<export: true>
+ ^interpreterProxy methodReturnInteger: self unicodeClipboardSize!
-
- count := self cCode: 'unicodeClipboardSize()'.
-
- interpreterProxy pop: 1
- thenPush: (interpreterProxy integerObjectOf: count).
- ^ 0
- !
Item was changed:
----- Method: UnicodePlugin>>primitiveGetFontList (in category 'primitives') -----
primitiveGetFontList
+ | strOop str strLength |
- | strOop str strLength count |
<export: true>
<var: 'str' declareC: 'char *str'>
strOop := interpreterProxy stackValue: 0.
str := self asCString: strOop.
+ interpreterProxy failed ifFalse:
+ [strLength := interpreterProxy stSizeOf: strOop.
+ interpreterProxy methodReturnInteger: (self unicodeGetFont: str List: strLength)]!
- interpreterProxy failed ifTrue: [^ nil].
-
- strLength := interpreterProxy stSizeOf: strOop.
- count := self cCode: 'unicodeGetFontList(str, strLength)'.
-
- interpreterProxy pop: 2
- thenPush: (interpreterProxy integerObjectOf: count).
- ^ 0
- !
Item was changed:
----- Method: UnicodePlugin>>primitiveGetXRanges (in category 'primitives') -----
primitiveGetXRanges
| utf8Oop utf8 resultOop resultPtr utf8Length count resultLength |
<export: true>
<var: 'utf8' declareC: 'char *utf8'>
<var: 'resultPtr' declareC: 'int *resultPtr'>
utf8Oop := interpreterProxy stackValue: 1.
utf8 := self asCString: utf8Oop.
resultOop := interpreterProxy stackValue: 0.
resultPtr := self cWordsPtr: resultOop minSize: 0.
interpreterProxy failed ifTrue: [^ nil].
utf8Length := interpreterProxy stSizeOf: utf8Oop.
resultLength := interpreterProxy stSizeOf: resultOop.
+ count := self unicode: utf8 Get: utf8Length X: resultPtr Ranges: resultLength.
- count := self cCode: 'unicodeGetXRanges(utf8, utf8Length, resultPtr, resultLength)'.
+ ^interpreterProxy methodReturnInteger: count!
- interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: count).
- ^ 0
- !
More information about the Vm-dev
mailing list