[Vm-dev] VM Maker: VMMaker.oscog-eem.228.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Dec 11 21:58:40 UTC 2012
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.228.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.228
Author: eem
Time: 11 December 2012, 1:56:43.108 pm
UUID: d0ee0b3a-efb3-4092-a37d-b6dfd1036b49
Ancestors: VMMaker.oscog-eem.227
Change generation of plugin code so that internal plugins call VM
routines directly and external plugins call through their own local
copies of the function pointers in InterpreterProxy. External plugins
copy the InterpreterProxy functions to their local copies in
setInterpreter:.
Fix a couple of prims in BalloonEnginePlugin that had variables called
isArray which now clash with the funciton of the same name.
Add the ImmX11Plugin.
Change implementations of stObject:at:put: to return their value, to
match the declaration in InterpreterProxy.
Delete some obsolete code in SmartSyntaxPluginCodeGenerator
(emitLoad:asBooleanValueFrom:on: et al).
Add a class to test consistency between *Interpreter(Primitives)
implementations and InterpreterProxy implementations. These
differ because void result functions are still declared as sqInt result
functions in InterprerterProxy/struct VirtualMachine.
=============== Diff against VMMaker.oscog-eem.227 ===============
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddBezierShape (in category 'primitives') -----
primitiveAddBezierShape
+ | failureCode points lineFill lineWidth fillIndex length pointsIsArray segSize nSegments |
- | failureCode points lineFill lineWidth fillIndex length isArray segSize nSegments |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
lineFill := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
lineWidth := interpreterProxy stackIntegerValue: 1.
fillIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 2).
nSegments := interpreterProxy stackIntegerValue: 3.
points := interpreterProxy stackObjectValue: 4.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"First, do a check if the points look okay"
length := interpreterProxy slotSizeOf: points.
(interpreterProxy isWords: points) ifTrue:[
+ pointsIsArray := false.
- isArray := false.
"Either PointArray or ShortPointArray"
(length = (nSegments * 3) or:[length = (nSegments * 6)])
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
] ifFalse:["Must be Array of points"
(interpreterProxy isArray: points)
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
length = (nSegments * 3)
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ pointsIsArray := true.
- isArray := true.
].
"Now check that we have some hope to have enough free space.
Do this by assuming nPoints boundaries of maximum size,
hoping that most of the fills will be colors and many boundaries
will be line segments"
(lineWidth = 0 or:[lineFill = 0])
ifTrue:[segSize := GLBaseSize]
ifFalse:[segSize := GLWideSize].
(self needAvailableSpace: segSize * nSegments)
ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
"Check the fills"
((self isFillOkay: lineFill) and:[self isFillOkay: fillIndex])
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
"Transform colors"
lineFill := self transformColor: lineFill.
fillIndex := self transformColor: fillIndex.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
"Check if have anything at all to do"
((lineFill = 0 or:[lineWidth = 0]) and:[fillIndex = 0])
ifTrue:[^interpreterProxy pop: 5].
"Transform the lineWidth"
lineWidth = 0 ifFalse:[
lineWidth := self transformWidth: lineWidth.
lineWidth < 1 ifTrue:[lineWidth := 1]].
"And load the actual shape"
+ pointsIsArray ifTrue:[
- isArray ifTrue:[
self loadArrayShape: points nSegments: nSegments
fill: fillIndex lineWidth: lineWidth lineFill: lineFill.
] ifFalse:[
self loadShape: (interpreterProxy firstIndexableField: points) nSegments: nSegments
fill: fillIndex lineWidth: lineWidth lineFill: lineFill
pointsShort: (nSegments * 3 = length)].
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self needsFlushPut: 1.
self storeEngineStateInto: engine.
interpreterProxy pop: 5. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddPolygon (in category 'primitives') -----
primitiveAddPolygon
+ | failureCode points lineFill lineWidth fillIndex nPoints length pointsIsArray segSize |
- | failureCode points lineFill lineWidth fillIndex nPoints length isArray segSize |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
lineFill := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
lineWidth := interpreterProxy stackIntegerValue: 1.
fillIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 2).
nPoints := interpreterProxy stackIntegerValue: 3.
points := interpreterProxy stackObjectValue: 4.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"First, do a check if the points look okay"
length := interpreterProxy slotSizeOf: points.
(interpreterProxy isWords: points) ifTrue:[
+ pointsIsArray := false.
- isArray := false.
"Either PointArray or ShortPointArray"
(length = nPoints or:[nPoints * 2 = length])
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
] ifFalse:["Must be Array of points"
(interpreterProxy isArray: points)
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
length = nPoints
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ pointsIsArray := true.
- isArray := true.
].
"Now check that we have some hope to have enough free space.
Do this by assuming nPoints boundaries of maximum size,
hoping that most of the fills will be colors and many boundaries
will be line segments"
(lineWidth = 0 or:[lineFill = 0])
ifTrue:[segSize := GLBaseSize]
ifFalse:[segSize := GLWideSize].
(self needAvailableSpace: segSize * nPoints)
ifFalse:[^interpreterProxy primitiveFail].
"Check the fills"
((self isFillOkay: lineFill) and:[self isFillOkay: fillIndex])
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
"Transform colors"
lineFill := self transformColor: lineFill.
fillIndex := self transformColor: fillIndex.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
"Check if have anything at all to do"
((lineFill = 0 or:[lineWidth = 0]) and:[fillIndex = 0])
ifTrue:[^interpreterProxy pop: 5].
"Transform the lineWidth"
lineWidth = 0 ifFalse:[lineWidth := self transformWidth: lineWidth].
"And load the actual polygon"
+ pointsIsArray ifTrue:[
- isArray ifTrue:[
self loadArrayPolygon: points nPoints: nPoints
fill: fillIndex lineWidth: lineWidth lineFill: lineFill
] ifFalse:[
self loadPolygon: (interpreterProxy firstIndexableField: points) nPoints: nPoints
fill: fillIndex lineWidth: lineWidth lineFill: lineFill
pointsShort: (nPoints = length)].
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self needsFlushPut: 1.
self storeEngineStateInto: engine.
interpreterProxy pop: 5. "Leave rcvr on stack"!
Item was changed:
----- Method: CCodeGenerator>>emitCVariablesOn: (in category 'C code generator') -----
emitCVariablesOn: aStream
"Store the global variable declarations on the given stream."
aStream cr; nextPutAll: '/*** Variables ***/'; cr.
(self sortStrings: variables) do:
[:var | | varString decl |
varString := var asString.
decl := variableDeclarations at: varString ifAbsent: ['sqInt ' , varString].
decl first == $# "support cgen var: #bytecodeSetSelector declareC: '#define bytecodeSetSelector 0' hack"
ifTrue:
[aStream nextPutAll: decl; cr]
ifFalse:
[self isGeneratingPluginCode
ifTrue:
[varString = 'interpreterProxy'
+ ifTrue: "quite special..."
+ [self preDeclareInterpreterProxyOn: aStream]
- ifTrue: ["quite special..."
- aStream cr; nextPutAll: '#ifdef SQUEAK_BUILTIN_PLUGIN'.
- aStream cr; nextPutAll: 'extern'.
- aStream cr; nextPutAll: '#endif'; cr]
ifFalse: [(decl beginsWith: 'static') ifFalse:
[aStream nextPutAll: 'static ']]]
ifFalse:
[(vmClass mustBeGlobal: varString) ifFalse:
[(decl beginsWith: 'static') ifFalse:
[aStream nextPutAll: 'static ']]].
aStream
nextPutAll: decl;
nextPut: $;;
cr]].
aStream cr!
Item was added:
+ ----- Method: CCodeGenerator>>preDeclareInterpreterProxyOn: (in category 'C code generator') -----
+ preDeclareInterpreterProxyOn: aStream
+ "Put the necessary #defines needed before interpreterProxy. Basically
+ internal plugins use the VM's interpreterProxy variable and external plugins use
+ their own. In addition the VMPluginCodeGenerator can choose to keep local copies
+ all functions."
+ aStream cr; nextPutAll: '#ifdef SQUEAK_BUILTIN_PLUGIN'.
+ aStream cr; nextPutAll: 'extern'.
+ aStream cr; nextPutAll: '#endif'; cr!
Item was changed:
----- Method: CCodeGeneratorGlobalStructure>>emitCVariablesOn: (in category 'C code generator') -----
emitCVariablesOn: aStream
"Store the global variable declarations on the given stream.
Break logic into vars for structure and vars for non-structure."
| structure nonstruct |
structure := WriteStream on: (String new: 32768).
nonstruct := WriteStream on: (String new: 32768).
aStream nextPutAll: '/*** Variables ***/'; cr.
structure
nextPutAll: '#if SQ_USE_GLOBAL_STRUCT'; cr;
nextPutAll: '# define _iss /* define in-struct static as void */'; cr;
nextPutAll: 'static struct foo {'; cr;
nextPutAll: '#else'; cr;
nextPutAll: '# define _iss static'; cr;
nextPutAll: '#endif'; cr.
self buildSortedVariablesCollection do:
[ :var | | decl varString inStruct target |
target := (inStruct := self placeInStructure: (varString := var asString))
ifTrue: [structure]
ifFalse: [nonstruct].
decl := variableDeclarations at: varString ifAbsent: ['sqInt ' , varString].
decl first == $# "support cgen var: #bytecodeSetSelector declareC: '#define bytecodeSetSelector 0' hack"
ifTrue:
[target nextPutAll: decl; cr]
ifFalse:
[self isGeneratingPluginCode
ifTrue:
[varString = 'interpreterProxy'
+ ifTrue: "quite special..."
+ [self preDeclareInterpreterProxyOn: target]
- ifTrue: ["quite special..."
- target cr; nextPutAll: '#ifdef SQUEAK_BUILTIN_PLUGIN'.
- target cr; nextPutAll: 'extern'.
- target cr; nextPutAll: '#endif'; cr]
ifFalse: [target nextPutAll: 'static ']]
ifFalse:
[(vmClass mustBeGlobal: varString) ifFalse:
[target nextPutAll: (inStruct ifTrue: ['_iss '] ifFalse: ['static '])]].
target nextPutAll: decl; nextPut: $;; cr]].
structure
nextPutAll: '#undef _iss'; cr;
nextPutAll: '#if SQ_USE_GLOBAL_STRUCT'; cr;
nextPutAll: ' } fum;'; cr;
nextPutAll: '# define DECL_MAYBE_SQ_GLOBAL_STRUCT register struct foo * foo = &fum;'; cr;
nextPutAll: '# define DECL_MAYBE_VOLATILE_SQ_GLOBAL_STRUCT volatile register struct foo * foo = &fum;'; cr;
nextPutAll: '# define GIV(interpreterInstVar) (foo->interpreterInstVar)'; cr;
nextPutAll: '#else'; cr;
nextPutAll: '# define DECL_MAYBE_SQ_GLOBAL_STRUCT /* oh, no mr bill!! */'; cr;
nextPutAll: '# define DECL_MAYBE_VOLATILE_SQ_GLOBAL_STRUCT /* oh no, mr bill!! */'; cr;
nextPutAll: '# define GIV(interpreterInstVar) interpreterInstVar'; cr;
nextPutAll: '#endif'; cr.
"if the machine needs the fum structure defining locally, do it now"
localStructDef ifTrue:
[structure
nextPutAll: '#if SQ_USE_GLOBAL_STRUCT'; cr;
nextPutAll: 'static struct foo * foo = &fum;'; cr;
nextPutAll: '#endif'; cr].
aStream
nextPutAll: structure contents;
nextPutAll: nonstruct contents;
cr!
Item was changed:
----- Method: IA32ABIPlugin>>primCallOutDoubleReturn (in category 'primitives-callouts') -----
primCallOutDoubleReturn
"Call a foreign function that answers a double-precision floating-point result in %f0
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien>
<primitive: 'primCallOutDoubleReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| errCode mac result |
<export: true>
mac := interpreterProxy methodArgumentCount.
self cppIf: STACKVM
ifTrue: "In the STACKVM stacks grow down"
+ [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg"
+ IA32: 1 - mac "nargs negated to imply stack direction"
+ Double: mac "funcOffset"
+ Return: mac - 1 "resultOffset"]
- [self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */
- 1 - mac /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]]
ifFalse:
+ [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg"
+ IA32: mac - 1 "nargs"
+ Double: mac "funcOffset"
+ Return: mac - 1 "resultOffset"].
- [self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */
- mac - 1 /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: mac - 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: IA32ABIPlugin>>primCallOutFloatReturn (in category 'primitives-callouts') -----
primCallOutFloatReturn
"Call a foreign function that answers a single-precision floating-point result in %f0
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien>
<primitive: 'primCallOutFloatReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| errCode mac result |
<export: true>
mac := interpreterProxy methodArgumentCount.
self cppIf: STACKVM
ifTrue: "In the STACKVM stacks grow down"
+ [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg"
+ IA32: 1 - mac "nargs negated to imply stack direction"
+ Float: mac "funcOffset"
+ Return: mac - 1 "resultOffset"]
- [self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */
- 1 - mac /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]]
ifFalse:
+ [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg"
+ IA32: mac - 1 "nargs"
+ Float: mac "funcOffset"
+ Return: mac - 1 "resultOffset"].
- [self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */
- mac - 1 /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: mac - 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: IA32ABIPlugin>>primCallOutIntegralReturn (in category 'primitives-callouts') -----
primCallOutIntegralReturn
"Call a foreign function that answers an integral result in %eax (and possibly %edx)
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien>
<primitive: 'primCallOutIntegralReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| errCode mac result |
<export: true>
mac := interpreterProxy methodArgumentCount.
self cppIf: STACKVM
ifTrue: "In the STACKVM stacks grow down"
+ [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg"
+ IA32: 1 - mac "nargs negated to imply stack direction"
+ Integral: mac "funcOffset"
+ Return: mac - 1 "resultOffset"]
- [self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */
- 1 - mac /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]]
ifFalse:
+ [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg"
+ IA32: mac - 1 "nargs"
+ Integral: mac "funcOffset"
+ Return: mac - 1 "resultOffset"].
- [self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */
- mac - 1 /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: mac - 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: IA32ABIPlugin>>primVarArgsCallOutDoubleReturn (in category 'primitives-callouts') -----
primVarArgsCallOutDoubleReturn
"Call a foreign function that answers a double-precision floating-point result in %f0
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien>
<primitive: 'primVarArgsCallOutDoubleReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| array mac errCode result |
<export: true>
array := interpreterProxy stackValue: 0.
(interpreterProxy isArray: array) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
mac := interpreterProxy methodArgumentCount.
+ errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg"
+ IA32: (interpreterProxy stSizeOf: array) "nargs"
+ Double: 2 "func stackValue"
+ Return: 1. "result stackValue"
- self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->firstIndexableField(array), /* arg vec */
- interpreterProxy->stSizeOf(array) /* nargs */,
- 2 /* funcOffset*/,
- 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: IA32ABIPlugin>>primVarArgsCallOutFloatReturn (in category 'primitives-callouts') -----
primVarArgsCallOutFloatReturn
"Call a foreign function that answers a single-precision floating-point result in %f0
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien>
<primitive: 'primVarArgsCallOutFloatReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| array mac errCode result |
<export: true>
array := interpreterProxy stackValue: 0.
(interpreterProxy isArray: array) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
mac := interpreterProxy methodArgumentCount.
+ errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg"
+ IA32: (interpreterProxy stSizeOf: array) "nargs"
+ Float: 2 "func stackValue"
+ Return: 1. "result stackValue"
- self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->firstIndexableField(array), /* arg vec */
- interpreterProxy->stSizeOf(array) /* nargs */,
- 2 /* funcOffset*/,
- 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: IA32ABIPlugin>>primVarArgsCallOutIntegralReturn (in category 'primitives-callouts') -----
primVarArgsCallOutIntegralReturn
"Call a foreign function that answers an integral result in %eax (and possibly %edx)
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien>
<primitive: 'primVarArgsCallOutIntegralReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| array mac errCode result |
<export: true>
array := interpreterProxy stackValue: 0.
(interpreterProxy isArray: array) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
mac := interpreterProxy methodArgumentCount.
+ errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg"
+ IA32: (interpreterProxy stSizeOf: array) "nargs"
+ Integral: 2 "func stackValue"
+ Return: 1. "result stackValue"
- self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->firstIndexableField(array), /* arg vec */
- interpreterProxy->stSizeOf(array) /* nargs */,
- 2 /* funcOffset*/,
- 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: IA32ABIPlugin>>setInterpreter: (in category 'initialize') -----
setInterpreter: anInterpreter
"Note: This is coded so that is can be run from Squeak."
| ok |
<export: true>
<var: #anInterpreter type: #'struct VirtualMachine*'>
interpreterProxy := anInterpreter.
ok := interpreterProxy majorVersion = 1
and: [interpreterProxy minorVersion >= 12].
+ ok ifTrue:
+ [self expandDereferenceInterpreterProxyFunctionTable].
^ok!
Item was added:
+ SmartSyntaxInterpreterPlugin subclass: #ImmX11Plugin
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
Item was added:
+ ----- Method: ImmX11Plugin class>>declareHeaderFilesIn: (in category 'as yet unclassified') -----
+ declareHeaderFilesIn: cg
+
+ cg addHeaderFile: '<locale.h>'.
+ cg addHeaderFile: '"sqUnixMain.h"'.
+ cg addHeaderFile: '"sqUnixCharConv.h"', Character cr asString,
+ 'extern char *setLocale(char *, size_t);', Character cr asString,
+ 'extern int setCompositionWindowPosition(int, int);', Character cr asString,
+ 'extern int setCompostionFocus(int);'.!
Item was added:
+ ----- Method: ImmX11Plugin>>initialiseModule (in category 'initialize-release') -----
+ initialiseModule
+
+ <export: true>
+ ^ true
+ !
Item was added:
+ ----- Method: ImmX11Plugin>>primGetEncoding (in category 'primitives') -----
+ primGetEncoding
+
+ | ret array len |
+
+ <export: true>
+ <var: #len type: 'int'>
+ <var: #array type: 'char *'>
+ len := self cCode: 'strlen(sqTextEncoding)'.
+
+ ret := interpreterProxy
+ instantiateClass: interpreterProxy classString
+ indexableSize: len.
+ array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'.
+ self cCode: 'strncpy(array, (char *)sqTextEncoding, len)'.
+
+ ^ ret.!
Item was added:
+ ----- Method: ImmX11Plugin>>primGetLocale (in category 'primitives') -----
+ primGetLocale
+
+ | ret array len locale |
+
+ <export: true>
+ <var: #len type: 'int'>
+ <var: #array type: 'char *'>
+ <var: #locale type: 'char *'>
+
+ locale := self cCode: 'setlocale(LC_CTYPE, "")'.
+ (self cCode: 'locale')
+ ifFalse: [ ret := interpreterProxy nilObject ]
+ ifTrue: [
+ len := self cCode: 'strlen(locale)'.
+ ret := interpreterProxy
+ instantiateClass: interpreterProxy classString
+ indexableSize: len.
+ array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'.
+ self cCode: 'strncpy(array, (char *)locale, len)'.
+ ].
+ ^ ret.!
Item was added:
+ ----- Method: ImmX11Plugin>>primGetLocaleEncoding (in category 'primitives') -----
+ primGetLocaleEncoding
+
+ | ret array len |
+
+ <export: true>
+ <var: #len type: 'int'>
+ <var: #array type: 'char *'>
+
+ (self cCode: '(int) localeEncoding')
+ ifFalse: [ ret := interpreterProxy nilObject ]
+ ifTrue: [
+ len := self cCode: 'strlen(localeEncoding)'.
+ ret := interpreterProxy
+ instantiateClass: interpreterProxy classString
+ indexableSize: len.
+ array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'.
+ self cCode: 'strncpy(array, (char *)localeEncoding, len)'.
+ ].
+ ^ ret.!
Item was added:
+ ----- Method: ImmX11Plugin>>primGetPathEnc (in category 'primitives') -----
+ primGetPathEnc
+
+ | ret array len |
+
+ <export: true>
+ <var: #len type: 'int'>
+ <var: #array type: 'char *'>
+ len := self cCode: 'strlen(uxPathEncoding)'.
+
+ ret := interpreterProxy
+ instantiateClass: interpreterProxy classString
+ indexableSize: len.
+ array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'.
+ self cCode: 'strncpy(array, (char *)uxPathEncoding, len)'.
+
+ ^ ret.!
Item was added:
+ ----- Method: ImmX11Plugin>>primGetTextEnc (in category 'primitives') -----
+ primGetTextEnc
+
+ | ret array len |
+
+ <export: true>
+ <var: #len type: 'int'>
+ <var: #array type: 'char *'>
+ len := self cCode: 'strlen(uxTextEncoding)'.
+
+ ret := interpreterProxy
+ instantiateClass: interpreterProxy classString
+ indexableSize: len.
+ array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'.
+ self cCode: 'strncpy(array, (char *)uxTextEncoding, len)'.
+
+ ^ ret.!
Item was added:
+ ----- Method: ImmX11Plugin>>primGetXWinEnc (in category 'primitives') -----
+ primGetXWinEnc
+
+ | ret array len |
+
+ <export: true>
+ <var: #len type: 'int'>
+ <var: #array type: 'char *'>
+ len := self cCode: 'strlen(uxXWinEncoding)'.
+
+ ret := interpreterProxy
+ instantiateClass: interpreterProxy classString
+ indexableSize: len.
+ array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'.
+ self cCode: 'strncpy(array, (char *)uxXWinEncoding, len)'.
+
+ ^ ret.!
Item was added:
+ ----- Method: ImmX11Plugin>>primIsTextEncUTF8 (in category 'primitives') -----
+ primIsTextEncUTF8
+
+ <export: true>
+ self primitive: 'primIsTextEncUTF8'.
+ ^ (self cCode: 'textEncodingUTF8') asOop: Boolean.!
Item was added:
+ ----- Method: ImmX11Plugin>>primSetCompositionFocus: (in category 'primitives') -----
+ primSetCompositionFocus: bool
+
+ | ret |
+ <export: true>
+ self primitive: 'primSetCompositionFocus'
+ parameters: #(Boolean).
+
+ ret := self cCode: 'setCompositionFocus(bool)'.
+
+ ret = false ifTrue: [
+ interpreterProxy primitiveFail.
+ ^ nil
+ ].
+
+ ^ ret asOop: Boolean
+ !
Item was added:
+ ----- Method: ImmX11Plugin>>primSetCompositionWindowPositionX:y: (in category 'primitives') -----
+ primSetCompositionWindowPositionX: x y: y
+
+ | ret |
+
+ <export: true>
+ self primitive: 'primSetCompositionWindowPosition'
+ parameters: #(SmallInteger SmallInteger).
+
+
+ ret := self cCode: 'setCompositionWindowPosition(x, y)'.
+
+ ret = false ifTrue: [
+ interpreterProxy primitiveFail.
+ ^ nil
+ ].
+
+ ^ ret asOop: Boolean
+
+ !
Item was added:
+ ----- Method: ImmX11Plugin>>primSetEncoding: (in category 'primitives') -----
+ primSetEncoding: encoding
+
+ | name len |
+ <export: true>
+ <var: #name type: 'char *'>
+ <var: #len type: 'size_t'>
+ len := interpreterProxy stSizeOf: encoding.
+ name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'.
+ self cCode: 'setNEncoding(&sqTextEncoding, name, len)'.
+ ^ encoding.
+ !
Item was added:
+ ----- Method: ImmX11Plugin>>primSetEncodingToLocale (in category 'primitives') -----
+ primSetEncodingToLocale
+
+ | ret |
+ <export: true>
+ self primitive: 'primSetEncodingToLocale'.
+
+ (self cCode: '(int) localeEncoding')
+ ifFalse: [ ret := interpreterProxy falseObject ]
+ ifTrue: [
+ self cCode: 'sqTextEncoding = (void *)localeEncoding'.
+ ret := interpreterProxy trueObject
+ ].
+ ^ ret!
Item was added:
+ ----- Method: ImmX11Plugin>>primSetLocale: (in category 'primitives') -----
+ primSetLocale: locale
+
+ | name len ret array |
+ <export: true>
+ <var: #name type: 'char *'>
+ <var: #array type: 'char *'>
+ <var: #len type: 'size_t'>
+ len := interpreterProxy stSizeOf: locale.
+ name := self cCoerce: (interpreterProxy arrayValueOf: locale) to: 'char *'.
+ name := self cCode: 'setLocale(name, len)'.
+ (self cCode: '(int) name')
+ ifFalse: [^ interpreterProxy nilObject ]
+ ifTrue: [
+ len := self cCode: 'strlen(name)'.
+ ret := interpreterProxy
+ instantiateClass: interpreterProxy classString
+ indexableSize: len.
+ array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'.
+ self cCode: 'strncpy(array, (char *)name, len)'.
+ ^ ret ].
+ !
Item was added:
+ ----- Method: ImmX11Plugin>>primSetLocaleEncoding: (in category 'primitives') -----
+ primSetLocaleEncoding: encoding
+
+ | name len |
+ <export: true>
+ <var: #name type: 'char *'>
+ <var: #len type: 'size_t'>
+ len := interpreterProxy stSizeOf: encoding.
+ name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'.
+ self cCode: 'setNEncoding(&localeEncoding, name, len)'.
+ self cCode: 'sqTextEncoding= uxTextEncoding= uxPathEncoding= uxXWinEncoding= localeEncoding'.
+ ^ encoding.
+ !
Item was added:
+ ----- Method: ImmX11Plugin>>primSetPathEnc: (in category 'primitives') -----
+ primSetPathEnc: encoding
+
+ | name len |
+ <export: true>
+ <var: #name type: 'char *'>
+ <var: #len type: 'size_t'>
+ len := interpreterProxy stSizeOf: encoding.
+ name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'.
+ self cCode: 'setNEncoding(&uxPathEncoding, name, len)'.
+ ^ encoding.!
Item was added:
+ ----- Method: ImmX11Plugin>>primSetPathEncToLocale (in category 'primitives') -----
+ primSetPathEncToLocale
+
+ | ret |
+ <export: true>
+ self primitive: 'primSetPathEncToLocale'.
+
+ (self cCode: '(int) localeEncoding')
+ ifFalse: [ ret := interpreterProxy falseObject ]
+ ifTrue: [
+ self cCode: 'uxPathEncoding = (void *)localeEncoding'.
+ ret := interpreterProxy trueObject
+ ].
+ ^ ret!
Item was added:
+ ----- Method: ImmX11Plugin>>primSetTextEnc: (in category 'primitives') -----
+ primSetTextEnc: encoding
+
+ | name len |
+ <export: true>
+ <var: #name type: 'char *'>
+ <var: #len type: 'size_t'>
+ len := interpreterProxy stSizeOf: encoding.
+ name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'.
+ self cCode: 'setNEncoding(&uxTextEncoding, name, len)'.
+ ^ encoding.!
Item was added:
+ ----- Method: ImmX11Plugin>>primSetTextEncToLocale (in category 'primitives') -----
+ primSetTextEncToLocale
+
+ | ret |
+ <export: true>
+ self primitive: 'primSetTextEncToLocale'.
+
+ (self cCode: '(int) localeEncoding')
+ ifFalse: [ ret := interpreterProxy falseObject ]
+ ifTrue: [
+ self cCode: 'uxTextEncoding = (void *)localeEncoding'.
+ ret := interpreterProxy trueObject
+ ].
+ ^ ret!
Item was added:
+ ----- Method: ImmX11Plugin>>primSetTextEncUTF8: (in category 'primitives') -----
+ primSetTextEncUTF8: bool
+
+ <export: true>
+ self primitive: 'primSetTextEncUTF8'
+ parameters: #(Boolean).
+ self cCode: 'textEncodingUTF8 = bool'.
+ ^ bool asOop: Boolean.!
Item was added:
+ ----- Method: ImmX11Plugin>>primSetXWinEnc: (in category 'primitives') -----
+ primSetXWinEnc: encoding
+
+ | name len |
+ <export: true>
+ <var: #name type: 'char *'>
+ <var: #len type: 'size_t'>
+ len := interpreterProxy stSizeOf: encoding.
+ name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'.
+ self cCode: 'setNEncoding(&uxXWinEncoding, name, len)'.
+ ^ encoding.!
Item was added:
+ ----- Method: ImmX11Plugin>>primSetXWinEncToLocale (in category 'primitives') -----
+ primSetXWinEncToLocale
+
+ | ret |
+ <export: true>
+ self primitive: 'primSetXWinEncToLocale'.
+
+ (self cCode: '(int) localeEncoding')
+ ifFalse: [ ret := interpreterProxy falseObject ]
+ ifTrue: [
+ self cCode: 'uxXWinEncoding = (void *)localeEncoding'.
+ ret := interpreterProxy trueObject
+ ].
+ ^ ret!
Item was added:
+ ----- Method: ImmX11Plugin>>shutdownModule (in category 'initialize-release') -----
+ shutdownModule
+
+ <export: true>
+ ^ true
+ !
Item was changed:
----- Method: Interpreter>>stObject:at:put: (in category 'array primitive support') -----
stObject: array at: index put: value
"Do what ST would return for <obj> at: index put: value."
| hdr fmt totalLength fixedFields stSize |
<inline: false>
hdr := self baseHeader: array.
fmt := (hdr >> 8) bitAnd: 16rF.
totalLength := self lengthOf: array baseHeader: hdr format: fmt.
fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
(fmt = 3 and: [self isContextHeader: hdr])
ifTrue: [stSize := self fetchStackPointerOf: array]
ifFalse: [stSize := totalLength - fixedFields].
((self oop: index isGreaterThanOrEqualTo: 1)
and: [self oop: index isLessThanOrEqualTo: stSize])
ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
+ ifFalse: [successFlag := false].
+ ^value!
- ifFalse: [successFlag := false]!
Item was added:
+ ----- Method: InterpreterPlugin>>expandDereferenceInterpreterProxyFunctionTable (in category 'initialize') -----
+ expandDereferenceInterpreterProxyFunctionTable
+ "This is a dummy funciton that the VMPluginCodeGenerator expands into a
+ sequence of assignments from interpreterProxy funcitons to local function pointers."!
Item was added:
+ ----- Method: InterpreterPlugin>>majorVersion (in category 'simulation support') -----
+ majorVersion
+ "This is implemented in sqVirtualMachine.c, so this form is for simulation only."
+ <doNotGenerate>
+ ^1!
Item was added:
+ ----- Method: InterpreterPlugin>>minorVersion (in category 'simulation support') -----
+ minorVersion
+ "This is implemented in sqVirtualMachine.c, so this form is for simulation only."
+ <doNotGenerate>
+ ^8!
Item was changed:
----- Method: InterpreterPlugin>>setInterpreter: (in category 'initialize') -----
setInterpreter: anInterpreter
+ "Note: This is coded so that it can be run in Squeak."
- "Note: This is coded so that is can be run from Squeak."
| ok |
<export: true>
<var: #anInterpreter type: #'struct VirtualMachine*'>
interpreterProxy := anInterpreter.
+ ok := interpreterProxy majorVersion = (self cCode: 'VM_PROXY_MAJOR' inSmalltalk: [self majorVersion])
+ and: [interpreterProxy minorVersion >= (self cCode: 'VM_PROXY_MINOR' inSmalltalk: [self minorVersion])].
+ ok ifTrue:
+ [self expandDereferenceInterpreterProxyFunctionTable].
+ ^ok!
- ok := self cCode: 'interpreterProxy->majorVersion() == VM_PROXY_MAJOR'.
- ok == false ifTrue: [^ false].
- ok := self cCode: 'interpreterProxy->minorVersion() >= VM_PROXY_MINOR'.
- ^ ok!
Item was added:
+ ----- Method: InterpreterProxy class>>implicitReturnTypeFor: (in category 'translation') -----
+ implicitReturnTypeFor: aSelector
+ "Answer the return type for methods that don't have an explicit return."
+ ^#sqInt!
Item was added:
+ ----- Method: InterpreterProxy>>disownVM: (in category 'FFI support') -----
+ disownVM: flags
+ self error: 'not yet implemented in Smalltalk'!
Item was added:
+ ----- Method: InterpreterProxy>>getInterruptPending (in category 'other') -----
+ getInterruptPending
+ self error: 'not yet implemented in Smalltalk'!
Item was changed:
----- Method: InterpreterProxy>>getStackPointer (in category 'other') -----
getStackPointer
+ <returnTypeC: #'sqInt *'>
self error: 'not yet implemented in Smalltalk'!
Item was changed:
----- Method: InterpreterProxy>>ioFilename:fromString:ofLength:resolveAliases: (in category 'converting') -----
ioFilename: aCharBuffer fromString: aFilenameString ofLength: filenameLength resolveAliases: aBoolean
+ <var: #aCharBuffer type: #'char *'>
+ <var: #aFilenameString type: #'char *'>
"the vm has to convert aFilenameString via any canonicalization and char-mapping and put the result in aCharBuffer. This doesn't translate well in Smalltalk since we know how long strings are rather than considering them terminated by a 0 char. Do the best we can.
Note the resolveAliases flag - this is an awful artefact of OSX and Apples demented alias handling. When opening a file, the flag must be true, when closing or renaming it must be false. Sigh."
aCharBuffer replaceFrom:1 to: filenameLength with: aFilenameString!
Item was changed:
----- Method: InterpreterProxy>>ioLoadFunction:From: (in category 'FFI support') -----
ioLoadFunction: functionName From: moduleName
+ <returnTypeC: #'void *'>
+ <var: #functionName type: #'char *'>
+ <var: #moduleName type: #'char *'>
"Dummy - provided by support code"
^0!
Item was changed:
----- Method: InterpreterProxy>>ioLoadModule:OfLength: (in category 'FFI support') -----
ioLoadModule: moduleNameIndex OfLength: moduleLength
+ <returnTypeC: #'void *'>
"Dummy - provided by support code"
^0!
Item was changed:
----- Method: InterpreterProxy>>ioLoadSymbol:OfLength:FromModule: (in category 'FFI support') -----
ioLoadSymbol: functionNameIndex OfLength: functionLength FromModule: moduleHandle
+ <returnTypeC: #'void *'>
"Dummy - provided by support code"
^0!
Item was added:
+ ----- Method: InterpreterProxy>>isYoung: (in category 'FFI support') -----
+ isYoung: anOop
+ self error: 'not yet implemented in Smalltalk'!
Item was added:
+ ----- Method: InterpreterProxy>>ownVM: (in category 'FFI support') -----
+ ownVM: flags
+ self error: 'not yet implemented in Smalltalk'!
Item was changed:
----- Method: InterpreterProxy>>positive64BitIntegerFor: (in category 'converting') -----
positive64BitIntegerFor: integerValue
+ <var: 'integerValue' type: #sqLong>
integerValue isInteger ifFalse:[self error:'Not an Integer object'].
^integerValue > 0
ifTrue:[integerValue]
ifFalse:[ (1 bitShift: 64) + integerValue]!
Item was changed:
----- Method: InterpreterProxy>>positive64BitValueOf: (in category 'converting') -----
positive64BitValueOf: oop
+ <returnTypeC: #sqLong>
oop isInteger ifFalse:[self error:'Not an integer object'].
oop < 0
ifTrue:[self primitiveFail. ^0]
ifFalse:[^oop]!
Item was changed:
----- Method: InterpreterProxy>>positiveMachineIntegerValueOf: (in category 'converting') -----
positiveMachineIntegerValueOf: oop
+ <returnTypeC: #'unsigned long'>
oop isInteger ifFalse:[self error: 'Not an integer object'].
^oop < 0
ifTrue: [self primitiveFail. 0]
ifFalse: [oop]!
Item was changed:
----- Method: InterpreterProxy>>returnAs:ThroughCallback:Context: (in category 'callback support') -----
returnAs: returnTypeOop ThroughCallback: vmCallbackContext Context: callbackMethodContext
+ <var: #vmCallbackContext type: #'VMCallbackContext *'>
"callbackMethodContext is an activation of invokeCallback:[stack:registers:jmpbuf:].
Its sender is the VM's state prior to the callback. Reestablish that state (via longjmp),
and mark callbackMethodContext as dead."
self notYetImplemented!
Item was changed:
----- Method: InterpreterProxy>>sendInvokeCallbackContext: (in category 'callback support') -----
sendInvokeCallbackContext: vmCallbackContext
+ <var: #vmCallbackContext type: #'VMCallbackContext *'>
"Send the calllback message to Alien class with the supplied arg(s). Use either the
1 arg invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf:
message, depending on what selector is installed in the specialObjectsArray.
Note that if invoking the legacy invokeCallback:stack:registers:jmpbuf: we pass the
vmCallbackContext as the jmpbuf argument (see reestablishContextPriorToCallback:).
The arguments are raw C addresses and are converted to integer objects on the way."
self notYetImplemented!
Item was changed:
----- Method: InterpreterProxy>>setInterruptCheckChain: (in category 'other') -----
setInterruptCheckChain: aFunction
+ <returnTypeC: 'void (*setInterruptCheckChain(void (*aFunction)(void)))()'>
+ <var: #aFunction declareC: 'void (*aFunction)()'>
self error: 'not yet implemented in Smalltalk'!
Item was added:
+ ----- Method: InterpreterProxy>>signalNoResume: (in category 'callback support') -----
+ signalNoResume: aSemaphore
+ self error: 'not yet implemented in Smalltalk'!
Item was changed:
----- Method: InterpreterProxy>>signed32BitValueOf: (in category 'converting') -----
signed32BitValueOf: oop
+ <returnTypeC: #int>
oop isInteger ifFalse:[self error:'Not an integer object'].
^oop!
Item was changed:
----- Method: InterpreterProxy>>signed64BitIntegerFor: (in category 'converting') -----
signed64BitIntegerFor: integerValue
+ <var: 'integerValue' type: #sqLong>
integerValue isInteger ifFalse:[self error:'Not an Integer object'].
^integerValue!
Item was changed:
----- Method: InterpreterProxy>>signed64BitValueOf: (in category 'converting') -----
signed64BitValueOf: oop
+ <returnTypeC: #sqLong>
oop isInteger ifFalse:[self error:'Not an integer object'].
^oop!
Item was changed:
----- Method: InterpreterProxy>>signedMachineIntegerValueOf: (in category 'converting') -----
signedMachineIntegerValueOf: oop
+ <returnTypeC: #'long'>
oop isInteger ifFalse:[self error:'Not an integer object'].
^oop!
Item was changed:
----- Method: LargeIntegersPlugin>>digitMontgomery:times:modulo:mInvModB: (in category 'oop functions') -----
digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv
| firstLen secondLen thirdLen prod |
<var: #over type: 'unsigned char '>
firstLen := self byteSizeOfBytes: firstLarge.
secondLen := self byteSizeOfBytes: secondLarge.
thirdLen := self byteSizeOfBytes: thirdLarge.
+ firstLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail].
+ secondLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail].
+ (mInv >= 0 and: [mInv <= 255]) ifFalse: [^interpreterProxy primitiveFail].
- firstLen <= thirdLen ifFalse: [^self error: 'firstLarge must be less than thirdLarge'].
- secondLen <= thirdLen ifFalse: [^self error: 'secondLarge must be less than thirdLarge'].
- (mInv >= 0 and: [mInv <= 255]) ifFalse: [^self error: 'mInvMod256 must be between 0 and 255'].
self remapOop: #(firstLarge secondLarge thirdLarge) in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen].
self
cdigitMontgomery: (interpreterProxy firstIndexableField: firstLarge)
len: firstLen
times: (interpreterProxy firstIndexableField: secondLarge)
len: secondLen
modulo: (interpreterProxy firstIndexableField: thirdLarge)
len: thirdLen
mInvModB: mInv
into: (interpreterProxy firstIndexableField: prod).
^self normalizePositive: prod!
Item was changed:
----- Method: NewspeakInterpreter>>getStackPointer (in category 'primitive support') -----
getStackPointer
"For Newsqueak FFI"
<export: true>
<returnTypeC: #'sqInt *'>
+ ^self cCoerce: stackPointer to: #'sqInt *'!
- ^stackPointer!
Item was changed:
----- Method: NewspeakInterpreter>>signed32BitIntegerFor: (in category 'primitive support') -----
signed32BitIntegerFor: integerValue
"Return a full 32 bit integer object for the given integer value"
| newLargeInteger value largeClass |
<inline: false>
- <var: #integerValue type: 'int'>
(self isIntegerValue: integerValue)
ifTrue: [^ self integerObjectOf: integerValue].
integerValue < 0
ifTrue:[ largeClass := self classLargeNegativeInteger.
value := 0 - integerValue]
ifFalse:[ largeClass := self classLargePositiveInteger.
value := integerValue].
newLargeInteger := self instantiateClass: largeClass indexableSize: 4.
self storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF).
self storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF).
self storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF).
self storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF).
^ newLargeInteger!
Item was changed:
----- Method: NewspeakInterpreter>>stObject:at:put: (in category 'indexing primitive support') -----
stObject: array at: index put: value
"Do what ST would return for <obj> at: index put: value."
| hdr fmt totalLength fixedFields stSize |
<inline: false>
hdr := self baseHeader: array.
fmt := self formatOfHeader: hdr.
totalLength := self lengthOf: array baseHeader: hdr format: fmt.
fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
(fmt = 3 and: [self isContextHeader: hdr])
ifTrue: [stSize := self fetchStackPointerOf: array]
ifFalse: [stSize := totalLength - fixedFields].
((self oop: index isGreaterThanOrEqualTo: 1)
and: [self oop: index isLessThanOrEqualTo: stSize])
ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
+ ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])].
+ ^value!
- ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])]!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin>>primCallOutDoubleReturn (in category 'primitives-callouts') -----
primCallOutDoubleReturn
"Call a foreign function that answers a double-precision floating-point result in %f0
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien>
<primitive: 'primCallOutDoubleReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| errCode mac result |
<export: true>
mac := interpreterProxy methodArgumentCount.
self cppIf: STACKVM
ifTrue: "In the STACKVM stacks grow down"
+ [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg"
+ IA32: 1 - mac "nargs negated to imply stack direction"
+ Double: mac "funcOffset"
+ Return: mac - 1 "resultOffset"]
- [self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */
- 1 - mac /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]]
ifFalse:
+ [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg"
+ IA32: mac - 1 "nargs"
+ Double: mac "funcOffset"
+ Return: mac - 1 "resultOffset"].
- [self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */
- mac - 1 /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: mac - 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin>>primCallOutFloatReturn (in category 'primitives-callouts') -----
primCallOutFloatReturn
"Call a foreign function that answers a single-precision floating-point result in %f0
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien>
<primitive: 'primCallOutFloatReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| errCode mac result |
<export: true>
mac := interpreterProxy methodArgumentCount.
self cppIf: STACKVM
ifTrue: "In the STACKVM stacks grow down"
+ [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg"
+ IA32: 1 - mac "nargs negated to imply stack direction"
+ Float: mac "funcOffset"
+ Return: mac - 1 "resultOffset"]
- [self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */
- 1 - mac /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]]
ifFalse:
+ [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg"
+ IA32: mac - 1 "nargs"
+ Float: mac "funcOffset"
+ Return: mac - 1 "resultOffset"].
- [self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */
- mac - 1 /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: mac - 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin>>primCallOutIntegralReturn (in category 'primitives-callouts') -----
primCallOutIntegralReturn
"Call a foreign function that answers an integral result in %eax (and possibly %edx)
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien>
<primitive: 'primCallOutIntegralReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| errCode mac result |
<export: true>
mac := interpreterProxy methodArgumentCount.
self cppIf: STACKVM
ifTrue: "In the STACKVM stacks grow down"
+ [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg"
+ IA32: 1 - mac "nargs negated to imply stack direction"
+ Integral: mac "funcOffset"
+ Return: mac - 1 "resultOffset"]
- [self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */
- 1 - mac /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]]
ifFalse:
+ [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg"
+ IA32: mac - 1 "nargs"
+ Integral: mac "funcOffset"
+ Return: mac - 1 "resultOffset"].
- [self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */
- mac - 1 /* nargs */,
- mac /* funcOffset*/,
- mac - 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported]].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: mac - 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin>>primVarArgsCallOutDoubleReturn (in category 'primitives-callouts') -----
primVarArgsCallOutDoubleReturn
"Call a foreign function that answers a double-precision floating-point result in %f0
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien>
<primitive: 'primVarArgsCallOutDoubleReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| array mac errCode result |
<export: true>
array := interpreterProxy stackValue: 0.
(interpreterProxy isArray: array) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
mac := interpreterProxy methodArgumentCount.
+ errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg"
+ IA32: (interpreterProxy stSizeOf: array) "nargs"
+ Double: 2 "func stackValue"
+ Return: 1. "result stackValue"
- self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->firstIndexableField(array), /* arg vec */
- interpreterProxy->stSizeOf(array) /* nargs */,
- 2 /* funcOffset*/,
- 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin>>primVarArgsCallOutFloatReturn (in category 'primitives-callouts') -----
primVarArgsCallOutFloatReturn
"Call a foreign function that answers a single-precision floating-point result in %f0
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien>
<primitive: 'primVarArgsCallOutFloatReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| array mac errCode result |
<export: true>
array := interpreterProxy stackValue: 0.
(interpreterProxy isArray: array) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
mac := interpreterProxy methodArgumentCount.
+ errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg"
+ IA32: (interpreterProxy stSizeOf: array) "nargs"
+ Float: 2 "func stackValue"
+ Return: 1. "result stackValue"
- self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->firstIndexableField(array), /* arg vec */
- interpreterProxy->stSizeOf(array) /* nargs */,
- 2 /* funcOffset*/,
- 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin>>primVarArgsCallOutIntegralReturn (in category 'primitives-callouts') -----
primVarArgsCallOutIntegralReturn
"Call a foreign function that answers an integral result in %eax (and possibly %edx)
according to IA32-ish ABI rules. The primitive will have a signature of the form
functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien>
<primitive: 'primVarArgsCallOutIntegralReturn' error: errorCode module: 'IA32ABI'>.
Answer result. If result is an Alien the value answered by the call will be assigned to result."
| array mac errCode result |
<export: true>
array := interpreterProxy stackValue: 0.
(interpreterProxy isArray: array) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
mac := interpreterProxy methodArgumentCount.
+ errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg"
+ IA32: (interpreterProxy stSizeOf: array) "nargs"
+ Integral: 2 "func stackValue"
+ Return: 1. "result stackValue"
- self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->firstIndexableField(array), /* arg vec */
- interpreterProxy->stSizeOf(array) /* nargs */,
- 2 /* funcOffset*/,
- 1 /* resultOffset */)'
- inSmalltalk: [errCode := PrimErrUnsupported].
errCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: errCode].
result := interpreterProxy stackValue: 1.
interpreterProxy pop: mac + 1 thenPush: result!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin>>setInterpreter: (in category 'initialize') -----
setInterpreter: anInterpreter
"Note: This is coded so that is can be run from Squeak."
| ok |
<export: true>
<var: #anInterpreter type: #'struct VirtualMachine*'>
interpreterProxy := anInterpreter.
ok := interpreterProxy majorVersion = 1
and: [interpreterProxy minorVersion >= 12].
+ ok ifTrue:
+ [self expandDereferenceInterpreterProxyFunctionTable].
^ok!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asBooleanValueFrom:on: (in category 'linking') -----
- emitLoad: aString asBooleanValueFrom: anInteger on: aStream
-
- aStream
- nextPutAll: aString;
- nextPutAll: ' = interpreterProxy->booleanValueOf(';
- crtab: 2;
- nextPutAll: 'interpreterProxy->stackValue(';
- nextPutAll: anInteger asString;
- nextPutAll: '))'!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asCharPtrFrom:on: (in category 'linking') -----
- emitLoad: aString asCharPtrFrom: anInteger on: aStream
-
- aStream
- nextPutAll: aString;
- nextPutAll: ' = (char *) interpreterProxy->firstIndexableField(';
- crtab: 2;
- nextPutAll: 'interpreterProxy->stackValueOf(';
- nextPutAll: anInteger asString;
- nextPutAll: '))'!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asFloatPtrFrom:on: (in category 'linking') -----
- emitLoad: aString asFloatPtrFrom: anInteger on: aStream
-
- aStream
- nextPutAll: aString;
- nextPutAll: ' = (float *) interpreterProxy->firstIndexableField(';
- crtab: 2;
- nextPutAll: 'interpreterProxy->stackValueOf(';
- nextPutAll: anInteger asString;
- nextPutAll: '))'!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asFloatValueFrom:on: (in category 'linking') -----
- emitLoad: aString asFloatValueFrom: anInteger on: aStream
-
- aStream
- nextPutAll: aString;
- nextPutAll: ' = interpreterProxy->stackFloatValue(';
- nextPutAll: anInteger asString;
- nextPutAll: ')'!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asIntPtrFrom:on: (in category 'linking') -----
- emitLoad: aString asIntPtrFrom: anInteger on: aStream
-
- aStream
- nextPutAll: aString;
- nextPutAll: ' = (int *) interpreterProxy->firstIndexableField(';
- crtab: 2;
- nextPutAll: 'interpreterProxy->stackValueOf(';
- nextPutAll: anInteger asString;
- nextPutAll: '))'!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asIntegerValueFrom:on: (in category 'linking') -----
- emitLoad: aString asIntegerValueFrom: anInteger on: aStream
-
- aStream
- nextPutAll: aString;
- nextPutAll: ' = interpreterProxy stackIntegerValue(';
- nextPutAll: anInteger asString;
- nextPutAll: ')'!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asKindOf:from:on: (in category 'linking') -----
- emitLoad: aString asKindOf: aClass from: anInteger on: aStream
-
- self emitLoad: aString asNakedOopFrom: anInteger on: aStream.
- aStream
- crtab;
- nextPutAll: 'interpreterProxy->success(interpreterProxy->isKindOf(';
- nextPutAll: aString;
- nextPutAll: ', ''';
- nextPutAll: aClass asString;
- nextPutAll: '''))'!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asMemberOf:from:on: (in category 'linking') -----
- emitLoad: aString asMemberOf: aClass from: anInteger on: aStream
-
- self emitLoad: aString asNakedOopFrom: anInteger on: aStream.
- aStream
- crtab;
- nextPutAll: 'interpreterProxy->success(interpreterProxy->isMemberOf(';
- nextPutAll: aString;
- nextPutAll: ', ''';
- nextPutAll: aClass asString;
- nextPutAll: '''))'!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asNakedOopFrom:on: (in category 'linking') -----
- emitLoad: aString asNakedOopFrom: anInteger on: aStream
-
- aStream
- nextPutAll: aString;
- nextPutAll: ' = interpreterProxy stackValue(';
- nextPutAll: anInteger asString;
- nextPutAll: ')'!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asNonIntegerValueFrom:on: (in category 'linking') -----
- emitLoad: aString asNonIntegerValueFrom: anInteger on: aStream
-
- aStream
- nextPutAll: aString;
- nextPutAll: ' = interpreterProxy stackObjectValue(';
- nextPutAll: anInteger asString;
- nextPutAll: ')'!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asUnsignedValueFrom:on: (in category 'linking') -----
- emitLoad: aString asUnsignedValueFrom: anInteger on: aStream
-
- aStream
- nextPutAll: aString;
- nextPutAll: ' = interpreterProxy->positive32BitValueOf(';
- crtab: 2;
- nextPutAll: 'interpreterProxy->stackValue(';
- nextPutAll: anInteger asString;
- nextPutAll: '))'!
Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>genCallOf:with:on: (in category 'translating builtins') -----
+ genCallOf: aSelector with: aNode on: aStream
+ pluginFunctionsUsed add: aSelector.
+ aStream nextPutAll: (self cFunctionNameFor: aSelector).
+ aStream nextPut: $(.
+ self emitCExpression: aNode on: aStream.
+ aStream nextPut: $)!
Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>genCallOf:with:with:on: (in category 'translating builtins') -----
+ genCallOf: aSelector with: firstArgNode with: secondArgNode on: aStream
+ pluginFunctionsUsed add: aSelector.
+ aStream nextPutAll: (self cFunctionNameFor: aSelector).
+ aStream nextPut: $(.
+ self emitCExpression: firstArgNode on: aStream.
+ aStream nextPut: $,.
+ self emitCExpression: secondArgNode on: aStream.
+ aStream nextPut: $)!
Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>genCallOf:with:with:with:on: (in category 'translating builtins') -----
+ genCallOf: aSelector with: firstArgNode with: secondArgNode with: thirdArgNode on: aStream
+ pluginFunctionsUsed add: aSelector.
+ aStream nextPutAll: (self cFunctionNameFor: aSelector).
+ aStream nextPut: $(.
+ self emitCExpression: firstArgNode on: aStream.
+ aStream nextPut: $,.
+ self emitCExpression: secondArgNode on: aStream.
+ aStream nextPut: $,.
+ self emitCExpression: thirdArgNode on: aStream.
+ aStream nextPut: $)!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsBooleanObj:on:indent: (in category 'translating builtins') -----
generateAsBooleanObj: aNode on: aStream indent: anInteger
+ pluginFunctionsUsed add: #trueObject; add: #falseObject.
+ aStream nextPutAll: '(('.
-
- aStream nextPutAll: '('.
self emitCExpression: aNode receiver on: aStream.
+ aStream nextPutAll: ') ? trueObject() : falseObject())'.!
- aStream nextPutAll:
- ') ? interpreterProxy->trueObject(): interpreterProxy->falseObject()'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsCBoolean:on:indent: (in category 'translating builtins') -----
generateAsCBoolean: aNode on: aStream indent: anInteger
+ self genCallOf: #booleanValueOf: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->booleanValueOf('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsCDouble:on:indent: (in category 'translating builtins') -----
generateAsCDouble: aNode on: aStream indent: anInteger
+ self genCallOf: #floatValueOf: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->floatValueOf('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsCUnsigned:on:indent: (in category 'translating builtins') -----
generateAsCUnsigned: aNode on: aStream indent: anInteger
+ self genCallOf: #positive32BitValueOf: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->positive32BitValueOf('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsCharPtr:on:indent: (in category 'translating builtins') -----
generateAsCharPtr: aNode on: aStream indent: anInteger
+ self generateCoerceToPtr: 'char *' fromObject: aNode receiver on: aStream!
-
- aStream nextPutAll: '(char *) interpreterProxy->firstIndexableField('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsFloatObj:on:indent: (in category 'translating builtins') -----
generateAsFloatObj: aNode on: aStream indent: anInteger
+ self genCallOf: #floatObjectOf: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->floatObjectOf('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsIfVar:on:indent: (in category 'translating builtins') -----
generateAsIfVar: aNode on: aStream indent: anInteger
| cName fName class index |
cName := String streamContents:
[:scStr | self emitCExpression: aNode args first on: scStr].
+ (class := Smalltalk classNamed: cName) isBehavior ifFalse:
- class := Smalltalk
- at: (cName asSymbol)
- ifAbsent: [nil].
- (class isNil not and: [class isBehavior]) ifFalse:
[^self error: 'first arg must identify class'].
fName := aNode args second value.
+ index := class
+ instVarIndexFor: fName
+ ifAbsent: [^self error: 'second arg must be instVar'].
+ pluginFunctionsUsed add: #fetchPointer:ofObject:.
+ aStream nextPutAll: 'fetchPointerofObject('; print: index - 1; nextPut: $,.
- index := class allInstVarNames
- indexOf: fName
- ifAbsent: [^self error: 'second arg must be instVar'].
- aStream
- nextPutAll: 'interpreterProxy->fetchPointerofObject(';
- nextPutAll: (index - 1) asString;
- nextPutAll: ','.
self emitCExpression: aNode receiver on: aStream.
+ aStream nextPut: $)!
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsIfVarAsValue:on:indent: (in category 'translating builtins') -----
generateAsIfVarAsValue: aNode on: aStream indent: anInteger
| cName fName class index fetchNode |
cName := String streamContents:
+ [:scStr | self emitCExpression: aNode args first on: scStr].
+ (class := Smalltalk classNamed: cName) isBehavior ifFalse:
- [:scStr | self emitCExpression: aNode args first on: scStr].
- class := Smalltalk
- at: (cName asSymbol)
- ifAbsent: [nil].
- (class isNil not and: [class isBehavior]) ifFalse:
[^self error: 'first arg must identify class'].
fName := aNode args second value.
+ index := class
+ instVarIndexFor: fName
+ ifAbsent: [^self error: 'second arg must be instVar'].
- index := class allInstVarNames
- indexOf: fName
- ifAbsent: [^self error: 'second arg must be instVar'].
fetchNode := TSendNode new
+ setSelector: #fetchPointer:ofObject:
+ receiver: (TVariableNode new setName: 'self')
+ arguments: { TConstantNode new setValue: index - 1. aNode receiver}.
- setSelector: #fetchPointer:ofObject:
- receiver: (TVariableNode new setName: 'interpreterProxy')
- arguments: (Array
- with: (TConstantNode new setValue: index - 1)
- with: aNode receiver).
cName := aNode args third nameOrValue.
+ (class := Smalltalk classNamed: cName) isBehavior ifFalse:
- class := Smalltalk
- at: (cName asSymbol)
- ifAbsent: [nil].
- (class isNil not and: [class isBehavior]) ifFalse:
[^self error: 'third arg must identify class'].
class ccg: self generateCoerceToValueFrom: fetchNode on: aStream
!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsIfVarPut:on:indent: (in category 'translating builtins') -----
generateAsIfVarPut: aNode on: aStream indent: anInteger
| cName fName class index |
cName := String streamContents:
[:scStr | self emitCExpression: aNode args first on: scStr].
+ (class := Smalltalk classNamed: cName) isBehavior ifFalse:
- class := Smalltalk
- at: (cName asSymbol)
- ifAbsent: [nil].
- (class isNil not and: [class isBehavior]) ifFalse:
[^self error: 'first arg must identify class'].
fName := aNode args second value.
+ index := class
+ instVarIndexFor: fName
+ ifAbsent: [^self error: 'second arg must be instVar'].
+ pluginFunctionsUsed add: #storePointer:ofObject:withValue:.
+ aStream nextPutAll: 'storePointerofObjectwithValue('; print: index - 1; nextPut: $,.
- index := class allInstVarNames
- indexOf: fName
- ifAbsent: [^self error: 'second arg must be instVar'].
- aStream
- nextPutAll: 'interpreterProxy->storePointerofObjectwithValue(';
- nextPutAll: (index - 1) asString;
- nextPutAll: ','.
self emitCExpression: aNode receiver on: aStream.
+ aStream nextPut: $,.
- aStream nextPutAll: ','.
self emitCExpression: aNode args third on: aStream.
+ aStream nextPut: $)!
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsIntPtr:on:indent: (in category 'translating builtins') -----
generateAsIntPtr: aNode on: aStream indent: anInteger
+ self generateCoerceToPtr: 'int *' fromObject: aNode receiver on: aStream!
-
- aStream nextPutAll: '(int *) interpreterProxy->firstIndexableField('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsPositiveIntegerObj:on:indent: (in category 'translating builtins') -----
generateAsPositiveIntegerObj: aNode on: aStream indent: anInteger
+ self genCallOf: #positive32BitIntegerFor: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->positive32BitIntegerFor('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateAsSmallIntegerObj:on:indent: (in category 'translating builtins') -----
generateAsSmallIntegerObj: aNode on: aStream indent: anInteger
+ self genCallOf: #integerObjectOf: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->integerObjectOf('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateClass:on:indent: (in category 'translating builtins') -----
generateClass: aNode on: aStream indent: anInteger
+ self genCallOf: #fetchClassOf: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->fetchClassOf('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToBooleanObjectFrom:on: (in category 'asOop:/asValue:') -----
generateCoerceToBooleanObjectFrom: aNode on: aStream
+ pluginFunctionsUsed add: #trueObject; add: #falseObject.
+ aStream nextPutAll: '(('.
-
- aStream nextPutAll: '('.
self emitCExpression: aNode on: aStream.
+ aStream nextPutAll: ') ? trueObject() : falseObject())'!
- aStream nextPutAll: '? interpreterProxy->trueObject(): interpreterProxy->falseObject())'!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToBooleanValueFrom:on: (in category 'asOop:/asValue:') -----
generateCoerceToBooleanValueFrom: aNode on: aStream
+ self genCallOf: #booleanValueOf: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->booleanValueOf('.
- self emitCExpression: aNode on: aStream.
- aStream nextPutAll: ')'!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToFloatObjectFrom:on: (in category 'asOop:/asValue:') -----
generateCoerceToFloatObjectFrom: aNode on: aStream
+ self genCallOf: #floatObjectOf: with: aNode on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->floatObjectOf('.
- self emitCExpression: aNode on: aStream.
- aStream nextPutAll: ')'!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToFloatValueFrom:on: (in category 'asOop:/asValue:') -----
generateCoerceToFloatValueFrom: aNode on: aStream
+ self genCallOf: #floatValueOf: with: aNode on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->floatValueOf('.
- self emitCExpression: aNode on: aStream.
- aStream nextPutAll: ')'!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToPtr:fromObject:on: (in category 'asOop:/asValue:') -----
generateCoerceToPtr: aString fromObject: aNode on: aStream
"This code assumes no named instance variables"
-
aStream
nextPutAll: '((';
nextPutAll: aString;
+ nextPut: $).
+ self genCallOf: #firstIndexableField: with: aNode on: aStream.
+ aStream nextPut: $)!
- nextPutAll: ') interpreterProxy->firstIndexableField('.
- self emitCExpression: aNode on: aStream.
- aStream nextPutAll: '))'!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToSmallIntegerObjectFrom:on: (in category 'asOop:/asValue:') -----
generateCoerceToSmallIntegerObjectFrom: aNode on: aStream
+ self genCallOf: #integerObjectOf: with: aNode on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->integerObjectOf('.
- self emitCExpression: aNode on: aStream.
- aStream nextPutAll: ')'!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToSmallIntegerValueFrom:on: (in category 'asOop:/asValue:') -----
generateCoerceToSmallIntegerValueFrom: aNode on: aStream
+ self genCallOf: #integerValueOf: with: aNode on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->integerValueOf('.
- self emitCExpression: aNode on: aStream.
- aStream nextPutAll: ')'!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToUnsignedObjectFrom:on: (in category 'asOop:/asValue:') -----
generateCoerceToUnsignedObjectFrom: aNode on: aStream
+ self genCallOf: #positive32BitIntegerFor: with: aNode on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->positive32BitIntegerFor('.
- self emitCExpression: aNode on: aStream.
- aStream nextPutAll: ')'!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToUnsignedValueFrom:on: (in category 'asOop:/asValue:') -----
generateCoerceToUnsignedValueFrom: aNode on: aStream
+ self genCallOf: #positive32BitValueOf: with: aNode on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->positive32BitValueOf('.
- self emitCExpression: aNode on: aStream.
- aStream nextPutAll: ')'!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateField:on:indent: (in category 'translating builtins') -----
generateField: aNode on: aStream indent: anInteger
+ self genCallOf: #fetchPointer:ofObject: with: aNode args first with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->fetchPointerofObject('.
- self emitCExpression: aNode args first on: aStream.
- aStream nextPutAll: ','.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateFieldPut:on:indent: (in category 'translating builtins') -----
generateFieldPut: aNode on: aStream indent: anInteger
+ self genCallOf: #storePointer:ofObject:withValue:
+ with: aNode args first
+ with: aNode receiver
+ with: aNode args second
+ on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->storePointerofObjectwithValue('.
- self emitCExpression: aNode args first on: aStream.
- aStream nextPutAll: ','.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ','.
- self emitCExpression: aNode args second on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateFromStack:on:indent: (in category 'translating builtins') -----
generateFromStack: aNode on: aStream indent: anInteger
-
| idList |
aNode args first isConstant ifFalse: [^self error: 'arg must be constant'].
+ pluginFunctionsUsed add: #stackValue:.
idList := aNode args first value.
(1 to: idList size)
do: [:i |
aStream
nextPutAll: (idList at: i);
+ nextPutAll: ' = stackValue(';
- nextPutAll: ' = interpreterProxy->stackValue(';
nextPutAll: (idList size - i) asString;
+ nextPut: $)]
- nextPutAll: ')']
separatedBy: [aStream nextPut: $;; crtab: anInteger].
!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsBytes:on:indent: (in category 'translating builtins') -----
- generateIsBytes: aNode on: aStream indent: anInteger
-
- aStream nextPutAll: 'interpreterProxy->isBytes('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateIsFloat:on:indent: (in category 'translating builtins') -----
generateIsFloat: aNode on: aStream indent: anInteger
+ self genCallOf: #isFloatObject: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->isFloatObject('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateIsIndexable:on:indent: (in category 'translating builtins') -----
generateIsIndexable: aNode on: aStream indent: anInteger
+ self genCallOf: #isIndexable: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->isIndexable('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsInteger:on:indent: (in category 'translating builtins') -----
- generateIsInteger: aNode on: aStream indent: anInteger
-
- aStream nextPutAll: 'interpreterProxy->isIntegerValue('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateIsIntegerOop:on:indent: (in category 'translating builtins') -----
generateIsIntegerOop: aNode on: aStream indent: anInteger
+ self genCallOf: #isIntegerObject: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->isIntegerObject('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateIsIntegerValue:on:indent: (in category 'translating builtins') -----
generateIsIntegerValue: aNode on: aStream indent: anInteger
+ self genCallOf: #isIntegerValue: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->isIntegerValue('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateIsKindOf:on:indent: (in category 'translating builtins') -----
generateIsKindOf: aNode on: aStream indent: anInteger
+ self genCallOf: #is:KindOf: with: aNode receiver with: aNode args first on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->isKindOf('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ','''.
- self emitCExpression: aNode args first on: aStream.
- aStream nextPutAll: ''')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateIsMemberOf:on:indent: (in category 'translating builtins') -----
generateIsMemberOf: aNode on: aStream indent: anInteger
+ self genCallOf: #is:MemberOf: with: aNode receiver with: aNode args first on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->isMemberOf('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ','''.
- self emitCExpression: aNode args first on: aStream.
- aStream nextPutAll: ''')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateIsPointers:on:indent: (in category 'translating builtins') -----
generateIsPointers: aNode on: aStream indent: anInteger
+ self genCallOf: #isPointers: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->isPointers('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateIsWords:on:indent: (in category 'translating builtins') -----
generateIsWords: aNode on: aStream indent: anInteger
+ self genCallOf: #isWords: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->isWords('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateIsWordsOrBytes:on:indent: (in category 'translating builtins') -----
generateIsWordsOrBytes: aNode on: aStream indent: anInteger
+ self genCallOf: #isWordsOrBytes: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->isWordsOrBytes('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateRemapOopIn:on:indent: (in category 'translating builtins') -----
generateRemapOopIn: aNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
| idList |
+ pluginFunctionsUsed add: #pushRemappableOop:; add: #popRemappableOop.
idList := aNode args first nameOrValue.
idList class == Array ifFalse: [idList := Array with: idList].
idList do:
[:each |
aStream
+ nextPutAll: 'pushRemappableOop(';
- nextPutAll: 'interpreterProxy->pushRemappableOop(';
nextPutAll: each asString;
nextPutAll: ');']
separatedBy: [aStream crtab: level].
aStream cr.
aNode args second emitCCodeOn: aStream level: level generator: self.
level timesRepeat: [aStream tab].
idList reversed do:
[:each |
aStream
nextPutAll: each asString;
+ nextPutAll: ' = popRemappableOop()']
- nextPutAll: ' = interpreterProxy->popRemappableOop()']
separatedBy: [aStream nextPut: $;; crtab: level].!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateStAt:on:indent: (in category 'translating builtins') -----
generateStAt: aNode on: aStream indent: anInteger
+ self genCallOf: #stObject:at: with: aNode receiver with: aNode args first on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->stObjectat('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ','.
- self emitCExpression: aNode args first on: aStream.
- aStream nextPutAll: ')'
- !
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateStAtPut:on:indent: (in category 'translating builtins') -----
generateStAtPut: aNode on: aStream indent: anInteger
+ self genCallOf: #stObject:at:put:
+ with: aNode receiver
+ with: aNode args first
+ with: aNode args second
+ on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->stObjectatput('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ','.
- self emitCExpression: aNode args first on: aStream.
- aStream nextPutAll: ','.
- self emitCExpression: aNode args second on: aStream.
- aStream nextPutAll: ')'
- !
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateStSize:on:indent: (in category 'translating builtins') -----
generateStSize: aNode on: aStream indent: anInteger
+ self genCallOf: #stSizeOf: with: aNode receiver on: aStream!
-
- aStream nextPutAll: 'interpreterProxy->stSizeOf('.
- self emitCExpression: aNode receiver on: aStream.
- aStream nextPutAll: ')'.!
Item was changed:
----- Method: StackInterpreter>>getStackPointer (in category 'primitive support') -----
getStackPointer
"For Alien FFI"
<api>
<returnTypeC: #'sqInt *'>
+ ^self cCoerce: stackPointer to: #'sqInt *'!
- ^self cCoerceSimple: stackPointer to: #'sqInt *'!
Item was changed:
----- Method: StackInterpreter>>stObject:at:put: (in category 'indexing primitive support') -----
stObject: array at: index put: value
"Do what ST would return for <obj> at: index put: value."
| hdr fmt totalLength fixedFields stSize |
<inline: false>
hdr := objectMemory baseHeader: array.
fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: array baseHeader: hdr format: fmt.
fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength.
(fmt = 3
and: [objectMemory isContextHeader: hdr])
ifTrue:
[stSize := self stackPointerForMaybeMarriedContext: array.
((self oop: index isGreaterThanOrEqualTo: 1)
and: [(self oop: index isLessThanOrEqualTo: stSize)
and: [self isStillMarriedContext: array]]) ifTrue:
+ [^self noInlineTemporary: index - 1 in: (self frameOfMarriedContext: array) put: value]]
- [self noInlineTemporary: index - 1 in: (self frameOfMarriedContext: array) put: value.
- ^self]]
ifFalse: [stSize := totalLength - fixedFields].
((self oop: index isGreaterThanOrEqualTo: (objectMemory firstValidIndexOfIndexableObject: array withFormat: fmt))
and: [self oop: index isLessThanOrEqualTo: stSize])
ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
+ ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])].
+ ^value!
- ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])]!
Item was changed:
----- Method: TSendNode>>emitCCodeAsFunctionCallOn:level:generator: (in category 'C code generation') -----
emitCCodeAsFunctionCallOn: aStream level: level generator: aCodeGen
"Translate this message send into a C function call"
"Special case for pluggable modules. Replace messages to interpreterProxy
by interpreterProxy->message(..) if the message is not builtin"
(aCodeGen messageReceiverIsInterpreterProxy: self) ifTrue:
+ [(aCodeGen noteUsedPluginFunction: selector) ifTrue:
+ [aStream nextPutAll: 'interpreterProxy->']].
- [aStream nextPutAll: 'interpreterProxy->'].
"Translate this message send into a C function call."
aStream nextPutAll: (aCodeGen cFunctionNameFor: selector); nextPut: $(.
"Only include the receiver as the first argument in certain cases.
The receiver is always included if it is an expression.
If it is a variable:
If the vmClass says it is an implicit variable, don't include it.
If the variable is 'self' and the method being called is not in
the method set (i.e. it is some external code), don't include it."
(self shouldExcludeReceiverAsFirstArgument: aCodeGen) ifFalse:
[receiver emitCCodeOn: aStream level: level generator: aCodeGen.
+ arguments isEmpty ifFalse:
- arguments isEmpty ifFalse:
[aStream nextPutAll: ', ']].
arguments
do: [ :arg| arg emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen]
separatedBy: [aStream nextPut: $,; space].
aStream nextPut: $)!
Item was added:
+ TestCase subclass: #VMInterfaceConsistencyTests
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Tests'!
+
+ !VMInterfaceConsistencyTests commentStamp: 'eem 12/6/2012 15:03' prior: 0!
+ VMInterfaceConsistencyTests tests that the interpreter proxy implementations are consistent.!
Item was added:
+ ----- Method: VMInterfaceConsistencyTests>>testInterpreterProxyInterface (in category 'tests') -----
+ testInterpreterProxyInterface
+ "| fails |
+ fails := Set new.
+ [self new testInterpreterProxyInterface]
+ on: AssertionFailure, TestFailure
+ do: [:ex|
+ fails add: ex messageText.
+ ex resume].
+ fails asArray sort do:
+ [:m| Transcript cr; nextPutAll: m; flush]"
+ (VMClass allSubclasses select: [:ea| (ea name endsWith: 'Interpreter') or: [ea name endsWith: 'InterpreterMT']]) do:
+ [:class|
+ self testInterpreterProxyInterfaceIsConsistentFor: class]!
Item was added:
+ ----- Method: VMInterfaceConsistencyTests>>testInterpreterProxyInterfaceIsConsistentFor: (in category 'private-support') -----
+ testInterpreterProxyInterfaceIsConsistentFor: aClass
+ | ccg |
+ ccg := VMPluginCodeGenerator new.
+ InterpreterProxy selectors asArray sort do:
+ [:sel| | pm |
+ ((#(initialize #'initialize-release' private) includes: (InterpreterProxy whichCategoryIncludesSelector: sel))
+ or: [ccg noteUsedPluginFunction: sel]) ifFalse:
+ [pm := ccg compileToTMethodSelector: sel in: InterpreterProxy.
+ (aClass whichClassIncludesSelector: sel) ifNotNil:
+ [:impClass| | im pt it |
+ im := ccg compileToTMethodSelector: sel in: impClass.
+ "A number of functions are actually void in the interpreter but declared as sqInt in sqVirtualMachine.c, e.g. push"
+ self assert: ((pt := pm returnType) = (it := im returnType)
+ or: [pt = #sqInt and: [it = #void]])
+ description: 'inconsistent returnType for ', sel, ' in InterpreterProxy vs ', impClass, ' ', pt, ' vs ', it.
+ pm args doWithIndex:
+ [:pma :i| | ima |
+ ima := im args at: i.
+ self assert: (pt := pm typeFor: pma in: ccg) = (it := im typeFor: ima in: ccg)
+ description: 'inconsistent ', i printString, (#('st' 'nd') at: i ifAbsent: 'th'), ' arg type for ', sel, ' in InterpreterProxy vs ', impClass, ' ', pt, ' vs ', it]]]]!
Item was changed:
CCodeGenerator subclass: #VMPluginCodeGenerator
+ instanceVariableNames: 'pluginClass pluginName pluginFunctionsUsed'
- instanceVariableNames: 'pluginClass pluginName'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-Translation to C'!
!VMPluginCodeGenerator commentStamp: '<historical>' prior: 0!
I generate code that can be loaded dynamically from external libraries (e.g., DSOs on Unix or DLLs on Windows)!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>emitCCodeOn:doInlining:doAssertions: (in category 'C code generator') -----
+ emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag
+ "Generate twice; the first time to collect the used functions, the second to output the used functions."
+ [super emitCCodeOn: NullStream new doInlining: inlineFlag doAssertions: assertionFlag]
+ on: MessageNotUnderstood
+ do: [:ex|
+ (#(peekLast tab: crtab:) includes: ex message selector) ifTrue:
+ [ex resume: nil].
+ ex pass].
+ super emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag!
Item was changed:
----- Method: VMPluginCodeGenerator>>emitCHeaderForPrimitivesOn: (in category 'C code generator') -----
emitCHeaderForPrimitivesOn: aStream
"Write a C file header for compiled primitives onto the given stream."
self emitCHeaderOn: aStream.
aStream nextPutAll: '
/*** Proxy Functions ***/
+ #if defined(SQUEAK_BUILTIN_PLUGIN)
+ extern sqInt stackValue(sqInt offset);
+ extern sqInt stackIntegerValue(sqInt offset);
+ extern sqInt failed(void);
+ # define successFlag (!!failed())
+ extern sqInt success(sqInt aBoolean);
+ extern void * arrayValueOf(sqInt oop);
+ extern void * fetchArrayofObject(sqInt fieldIndex, sqInt objectPointer);
+ extern double fetchFloatofObject(sqInt fieldIndex, sqInt objectPointer);
+ extern sqInt fetchIntegerofObject(sqInt fieldIndex, sqInt objectPointer);
+ extern double floatValueOf(sqInt oop);
+ extern sqInt pop(sqInt nItems);
+ extern sqInt pushInteger(sqInt integerValue);
+ extern sqInt sizeOfSTArrayFromCPrimitive(void *cPtr);
+ extern sqInt storeIntegerofObjectwithValue(sqInt index, sqInt oop, sqInt integer);
+ extern sqInt primitiveFail(void);
+ #else /* SQUEAK_BUILTIN_PLUGIN */
+ # define stackValue(i) (interpreterProxy->stackValue(i))
+ # define stackIntegerValue(i) (interpreterProxy->stackIntegerValue(i))
+ # define successFlag (!!interpreterProxy->failed())
+ # define success(bool) (interpreterProxy->success(bool))
+ # define arrayValueOf(oop) (interpreterProxy->arrayValueOf(oop))
+ # define fetchArrayofObject(idx,oop) (interpreterProxy->fetchArrayofObject(idx,oop))
+ # define fetchFloatofObject(idx,oop) (interpreterProxy->fetchFloatofObject(idx,oop))
+ # define fetchIntegerofObject(idx,oop) (interpreterProxy->fetchIntegerofObject(idx,oop))
+ # define floatValueOf(oop) (interpreterProxy->floatValueOf(oop))
+ # define pop(n) (interpreterProxy->pop(n))
+ # define pushInteger(n) (interpreterProxy->pushInteger(n))
+ # define sizeOfSTArrayFromCPrimitive(cPtr) (interpreterProxy->sizeOfSTArrayFromCPrimitive(cPtr))
+ # define storeIntegerofObjectwithValue(idx,oop,value) (interpreterProxy->storeIntegerofObjectwithValue(idx,oop,value))
+ # define primitiveFail() interpreterProxy->primitiveFail()
+ #endif /* SQUEAK_BUILTIN_PLUGIN */
+
- #define stackValue(i) (interpreterProxy->stackValue(i))
- #define stackIntegerValue(i) (interpreterProxy->stackIntegerValue(i))
- #define successFlag (!!interpreterProxy->failed())
- #define success(bool) (interpreterProxy->success(bool))
- #define arrayValueOf(oop) (interpreterProxy->arrayValueOf(oop))
- #define checkedIntegerValueOf(oop) (interpreterProxy->checkedIntegerValueOf(oop))
- #define fetchArrayofObject(idx,oop) (interpreterProxy->fetchArrayofObject(idx,oop))
- #define fetchFloatofObject(idx,oop) (interpreterProxy->fetchFloatofObject(idx,oop))
- #define fetchIntegerofObject(idx,oop) (interpreterProxy->fetchIntegerofObject(idx,oop))
- #define floatValueOf(oop) (interpreterProxy->floatValueOf(oop))
- #define pop(n) (interpreterProxy->pop(n))
- #define pushInteger(n) (interpreterProxy->pushInteger(n))
- #define sizeOfSTArrayFromCPrimitive(cPtr) (interpreterProxy->sizeOfSTArrayFromCPrimitive(cPtr))
- #define storeIntegerofObjectwithValue(idx,oop,value) (interpreterProxy->storeIntegerofObjectwithValue(idx,oop,value))
- #define primitiveFail() interpreterProxy->primitiveFail()
/* allows accessing Strings in both C and Smalltalk */
#define asciiValue(c) c
+
+ '!
- '.
- aStream cr.!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>generateInterpreterProxyFunctionDeference:on:indent: (in category 'C translation') -----
+ generateInterpreterProxyFunctionDeference: aNode on: aStream indent: anInteger
+ | pluginsToClone |
+ (pluginsToClone := self pluginFunctionsToClone) isEmpty ifTrue:
+ [^self].
+ aStream cr; nextPutAll: '#if !!defined(SQUEAK_BUILTIN_PLUGIN)'.
+ pluginsToClone do:
+ [:s| | cs |
+ cs := self cFunctionNameFor: s.
+ aStream crtab: anInteger; nextPutAll: cs; nextPutAll: ' = interpreterProxy->'; nextPutAll: cs; nextPut: $;].
+ aStream cr; nextPutAll: '#endif /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'.!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>initialize (in category 'public') -----
+ initialize
+ super initialize.
+ pluginFunctionsUsed := Set new!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>initializeCTranslationDictionary (in category 'public') -----
+ initializeCTranslationDictionary
+ "Initialize the dictionary mapping message names to actions for C code generation."
+
+ super initializeCTranslationDictionary.
+ translationDict
+ at: #expandDereferenceInterpreterProxyFunctionTable
+ put: #generateInterpreterProxyFunctionDeference:on:indent:!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>noteUsedPluginFunction: (in category 'public') -----
+ noteUsedPluginFunction: aSelector
+ "Remember aSelector and answer whether the call should be made through
+ interpreterProxy. If not, it will be made either directly (in an internal plugin)
+ or through a local copy of the function pointer (in an external plugin)."
+ pluginFunctionsUsed add: aSelector.
+ "These two are static to sqVirtualMachine.c and so
+ they must be called through the interpreterProxy."
+ ^#(majorVersion minorVersion) includes: aSelector!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>pluginFunctionsToClone (in category 'public') -----
+ pluginFunctionsToClone
+ "Answer those of the used plugin functions to clone as a sorted collection.
+ Exclude those that are static to sqVirtualMachine.c and hence always need
+ to be called through interpreterProxy."
+
+ ^(pluginFunctionsUsed reject:
+ [:selector| self noteUsedPluginFunction: selector])
+ asSortedCollection!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>preDeclareInterpreterProxyOn: (in category 'C code generator') -----
+ preDeclareInterpreterProxyOn: aStream
+ "Put the necessary #defines needed before interpreterProxy. Basically
+ internal plugins use the VM's interpreterProxy variable and external plugins
+ use their own. Override to keep local copies of all functions in external
+ prims, and link directly in internal plugins."
+ | pluginsToClone |
+ (pluginsToClone := self pluginFunctionsToClone) isEmpty ifTrue:
+ [^super preDeclareInterpreterProxyOn: aStream].
+ aStream cr; nextPutAll: '#if !!defined(SQUEAK_BUILTIN_PLUGIN)'; cr.
+ pluginsToClone do:
+ [:selector| | functionName |
+ functionName := self cFunctionNameFor: selector.
+ aStream nextPutAll:
+ ((String streamContents:
+ [:s|
+ (self compileToTMethodSelector: selector in: InterpreterProxy)
+ emitCFunctionPrototype: s generator: self])
+ copyReplaceAll: functionName
+ with: '(*', functionName, ')').
+ aStream nextPut: $;; cr].
+ aStream nextPutAll: '#else /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'; cr.
+ pluginsToClone do:
+ [:selector|
+ aStream nextPutAll: 'extern '.
+ (self compileToTMethodSelector: selector in: InterpreterProxy)
+ static: false;
+ emitCFunctionPrototype: aStream generator: self.
+ aStream nextPut: $;; cr].
+ aStream cr; nextPutAll: 'extern'.
+ aStream cr; nextPutAll: '#endif'; cr!
More information about the Vm-dev
mailing list