[Vm-dev] VM Maker: VMMaker.oscog-tfel.1680.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Feb 15 11:48:23 UTC 2016
Tim Felgentreff uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-tfel.1680.mcz
==================== Summary ====================
Name: VMMaker.oscog-tfel.1680
Author: tfel
Time: 15 February 2016, 12:46:35.512 pm
UUID: 55139d69-7f8f-7849-95ca-900810aadddc
Ancestors: VMMaker.oscog-tfel.1677, VMMaker.oscog-eem.1679
merge
=============== Diff against VMMaker.oscog-tfel.1677 ===============
Item was changed:
----- Method: CCodeGenerator>>addConstantForBinding: (in category 'public') -----
addConstantForBinding: variableBinding
"Add the pool variable to the code base as a constant."
| node val |
val := variableBinding value.
node := (useSymbolicConstants and: [self isCLiteral: val])
ifTrue:[TDefineNode new
+ setName: variableBinding key
- setName: variableBinding key asString
value: variableBinding value]
ifFalse:[TConstantNode new setValue: variableBinding value].
+ constants at: variableBinding key put: node!
- constants at: variableBinding key asString put: node!
Item was changed:
----- Method: CCodeGenerator>>addPoolVarsFor: (in category 'public') -----
addPoolVarsFor: aClass
"Add the pool variables for the given class to the code base as constants."
(aClass sharedPools reject: [:pool| pools includes: pool]) do:
[:pool |
pools add: pool.
+ pool bindingsDo:
+ [:binding |
+ self addConstantForBinding: binding]]!
- pool bindingsDo: [:assoc | | val node |
- val := assoc value.
- node := (useSymbolicConstants and:[self isCLiteral: val])
- ifTrue:[TDefineNode new setName: assoc key asString value: assoc value]
- ifFalse:[TConstantNode new setValue: assoc value].
- constants at: assoc key asString put: node]].!
Item was changed:
----- Method: CCodeGenerator>>checkClassForNameConflicts: (in category 'error notification') -----
checkClassForNameConflicts: aClass
"Verify that the given class does not have constant, variable, or method names that conflict with
those of previously added classes. Raise an error if a conflict is found, otherwise just return."
"check for constant name collisions in class pools"
aClass classPool associationsDo:
[:assoc |
+ (constants includesKey: assoc key) ifTrue:
- (constants includesKey: assoc key asString) ifTrue:
[self error: 'Constant ', assoc key, ' was defined in a previously added class']].
"and in shared pools"
(aClass sharedPools reject: [:pool| pools includes: pool]) do:
[:pool |
pool bindingsDo:
[:assoc |
+ (constants includesKey: assoc key) ifTrue:
- (constants includesKey: assoc key asString) ifTrue:
[self error: 'Constant ', assoc key, ' was defined in a previously added class']]].
"check for instance variable name collisions"
(aClass inheritsFrom: VMStructType) ifFalse:
[(self instVarNamesForClass: aClass) do:
[:varName |
(variables includes: varName) ifTrue:
[self error: 'Instance variable ', varName, ' was defined in a previously added class']]].
"check for method name collisions"
aClass selectors do:
[:sel | | tmeth meth |
((self shouldIncludeMethodFor: aClass selector: sel)
and: [(tmeth := methods at: sel ifAbsent: nil) notNil
and: [(aClass isStructClass and: [(aClass isAccessor: sel)
and: [(methods at: sel) isStructAccessor]]) not
and: [(meth := aClass >> sel) isSubclassResponsibility not
and: [(aClass includesBehavior: tmeth definingClass) not]]]]) ifTrue:
[((aClass >>sel) pragmaAt: #option:)
ifNil: [self error: 'Method ', sel, ' was defined in a previously added class.']
ifNotNil:
[logger
ensureCr;
show: 'warning, method ', aClass name, '>>', sel storeString,
' overrides ', tmeth definingClass, '>>', sel storeString;
cr]]]!
Item was changed:
----- Method: CCodeGenerator>>const:declareC: (in category 'public') -----
const: constName declareC: declarationString
"Record the given C declaration for a constant."
constants
+ at: constName
- at: constName asString
put: (TDefineNode new
+ setName: constName
- setName: constName asString
value: declarationString)!
Item was changed:
----- Method: CCodeGenerator>>emitCConstants:on: (in category 'C code generator') -----
emitCConstants: constList on: aStream
"Store the global variable declarations on the given stream."
constList isEmpty ifTrue: [^self].
aStream cr; nextPutAll: '/*** Constants ***/'; cr.
(self sortStrings: constList) do:
[:varName| | node default value conditional |
node := constants at: varName.
node name isEmpty ifFalse:
["If the definition includes a C comment, take it as is, otherwise convert the value from Smalltalk to C.
Allow the class to provide an alternative definition, either of just the value or the whole shebang."
default := (node value isString and: [node value includesSubString: '/*'])
ifTrue: [node value]
ifFalse: [self cLiteralFor: node value name: varName].
default = #undefined
ifTrue: [aStream nextPutAll: '#undef '; nextPutAll: node name; cr]
ifFalse:
+ [conditional := VMBasicConstants defineAtCompileTime: node name.
+ conditional ifTrue:
- [conditional := VMBasicConstants namesDefinedAtCompileTime includes: node name.
- conditional ifTrue:
[aStream nextPutAll: '#if !!defined('; nextPutAll: node name; nextPutAll: ') /* Allow this to be overridden on the compiler command line */'; cr].
+ value := vmClass
- value := vmClass
ifNotNil:
[(vmClass specialValueForConstant: node name default: default)
ifNotNil: [:specialDef| specialDef]
ifNil: [default]]
ifNil: [default].
value first ~= $# ifTrue:
+ [aStream nextPutAll: (conditional ifTrue: ['# define '] ifFalse: ['#define ']); nextPutAll: node name; space].
- [aStream nextPutAll: '#define '; nextPutAll: node name; space].
aStream nextPutAll: value; cr.
conditional ifTrue:
[aStream nextPutAll: '#endif'; cr]]]].
aStream cr!
Item was changed:
----- Method: CCodeGenerator>>emitCFunctionPrototypes:on: (in category 'C code generator') -----
emitCFunctionPrototypes: methodList on: aStream
"Store prototype declarations for all non-inlined methods on the given stream.
Add a define for a NoDbgRegParms attribute for static functions used for debugging.
gcc and other compilers will use non-standard calling conventions for static functions
when optimizing. The optimization can render the functions unusable in gdb. The sqConfig.h
file for the platform should define PlatformNoDbgRegParms suitably for the platform's
compiler, if the compiler can be persuaded not to generate such functions.
Add a define for a NeverInline attribute that tells the compiler never to inline functions
with the attribute. We mark functions we want to observe in a profiler as NeverInline.
The sqConfig.h file for the platform should define NeverInline suitably for the platform's
compiler, if the compiler can be persuaded not to inline certain functions."
aStream cr; nextPutAll: '/*** Function Prototypes ***/'; cr.
vmClass ifNotNil:
[NoRegParmsInAssertVMs ifTrue:
[aStream nextPutAll: '\\#if !!PRODUCTION && defined(PlatformNoDbgRegParms)\# define NoDbgRegParms PlatformNoDbgRegParms\#endif' withCRs.
aStream nextPutAll: '\\#if !!defined(NoDbgRegParms)\# define NoDbgRegParms /*empty*/\#endif\\' withCRs].
aStream nextPutAll: '\\#if !!defined(NeverInline)\# define NeverInline /*empty*/\#endif\\' withCRs].
(methodList select: [:m| m isRealMethod and: [self shouldGenerateMethod: m]]) do:
[:m |
vmClass ifNotNil:
[(NoRegParmsInAssertVMs and: [m export not and: [m isStatic and: [m args notEmpty]]]) ifTrue:
[m addFunctionAttribute: 'NoDbgRegParms'].
m inline == #never ifTrue:
[m addFunctionAttribute: 'NeverInline']].
+ m emitCFunctionPrototype: aStream generator: self].
- m emitCFunctionPrototype: aStream generator: self.
- aStream nextPut: $; ; cr].
aStream cr!
Item was changed:
----- Method: CCodeGenerator>>emitExportsNamed:pluginName:on: (in category 'C code generator') -----
emitExportsNamed: exportsNamePrefix pluginName: pluginName on: aStream
"Store all the exported primitives in the form used by the internal named prim system."
| nilVMClass excludeDepth |
+ (nilVMClass := vmClass isNil) ifTrue: "We need a vmClass temporarily to compute accessor depths."
- (nilVMClass := vmClass isNil) ifTrue:
[vmClass := StackInterpreter].
"Don't include the depth in the vm's named primitives if the vm is non-Spur."
excludeDepth := exportsNamePrefix = 'vm'
and: [pluginName isEmpty
and: [vmClass objectMemoryClass hasSpurMemoryManagerAPI not]].
+ aStream cr; cr; nextPutAll: 'void* '; nextPutAll: exportsNamePrefix; nextPutAll: '_exports[][3] = {'; cr.
+ ((methods select: [:m| m export]) asSortedCollection: [:a :b| a selector caseSensitiveLessOrEqual: b selector]) do:
+ [:method| | compileTimeOptionPragmas primName |
+ (compileTimeOptionPragmas := method compileTimeOptionPragmas) notEmpty ifTrue:
+ [method outputConditionalDefineFor: compileTimeOptionPragmas on: aStream].
+ primName := self cFunctionNameFor: method selector.
+ aStream tab; nextPutAll: '{"'; nextPutAll: pluginName; nextPutAll: '", "'; nextPutAll: primName.
- aStream cr; cr; nextPutAll: 'void* '; nextPutAll: exportsNamePrefix; nextPutAll: '_exports[][3] = {'.
- (self sortStrings: self exportedPrimitiveNames) do:
- [:primName|
- aStream cr; tab;
- nextPutAll: '{"';
- nextPutAll: pluginName;
- nextPutAll: '", "';
- nextPutAll: primName.
excludeDepth ifFalse:
[(self accessorDepthForSelector: primName asSymbol) ifNotNil:
[:depth| "store the accessor depth in a hidden byte immediately after the primName"
self assert: depth < 128.
aStream
nextPutAll: '\000\';
nextPutAll: ((depth bitAnd: 255) printStringBase: 8 nDigits: 3)]].
+ aStream nextPutAll: '", (void*)'; nextPutAll: primName; nextPutAll: '},'; cr.
+ method terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream].
+ aStream tab; nextPutAll: '{NULL, NULL, NULL}'; cr; nextPutAll: '};'; cr.
- aStream
- nextPutAll: '", (void*)';
- nextPutAll: primName;
- nextPutAll: '},'].
- aStream cr; tab; nextPutAll: '{NULL, NULL, NULL}'; cr; nextPutAll: '};'; cr.
nilVMClass ifTrue:
[vmClass := nil]!
Item was changed:
----- Method: CCodeGenerator>>exportedPrimitiveNames (in category 'public') -----
exportedPrimitiveNames
"Return an array of all exported primitives"
+ ^methods select:[:m| m export] thenCollect:[:m| self cFunctionNameFor: m selector].
- ^methods select:[:m| m export] thenCollect:[:m| m selector copyWithout: $:].
!
Item was changed:
----- Method: CCodeGenerator>>isConstantNode:valueInto: (in category 'utilities') -----
isConstantNode: aNode valueInto: aBlock
"Answer if aNode evaluates to a constant, and if so, evaluate aBlock with the value of that constant."
aNode isConstant ifTrue:
[(aNode isDefine
+ and: [VMBasicConstants defineAtCompileTime: aNode name]) ifTrue:
- and: [VMBasicConstants namesDefinedAtCompileTime includes: aNode name]) ifTrue:
[^false].
aBlock value: aNode value.
^true].
(aNode isVariable
and: [aNode name = #nil]) ifTrue:
[aBlock value: nil.
^true].
aNode isSend ifFalse:
[^false].
(self anyMethodNamed: aNode selector)
ifNil:
[(VMBasicConstants valueOfBasicSelector: aNode selector) ifNotNil:
[:value|
aBlock value: value.
^true]]
ifNotNil:
[:m|
(m statements size = 1
and: [m statements last isReturn]) ifTrue:
[^self isConstantNode: m statements last expression valueInto: aBlock]].
^false!
Item was changed:
----- Method: CCodeGenerator>>nilOrBooleanConditionFor: (in category 'utilities') -----
nilOrBooleanConditionFor: nodeOrNil
"If nodeOrNil is one of the conditional sends for which we do translation-time dead code elimination
(i.e. cppIf:ifTrue: et al or ifTrue: et al) and the conditional does evaluate to a translation-time
boolean constant, answer that constant, otherwise answer nil. Used to prune dead code,
+ either for code generaton or dead variable elimination."
+ generateDeadCode ifTrue: [^nil].
- either for code egenraton or dead variable elimination."
nodeOrNil ifNil:
[^nil].
nodeOrNil isSend ifFalse:
[^nil].
(#(cppIf:ifTrue: cppIf:ifTrue:ifFalse:) includes: nodeOrNil selector) ifTrue:
+ [(vmClass notNil
+ and: [nodeOrNil args first isConstant
+ and: [nodeOrNil args first value isSymbol
+ and: [(VMBasicConstants defineAtCompileTime: nodeOrNil args first value) not
+ and: [(vmClass bindingOf: nodeOrNil args first value) notNil]]]]) ifTrue:
+ [self logger
+ nextPutAll: 'Warning: cppIf: reference to ';
+ store: nodeOrNil args first value;
+ nextPutAll: ' when variable of same name exists.'; cr].
+
+ ^(optionsDictionary notNil
- [^(optionsDictionary notNil
and: [nodeOrNil args first isConstant
and: [#(true false) includes: (optionsDictionary at: nodeOrNil args first name ifAbsent: [nil])]]) ifTrue:
[optionsDictionary at: nodeOrNil args first name]].
^(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: nodeOrNil selector) ifTrue:
[self nilOrBooleanConstantReceiverOf: nodeOrNil]!
Item was changed:
----- Method: CCodeGenerator>>optionIsTrue:in: (in category 'utilities') -----
optionIsTrue: pragma in: aClass
"Answer whether an option: or notOption: pragma is true in the context of aClass.
The argument to the option: pragma is interpreted as either a Cogit class name
or a class variable name or a variable name in VMBasicConstants."
| key |
key := pragma argumentAt: 1.
+
+ "If the option is one to be defined at compile time we'll generate a
+ conditional around its declaration and definition."
+ (VMBasicConstants defineAtCompileTime: key) ifTrue:
+ [^true].
+
"If the option is the name of a subclass of Cogit, include it if it inherits from the Cogit class."
(Smalltalk classNamed: key) ifNotNil:
[:optionClass|
aClass cogitClass ifNotNil:
[:cogitClass|
(optionClass includesBehavior: Cogit) ifTrue:
[^cogitClass includesBehavior: optionClass]].
aClass objectMemoryClass ifNotNil:
[:objectMemoryClass|
((optionClass includesBehavior: ObjectMemory)
or: [optionClass includesBehavior: SpurMemoryManager]) ifTrue:
[^objectMemoryClass includesBehavior: optionClass]]].
"Lookup options in options, class variables of the defining class, VMBasicConstants, the interpreterClass and the objectMemoryClass"
{aClass initializationOptions.
aClass.
VMBasicConstants.
aClass interpreterClass.
aClass objectMemoryClass} do:
[:scopeOrNil|
scopeOrNil ifNotNil:
[:scope|
(scope bindingOf: key) ifNotNil:
[:binding|
binding value ~~ false ifTrue: [^true]]]].
^false!
Item was changed:
----- Method: CoInterpreter>>findNewMethodInClassTag: (in category 'message sending') -----
findNewMethodInClassTag: classTagArg
"Find the compiled method to be run when the current messageSelector is
sent to the given classTag, setting the values of newMethod and primitiveIndex."
| ok classTag |
<inline: false>
ok := self lookupInMethodCacheSel: messageSelector classTag: classTagArg.
ok ifTrue:
[self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]
ifFalse:
["entry was not found in the cache; perhaps soemthing was forwarded."
classTag := classTagArg.
((objectMemory isOopForwarded: messageSelector)
or: [objectMemory isForwardedClassTag: classTag]) ifTrue:
[(objectMemory isOopForwarded: messageSelector) ifTrue:
[messageSelector := self handleForwardedSelectorFaultFor: messageSelector].
(objectMemory isForwardedClassTag: classTag) ifTrue:
[classTag := self handleForwardedSendFaultForTag: classTag].
ok := self lookupInMethodCacheSel: messageSelector classTag: classTag.
ok ifTrue:
[^self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]].
"entry was not found in the cache; look it up the hard way "
lkupClass := objectMemory classForClassTag: classTag.
+ NewspeakVM
- self cppIf: #NewspeakVM
ifTrue: [self lookupOrdinarySend]
ifFalse: [self lookupMethodInClass: lkupClass].
self addNewMethodToCache: lkupClass]!
Item was changed:
----- Method: CoInterpreter>>lookupMNU:receiver: (in category 'cog jit support') -----
lookupMNU: selector receiver: rcvr
<api>
"Lookup selector in rcvr, without doing MNU processing, and answer either a
method or an error code if the message was not understood. Used to populate closed PICs."
| classTag inCache erridx |
"self printFrame: stackPage headFP WithSP: stackPage headSP"
"self printStringOf: selector"
classTag := objectMemory fetchClassTagOf: rcvr.
+ NewspeakVM
- self cppIf: #NewspeakVM
ifTrue:
+ [inCache := self
+ inlineLookupInNSMethodCacheSel: selector
+ classTag: classTag
+ method: 0
+ lookupRule: LookupRuleMNU]
- [inCache := (self
- inlineLookupInNSMethodCacheSel: selector
- classTag: classTag
- method: 0
- lookupRule: LookupRuleMNU)]
ifFalse:
[inCache := self lookupInMethodCacheSel: selector classTag: classTag].
inCache ifFalse:
[messageSelector := selector.
erridx := self lookupMNUInClass: (objectMemory classForClassTag: classTag).
erridx ~= 0 ifTrue:
[self assert: erridx <= self maxLookupNoMNUErrorCode.
^erridx]].
^newMethod!
Item was changed:
----- Method: Cogit>>maybeAllocAndInitIRCs (in category 'newspeak support') -----
maybeAllocAndInitIRCs
"If this is the Newspeak VM and the objectRepresentation supports pinning
then allocate space for the implicit receiver caches on the heap."
+ NewspeakVM
- self cppIf: #NewspeakVM
ifTrue:
[indexOfIRC := theIRCs := 0.
(objectRepresentation canPinObjects and: [numIRCs > 0]) ifTrue:
[self assert: (self noAssertMethodClassAssociationOf: methodObj) ~= objectMemory nilObject.
theIRCs := objectRepresentation allocateNPinnedSlots: numIRCs * NumOopsPerNSC.
^theIRCs ~= 0].
^true]
ifFalse:
[^true]!
Item was changed:
----- Method: Cogit>>maybeMarkIRCsIn: (in category 'newspeak support') -----
maybeMarkIRCsIn: cogMethod
<inline: true>
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[objectRepresentation canPinObjects ifTrue:
[objectRepresentation markIfIRC: cogMethod nextMethodOrIRCs]]!
Item was changed:
----- Method: Cogit>>scanMethod (in category 'compile abstract instructions') -----
scanMethod
"Scan the method (and all embedded blocks) to determine
- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
- if the method needs a frame or not
- what are the targets of any backward branches.
- how many blocks it creates
- if it contans an unknown bytecode
Answer the block count or on error a negative error code"
| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
<var: #descriptor type: #'BytecodeDescriptor *'>
needsFrame := false.
inBlock := false.
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[numIRCs := 0].
(primitiveIndex > 0
and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
[^0].
pc := latestContinuation := initialPC.
numBlocks := framelessStackDelta := nExts := extA := extB := 0.
[pc <= endPC] whileTrue:
[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
descriptor := self generatorAt: byte0.
descriptor isExtension ifTrue:
[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
[^EncounteredUnknownBytecode].
self loadSubsequentBytesForDescriptor: descriptor at: pc.
self perform: descriptor generator].
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[endPC := pc].
needsFrame ifFalse:
[(descriptor needsFrameFunction isNil
or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
ifTrue: [needsFrame := true]
ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
descriptor isBranch ifTrue:
[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
(self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
ifTrue: [self initializeFixupAt: targetPC - initialPC]
ifFalse: [latestContinuation := latestContinuation max: targetPC]].
descriptor isBlockCreation ifTrue:
[numBlocks := numBlocks + 1.
distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
latestContinuation := latestContinuation max: targetPC].
+ self cppIf: NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[descriptor hasIRC ifTrue:
[numIRCs := numIRCs + 1]].
pc := pc + descriptor numBytes.
descriptor isExtension
ifTrue: [nExts := nExts + 1]
ifFalse: [nExts := extA := extB := 0]].
^numBlocks!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveGetImmutability (in category 'object access primitives') -----
primitiveGetImmutability
+ self cppIf: #IMMUTABILITY
+ ifTrue:
+ [| rcvr |
+ rcvr := self stackValue: 0.
+ self pop: argumentCount + 1 thenPushBool: (objectMemory isOopImmutable: rcvr)]
+ ifFalse:
+ [self primitiveFailFor: PrimErrUnsupported]!
- <option: #IMMUTABILITY>
- | rcvr bool |
- rcvr := self stackValue: 0.
- bool := (objectMemory isOopImmutable: rcvr)
- ifTrue: [ TrueObject ]
- ifFalse: [ FalseObject ].
- self pop: argumentCount + 1 thenPush: (objectMemory splObj: bool)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSetImmutability (in category 'object access primitives') -----
primitiveSetImmutability
+ self cppIf: #IMMUTABILITY
+ ifTrue:
+ [| rcvr wasImmutable |
+ rcvr := self stackValue: 1.
+ (objectMemory isImmediate: rcvr) ifTrue:
+ [^self primitiveFailFor: PrimErrBadReceiver].
+ wasImmutable := objectMemory isObjImmutable: rcvr.
+ self stackTop = objectMemory trueObject
+ ifTrue:
+ [(self canBeImmutable: rcvr) ifFalse:
+ [^self primitiveFailFor: PrimErrInappropriate].
+ objectMemory setIsImmutableOf: rcvr to: true]
+ ifFalse: [
+ self stackTop = objectMemory falseObject
+ ifTrue: [objectMemory setIsImmutableOf: rcvr to: false]
+ ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument]].
+ self pop: argumentCount + 1 thenPushBool: wasImmutable]
+ ifFalse:
+ [self primitiveFailFor: PrimErrUnsupported]!
- <option: #IMMUTABILITY>
- | rcvr boolean wasImmutable |
- rcvr := self stackValue: 1.
- (objectMemory isImmediate: rcvr) ifTrue:
- [^self primitiveFailFor: PrimErrBadReceiver].
- boolean := self booleanValueOf: self stackTop.
- self successful ifFalse:
- [^self primitiveFailFor: PrimErrBadArgument].
- boolean ifTrue:
- [(self canBeImmutable: rcvr) ifFalse:
- [^self primitiveFailFor: PrimErrInappropriate]].
- wasImmutable := objectMemory booleanObjectOf: (objectMemory isOopImmutable: rcvr).
- objectMemory setIsImmutableOf: rcvr to: boolean.
- self pop: argumentCount + 1 thenPush: wasImmutable!
Item was changed:
----- Method: SimpleStackBasedCogit>>compileFrameBuild (in category 'compile abstract instructions') -----
compileFrameBuild
"Build a frame for a CogMethod activation. See CoInterpreter class>>initializeFrameIndices.
receiver (in ReceiverResultReg)
arg0
...
argN
caller's saved ip/this stackPage (for a base frame)
fp-> saved fp
method
context (uninitialized?)
receiver
first temp
...
sp-> Nth temp
If there is a primitive and an error code the Nth temp is the error code.
Ensure SendNumArgsReg is set early on (incidentally to nilObj) because
it is the flag determining whether context switch is allowed on stack-overflow."
| jumpSkip |
<inline: false>
<var: #jumpSkip type: #'AbstractInstruction *'>
needsFrame ifFalse: [^self].
backEnd hasLinkRegister ifTrue: [self PushR: LinkReg].
self PushR: FPReg.
self MoveR: SPReg R: FPReg.
methodLabel addDependent: (self annotateAbsolutePCRef:
(self PushCw: methodLabel asInteger)). "method"
self genMoveConstant: objectMemory nilObject R: SendNumArgsReg.
self PushR: SendNumArgsReg. "context"
self PushR: ReceiverResultReg.
methodOrBlockNumArgs + 1 to: (coInterpreter temporaryCountOfMethodHeader: methodHeader) do:
[:i|
self PushR: SendNumArgsReg].
(self methodUsesPrimitiveErrorCode: methodObj header: methodHeader) ifTrue:
[self compileGetErrorCode].
self MoveAw: coInterpreter stackLimitAddress R: TempReg.
self CmpR: TempReg R: SPReg. "N.B. FLAGS := SPReg - TempReg"
"If we can't context switch for this method, use a slightly
slower overflow check that clears SendNumArgsReg."
(coInterpreter canContextSwitchIfActivating: methodObj header: methodHeader)
ifTrue:
[self JumpBelow: stackOverflowCall.
stackCheckLabel := self Label]
ifFalse:
[jumpSkip := self JumpAboveOrEqual: 0.
self MoveCq: 0 R: SendNumArgsReg.
self Jump: stackOverflowCall.
jumpSkip jmpTarget: (stackCheckLabel := self Label)].
self annotateBytecode: stackCheckLabel.
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[numIRCs > 0 ifTrue:
[self PrefetchAw: theIRCs]]!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
compileBlockBodies
"override to maintain counterIndex when recompiling blocks; sigh."
<inline: false>
| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
initialStackPtr initialOpcodeIndex initialCounterIndex initialIndexOfIRC |
<var: #blockStart type: #'BlockStart *'>
self assert: blockCount > 0.
"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
savedNeedsFrame := needsFrame.
savedNumArgs := methodOrBlockNumArgs.
savedNumTemps := methodOrBlockNumTemps.
inBlock := true.
compiledBlocksCount := 0.
[compiledBlocksCount < blockCount] whileTrue:
[blockStart := self blockStartAt: compiledBlocksCount.
self scanBlock: blockStart.
initialOpcodeIndex := opcodeIndex.
initialCounterIndex := counterIndex.
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[initialIndexOfIRC := indexOfIRC].
[self compileBlockEntry: blockStart.
initialStackPtr := simStackPtr.
(result := self compileAbstractInstructionsFrom: blockStart startpc + (self pushNilSize: methodObj numInitialNils: blockStart numInitialNils)
through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
[^result].
"If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
estimated the number of initial nils (because it assumed one or more pushNils to
produce an operand were pushNils to initialize temps. This is very rare, so
compensate by checking, adjusting numInitialNils and recompiling the block body.
N.B. No need to reinitialize the literalsManager because it answers existing literals."
initialStackPtr = simStackPtr]
whileFalse:
[self assert: initialStackPtr > simStackPtr.
blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
blockStart fakeHeader dependent: nil.
self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
through: blockStart startpc + blockStart span - 1.
self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
[:i| abstractOpcodes at: i put: (CogCompilerClass for: self)]].
opcodeIndex := initialOpcodeIndex.
counterIndex := initialCounterIndex.
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[indexOfIRC := initialIndexOfIRC]].
compiledBlocksCount := compiledBlocksCount + 1].
needsFrame := savedNeedsFrame.
methodOrBlockNumArgs := savedNumArgs.
methodOrBlockNumTemps := savedNumTemps.
^0!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>scanMethod (in category 'compile abstract instructions') -----
scanMethod
"Scan the method (and all embedded blocks) to determine
- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
- if the method needs a frame or not
- what are the targets of any backward branches.
- how many blocks it creates
- how many counters it needs/conditional branches it contains
Answer the block count or on error a negative error code"
| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
<var: #descriptor type: #'BytecodeDescriptor *'>
needsFrame := false.
inBlock := false.
prevBCDescriptor := nil.
numCounters := 0.
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[numIRCs := 0].
(primitiveIndex > 0
and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
[^0].
pc := latestContinuation := initialPC.
numBlocks := framelessStackDelta := nExts := extA := extB := 0.
[pc <= endPC] whileTrue:
[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
descriptor := self generatorAt: byte0.
descriptor isExtension ifTrue:
[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
[^EncounteredUnknownBytecode].
self loadSubsequentBytesForDescriptor: descriptor at: pc.
self perform: descriptor generator].
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[endPC := pc].
needsFrame ifFalse:
[(descriptor needsFrameFunction isNil
or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
ifTrue: [needsFrame := true]
ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
descriptor isBranch ifTrue:
[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
(self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
ifTrue: [self initializeFixupAt: targetPC - initialPC]
ifFalse:
[latestContinuation := latestContinuation max: targetPC.
(descriptor isBranchTrue or: [descriptor isBranchFalse]) ifTrue:
[numCounters := numCounters + 1]]].
descriptor isBlockCreation ifTrue:
[numBlocks := numBlocks + 1.
distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
latestContinuation := latestContinuation max: targetPC].
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[descriptor hasIRC ifTrue:
[numIRCs := numIRCs + 1]].
pc := pc + descriptor numBytes.
descriptor isExtension
ifTrue: [nExts := nExts + 1]
ifFalse: [nExts := extA := extB := 0].
prevBCDescriptor := descriptor].
^numBlocks!
Item was changed:
----- Method: StackInterpreter>>findNewMethodInClassTag: (in category 'message sending') -----
findNewMethodInClassTag: classTagArg
"Find the compiled method to be run when the current
messageSelector is sent to the given class, setting the values
of 'newMethod' and 'primitiveIndex'."
| ok classTag |
<inline: false>
ok := self lookupInMethodCacheSel: messageSelector classTag: classTagArg.
ok ifFalse: "entry was not found in the cache; look it up the hard way "
[classTag := classTagArg.
((objectMemory isOopForwarded: messageSelector)
or: [objectMemory isForwardedClassTag: classTag]) ifTrue:
[(objectMemory isOopForwarded: messageSelector) ifTrue:
[messageSelector := self handleForwardedSelectorFaultFor: messageSelector].
(objectMemory isForwardedClassTag: classTag) ifTrue:
[classTag := self handleForwardedSendFaultForTag: classTag].
ok := self lookupInMethodCacheSel: messageSelector classTag: classTag.
ok ifTrue:
[^nil]].
lkupClass := objectMemory classForClassTag: classTag.
+ NewspeakVM
- self cppIf: #NewspeakVM
ifTrue: [self lookupOrdinarySend]
ifFalse: [self lookupMethodInClass: lkupClass].
self addNewMethodToCache: lkupClass]!
Item was changed:
----- Method: StackInterpreter>>lookupMNUInClass: (in category 'message sending') -----
lookupMNUInClass: class
"Lookup messageSelector in class. Answer 0 on success. Answer the splObj: index
for the error selector to use on failure rather than performing MNU processing etc."
| currentClass dictionary found |
<inline: false>
currentClass := class.
[currentClass ~= objectMemory nilObject] whileTrue:
[dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
dictionary = objectMemory nilObject ifTrue:
[lkupClass := self superclassOf: currentClass.
^SelectorCannotInterpret].
found := self lookupMethodInDictionary: dictionary.
+ NewspeakVM
- self cppIf: #NewspeakVM
ifTrue: [found ifTrue: [lkupClass := class. self addNewMethodToNSCache: LookupRuleMNU. ^0]]
ifFalse: [found ifTrue: [self addNewMethodToCache: class. ^0]].
currentClass := self superclassOf: currentClass].
lkupClass := class.
^SelectorDoesNotUnderstand!
Item was changed:
----- Method: StackInterpreter>>lookupOrdinaryNoMNUEtcInClass: (in category 'message sending') -----
lookupOrdinaryNoMNUEtcInClass: class
"Lookup messageSelector in class. Answer 0 on success. Answer the splObj: index
for the error selector to use on failure rather than performing MNU processing etc."
| currentClass dictionary found |
<inline: false>
currentClass := class.
[currentClass ~= objectMemory nilObject] whileTrue:
[dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
dictionary = objectMemory nilObject ifTrue:
[lkupClass := self superclassOf: currentClass.
^SelectorCannotInterpret].
found := self lookupMethodInDictionary: dictionary.
+ NewspeakVM
- self cppIf: #NewspeakVM
ifTrue:
[found ifTrue:
[(self isPublicMethod: newMethod) ifTrue:
[self addNewMethodToCache: class. ^0].
(self isProtectedMethod: newMethod) ifTrue:
[lkupClass := class. ^SelectorDoesNotUnderstand]]]
ifFalse:
[found ifTrue:
[self addNewMethodToCache: class. ^0]].
currentClass := self superclassOf: currentClass].
lkupClass := class.
^SelectorDoesNotUnderstand!
Item was changed:
----- Method: StackToRegisterMappingCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
compileBlockBodies
<inline: false>
| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
initialStackPtr initialOpcodeIndex initialIndexOfIRC |
<var: #blockStart type: #'BlockStart *'>
self assert: blockCount > 0.
"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
savedNeedsFrame := needsFrame.
savedNumArgs := methodOrBlockNumArgs.
savedNumTemps := methodOrBlockNumTemps.
inBlock := true.
compiledBlocksCount := 0.
[compiledBlocksCount < blockCount] whileTrue:
[blockStart := self blockStartAt: compiledBlocksCount.
self scanBlock: blockStart.
initialOpcodeIndex := opcodeIndex.
literalsManager saveForBlockCompile.
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[initialIndexOfIRC := indexOfIRC].
[self compileBlockEntry: blockStart.
initialStackPtr := simStackPtr.
(result := self compileAbstractInstructionsFrom: blockStart startpc + (self pushNilSize: methodObj numInitialNils: blockStart numInitialNils)
through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
[^result].
"If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
estimated the number of initial nils (because it assumed one or more pushNils to
produce an operand were pushNils to initialize temps. This is very rare, so
compensate by checking, adjusting numInitialNils and recompiling the block body.
N.B. No need to reinitialize the literalsManager because it answers existing literals."
initialStackPtr = simStackPtr]
whileFalse:
[self assert: initialStackPtr > simStackPtr.
blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
blockStart fakeHeader dependent: nil.
self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
through: blockStart startpc + blockStart span - 1.
self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
[:i| abstractOpcodes at: i put: (CogCompilerClass for: self)]].
opcodeIndex := initialOpcodeIndex.
literalsManager resetForBlockCompile.
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[indexOfIRC := initialIndexOfIRC]].
compiledBlocksCount := compiledBlocksCount + 1].
needsFrame := savedNeedsFrame.
methodOrBlockNumArgs := savedNumArgs.
methodOrBlockNumTemps := savedNumTemps.
^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>scanMethod (in category 'compile abstract instructions') -----
scanMethod
"Scan the method (and all embedded blocks) to determine
- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
- if the method needs a frame or not
- what are the targets of any backward branches.
- how many blocks it creates
Answer the block count or on error a negative error code"
| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
<var: #descriptor type: #'BytecodeDescriptor *'>
needsFrame := false.
inBlock := false.
prevBCDescriptor := nil.
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[numIRCs := 0].
(primitiveIndex > 0
and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
[^0].
pc := latestContinuation := initialPC.
numBlocks := framelessStackDelta := nExts := extA := extB := 0.
[pc <= endPC] whileTrue:
[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
descriptor := self generatorAt: byte0.
descriptor isExtension ifTrue:
[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
[^EncounteredUnknownBytecode].
self loadSubsequentBytesForDescriptor: descriptor at: pc.
self perform: descriptor generator].
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[endPC := pc].
needsFrame ifFalse:
[(descriptor needsFrameFunction isNil
or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
ifTrue: [needsFrame := true]
ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
descriptor isBranch ifTrue:
[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
(self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
ifTrue: [self initializeFixupAt: targetPC - initialPC]
ifFalse: [latestContinuation := latestContinuation max: targetPC]].
descriptor isBlockCreation ifTrue:
[numBlocks := numBlocks + 1.
distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
latestContinuation := latestContinuation max: targetPC].
+ NewspeakVM ifTrue:
- self cppIf: #NewspeakVM ifTrue:
[descriptor hasIRC ifTrue:
[numIRCs := numIRCs + 1]].
pc := pc + descriptor numBytes.
descriptor isExtension
ifTrue: [nExts := nExts + 1]
ifFalse: [nExts := extA := extB := 0].
prevBCDescriptor := descriptor].
^numBlocks!
Item was changed:
----- Method: TDefineNode>>name (in category 'accessing') -----
name
+ ^name!
- ^name asString!
Item was added:
+ ----- Method: TMethod>>compileTimeOptionPragmas (in category 'accessing') -----
+ compileTimeOptionPragmas
+ "Answer the (possibly empty) sequence of option: or notOption: pragmas
+ whose arguments are values to be defined at compile time."
+ ^self compiledMethod pragmas select:
+ [:pragma|
+ (#option: == pragma keyword or: [#notOption: == pragma keyword])
+ and: [VMBasicConstants defineAtCompileTime: (pragma argumentAt: 1)]]!
Item was changed:
----- Method: TMethod>>compiledMethod (in category 'accessing') -----
compiledMethod
+ ^definingClass
+ compiledMethodAt: selector
+ ifAbsent: [definingClass compiledMethodAt: properties selector]!
- ^definingClass >> selector!
Item was changed:
----- Method: TMethod>>emitCCodeOn:generator: (in category 'C code generation') -----
emitCCodeOn: aStream generator: aCodeGen
"Emit C code for this method onto the given stream.
All calls to inlined methods should already have been expanded."
+ | conditional |
aCodeGen currentMethod: self.
self emitCCommentOn: aStream. "place method comment and method name before function."
aStream crtab; nextPutAll: '/* '; nextPutAll: self definingClass name; nextPutAll: '>>#'; nextPutAll: self smalltalkSelector; nextPutAll: ' */'.
aStream cr.
+ conditional := self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: false.
- self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: false.
aStream cr; nextPut: ${.
self emitCLocalsOn: aStream generator: aCodeGen.
aCodeGen
pushScope: declarations
while: [parseTree emitCCodeOn: aStream level: 1 generator: aCodeGen].
+ aStream nextPut: $}; cr.
+ conditional ifTrue:
+ [self terminateConditionalDefineFor: self compileTimeOptionPragmas on: aStream]!
- aStream nextPut: $}; cr!
Item was changed:
----- Method: TMethod>>emitCFunctionPrototype:generator: (in category 'C code generation') -----
emitCFunctionPrototype: aStream generator: aCodeGen
"Emit a C function header for this method onto the given stream."
properties ifNotNil:
[(properties at: #api: ifAbsent: []) ifNotNil:
[:pragma|
+ aStream
+ nextPutAll: (pragma argumentAt: 1);
+ nextPut: $;;
+ cr.
- aStream nextPutAll: (pragma argumentAt: 1).
^self]].
self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: true!
Item was changed:
----- Method: TMethod>>emitCFunctionPrototype:generator:isPrototype: (in category 'C code generation') -----
emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: isPrototype "<Boolean>"
+ "Emit a C function header for this method onto the given stream.
+ Answer if the method has any compileTimeOptionPragmas"
+ | compileTimeOptionPragmas returnTypeIsFunctionPointer |
+ (compileTimeOptionPragmas := self compileTimeOptionPragmas) notEmpty ifTrue:
+ [self outputConditionalDefineFor: compileTimeOptionPragmas on: aStream].
- "Emit a C function header for this method onto the given stream."
- | returnTypeIsFunctionPointer |
returnTypeIsFunctionPointer := returnType last = $)
and: [returnType includesSubString: (aCodeGen cFunctionNameFor: selector)].
export
ifTrue:
[aStream nextPutAll: 'EXPORT('; nextPutAll: returnType; nextPut: $)]
ifFalse:
[self isStatic
ifTrue: [aStream nextPutAll: 'static ']
ifFalse:
[isPrototype ifTrue:
[aStream nextPutAll: 'extern ']].
(isPrototype or: [inline ~~ #always]) ifFalse: [aStream nextPutAll: 'inline '].
aStream nextPutAll: returnType].
(functionAttributes isNil or: [returnTypeIsFunctionPointer]) ifFalse:
[aStream space; nextPutAll: functionAttributes].
isPrototype ifTrue: [aStream space] ifFalse: [aStream cr].
returnTypeIsFunctionPointer ifFalse:
[aStream
nextPutAll: (aCodeGen cFunctionNameFor: selector);
nextPut: $(.
args isEmpty
ifTrue: [aStream nextPutAll: #void]
ifFalse:
[args
do: [:arg| aStream nextPutAll: (self declarationAt: arg)]
separatedBy: [aStream nextPutAll: ', ']].
+ aStream nextPut: $)].
+ isPrototype ifTrue:
+ [aStream nextPut: $;; cr.
+ self terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream].
+ ^compileTimeOptionPragmas notEmpty!
- aStream nextPut: $)]!
Item was added:
+ ----- Method: TMethod>>outputConditionalDefineFor:on: (in category 'C code generation') -----
+ outputConditionalDefineFor: compileTimeOptionPragmas on: aStream
+ aStream nextPutAll: '#if '.
+ compileTimeOptionPragmas
+ do: [:pragma|
+ pragma keyword = #notOption: ifTrue:
+ [aStream nextPut: $!!].
+ aStream nextPutAll: (pragma argumentAt: 1)]
+ separatedBy: [aStream nextPutAll: ' && '].
+ aStream cr!
Item was added:
+ ----- Method: TMethod>>terminateConditionalDefineFor:on: (in category 'C code generation') -----
+ terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream
+ compileTimeOptionPragmas ifEmpty: [^self].
+ aStream nextPutAll: '#endif /* '.
+ compileTimeOptionPragmas
+ do: [:pragma|
+ pragma keyword = #notOption: ifTrue:
+ [aStream nextPut: $!!].
+ aStream nextPutAll: (pragma argumentAt: 1)]
+ separatedBy: [aStream nextPutAll: ' && '].
+ aStream nextPutAll: ' */'; cr!
Item was added:
+ ----- Method: VMBasicConstants class>>defineAtCompileTime: (in category 'C translation') -----
+ defineAtCompileTime: anObject
+ ^anObject isSymbol
+ and: [self namesDefinedAtCompileTime includes: anObject]!
Item was changed:
----- Method: VMClass class>>shouldIncludeMethodForSelector: (in category 'translation') -----
shouldIncludeMethodForSelector: selector
"Answer whether a primitive method should be translated. Emit a warning to the transcript if the method doesn't exist."
^(self whichClassIncludesSelector: selector)
ifNotNil:
[:c|
(c >> selector pragmaAt: #option:)
ifNotNil:
[:pragma|
+ (VMBasicConstants defineAtCompileTime: pragma arguments first)
+ or: [initializationOptions
+ at: pragma arguments first
+ ifAbsent: [(self bindingOf: pragma arguments first)
+ ifNil: [false]
+ ifNotNil: [:binding| binding value ~~ #undefined]]]]
- initializationOptions
- at: pragma arguments first
- ifAbsent: [(self bindingOf: pragma arguments first)
- ifNil: [false]
- ifNotNil: [:binding| binding value ~~ #undefined]]]
ifNil: [true]]
ifNil:
[Transcript nextPutAll: 'Cannot find implementation of '; nextPutAll: selector; nextPutAll: ' in hierarchy of '; print: self; cr; flush.
false]!
Item was changed:
----- 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)'; cr.
- aStream cr; nextPutAll: '#if !!defined(SQUEAK_BUILTIN_PLUGIN)'.
pluginsToClone do:
[:s| | cs |
cs := self cFunctionNameFor: s.
self withOptionalVerbiageFor: s
on: aStream
+ do: [aStream tab: anInteger; nextPutAll: cs; nextPutAll: ' = interpreterProxy->'; nextPutAll: cs; nextPut: $;; cr]
+ ifOptionalDo: [aStream
+ nextPutAll: '# if !!defined('; nextPutAll: cs; nextPut: $);
+ crtab: anInteger; nextPutAll: cs; nextPutAll: ' = 0;';
+ cr; nextPutAll: '# endif'; cr]].
+ aStream nextPutAll: '#endif /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'.!
- do: [aStream crtab: anInteger; nextPutAll: cs; nextPutAll: ' = interpreterProxy->'; nextPutAll: cs; nextPut: $;]].
- aStream cr; nextPutAll: '#endif /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'.!
Item was changed:
----- 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."
"| pcc |
pcc := self new.
(InterpreterProxy selectors reject: [:s| #(initialize private) includes: (InterpreterProxy whichCategoryIncludesSelector: s)]) do:
[:s| pcc noteUsedPluginFunction: s].
pcc preDeclareInterpreterProxyOn: Transcript.
Transcript flush"
| pluginFuncs interpreterClass objectMemoryClass |
(pluginFuncs := self pluginFunctionsToClone) isEmpty ifTrue:
[^super preDeclareInterpreterProxyOn: aStream].
aStream cr; nextPutAll: '#if !!defined(SQUEAK_BUILTIN_PLUGIN)'; cr.
interpreterClass := self referenceInterpreterClass.
objectMemoryClass := self referenceObjectMemoryClass.
pluginFuncs := pluginFuncs collect:
[:selector| | reference actual |
reference := self compileToTMethodSelector: selector
in: ((interpreterClass whichClassIncludesSelector: selector) ifNil:
[(objectMemoryClass whichClassIncludesSelector: selector) ifNil:
[InterpreterProxy]]).
actual := self compileToTMethodSelector: selector in: InterpreterProxy.
(reference returnType ~= actual returnType
or: [(1 to: reference args size) anySatisfy:
[:i| (reference typeFor: (reference args at: i) in: self)
~= (actual typeFor: (actual args at: i) in: self)]]) ifTrue:
[self logger
nextPutAll: 'warning, signature of InterpreterProxy>>';
nextPutAll: selector;
nextPutAll: ' does not match reference implementation.';
cr].
actual].
pluginFuncs do:
[:tMethod|
tMethod recordDeclarationsIn: self.
tMethod returnType ifNil:
[tMethod inferReturnTypeIn: self]].
-
pluginFuncs do:
+ [:tMethod| | functionName |
+ functionName := self cFunctionNameFor: tMethod selector.
+ aStream nextPutAll:
+ ((String streamContents:
+ [:s|
+ tMethod
+ static: true;
+ emitCFunctionPrototype: s generator: self])
+ copyReplaceAll: functionName
+ with: '(*', functionName, ')'
+ tokenish: [:ch| ch = $_ or: [ch isAlphaNumeric]])].
+ aStream nextPutAll: '#else /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'; cr.
- [:tMethod| self preDeclareStaticFunction: tMethod on: aStream].
- aStream cr; nextPutAll: '#else /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'.
pluginFuncs do:
+ [:tMethod|
+ self withOptionalVerbiageFor: tMethod selector
+ on: aStream
+ do: [tMethod static: false; export: false; emitCFunctionPrototype: aStream generator: self]
+ ifOptionalDo:
+ [aStream nextPutAll: '# define '.
+ (TSendNode new
+ setSelector: tMethod selector
+ receiver: (TVariableNode new setName: 'interpreterProxy')
+ arguments: (tMethod args collect: [:a| TVariableNode new setName: a]))
+ emitCCodeAsArgumentOn: aStream
+ level: 0
+ generator: self.
+ aStream nextPutAll: ' 0'; cr]].
+ aStream nextPutAll: 'extern'; cr; nextPutAll: '#endif'; cr!
- [:tMethod| self preDeclareExternFunction: tMethod on: aStream ].
- aStream cr; nextPutAll: 'extern'.
- aStream cr; nextPutAll: '#endif'; cr!
Item was changed:
----- Method: VMPluginCodeGenerator>>storeVirtualMachineProxyImplementation:on: (in category 'private') -----
storeVirtualMachineProxyImplementation: categoryList on: fileName
"Store the interpreter definitions on the given file"
| stream |
stream := FileStream newFileNamed: fileName.
stream nextPutAll:'
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "sqVirtualMachine.h"'; cr;cr.
stream nextPutAll:'/*** Function prototypes ***/'.
categoryList do:[:assoc|
stream cr; cr; nextPutAll:'/* InterpreterProxy methodsFor: ''',assoc key, ''' */'; cr.
(self sortStrings: assoc value) do:[:sel|
+ (methods at: sel) emitCFunctionPrototype: stream generator: self]].
- (methods at: sel) emitCFunctionPrototype: stream generator: self.
- stream nextPut: $;; cr]].
stream cr; nextPutAll:'struct VirtualMachine *VM = NULL;'; cr.
stream cr; nextPutAll:
'static int majorVersion(void) {
return VM_PROXY_MAJOR;
}
static int minorVersion(void) {
return VM_PROXY_MINOR;
}
struct VirtualMachine* sqGetInterpreterProxy(void)
{
if(VM) return VM;
VM = (struct VirtualMachine *) calloc(1, sizeof(VirtualMachine));
/* Initialize Function pointers */
VM->majorVersion = majorVersion;
VM->minorVersion = minorVersion;
'.
categoryList do:[:assoc|
stream cr; crtab; nextPutAll:'/* InterpreterProxy methodsFor: ''',assoc key, ''' */'; crtab.
assoc value asSortedCollection do:[:sel|
stream nextPutAll:'VM->';
nextPutAll: (self cFunctionNameFor: sel);
nextPutAll:' = ';
nextPutAll: (self cFunctionNameFor: sel);
nextPutAll:';';
crtab]].
stream cr; crtab; nextPutAll:'return VM;'; cr; nextPutAll:'}'; cr.
stream close.!
Item was changed:
----- Method: VMPluginCodeGenerator>>withOptionalVerbiageFor:on:do:ifOptionalDo: (in category 'C translation') -----
withOptionalVerbiageFor: selector on: aStream do: mainBlock ifOptionalDo: optionalBlock
(InterpreterProxy >> selector pragmaAt: #option:)
ifNil:
[mainBlock value]
ifNotNil:
[:pragma|
- aStream cr.
self emitIfdefForPluginFunctionOption: pragma arguments first on: aStream.
+ aStream cr.
mainBlock value.
+ aStream nextPutAll: '#else'; cr.
+ optionalBlock value.
+ aStream nextPutAll: '#endif'; cr]!
- optionalBlock ifNotNil:
- [aStream cr; nextPutAll: '#else'.
- optionalBlock value].
- aStream cr; nextPutAll: '#endif']!
More information about the Vm-dev
mailing list