[Vm-dev] [commit] r2313 - OSCogVM source as per VMMaker-oscog.33.
Support object-as-method.
commits at squeakvm.org
commits at squeakvm.org
Sun Sep 26 02:24:22 UTC 2010
Author: eliot
Date: 2010-09-25 19:24:21 -0700 (Sat, 25 Sep 2010)
New Revision: 2313
Modified:
branches/Cog/image/VMMaker-Squeak4.1.changes
branches/Cog/image/VMMaker-Squeak4.1.image
branches/Cog/src/vm/cogit.c
branches/Cog/src/vm/cogit.h
branches/Cog/src/vm/cogmethod.h
branches/Cog/src/vm/cointerp.c
branches/Cog/src/vm/cointerp.h
branches/Cog/src/vm/gcc3x-cointerp.c
branches/Cog/src/vm/interp.h
branches/Cog/stacksrc/vm/gcc3x-interp.c
branches/Cog/stacksrc/vm/interp.c
branches/Cog/stacksrc/vm/interp.h
Log:
OSCogVM source as per VMMaker-oscog.33. Support object-as-method.
Modified: branches/Cog/image/VMMaker-Squeak4.1.changes
===================================================================
--- branches/Cog/image/VMMaker-Squeak4.1.changes 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/image/VMMaker-Squeak4.1.changes 2010-09-26 02:24:21 UTC (rev 2313)
@@ -134817,4 +134817,1393 @@
password: pw ].
user = 'anon' ifTrue: [MCFileBasedRepository flushAllCaches]!
-----QUIT----{21 September 2010 . 8:19 pm} VMMaker-Squeak4.1.image priorSource: 5465030!
\ No newline at end of file
+----QUIT----{21 September 2010 . 8:19 pm} VMMaker-Squeak4.1.image priorSource: 5465030!
+
+----STARTUP----{25 September 2010 . 7:02:21 pm} as /Users/eliot/Cog/oscog/Cog.squeakvm.org/image/VMMaker-Squeak4.1.image!
+
+!CoInterpreter methodsFor: 'method lookup cache' stamp: 'eem 9/25/2010 10:50'!
+addNewMethodToCache: class
+ "Override to refuse to cache other than compiled methods.
+ This protects open PICs against having to test for compiled methods."
+ (self isOopCompiledMethod: newMethod) ifFalse:
+ [primitiveFunctionPointer := #primitiveInvokeObjectAsMethod asSymbol.
+ ^self].
+ super addNewMethodToCache: class! !
+!CoInterpreter methodsFor: 'trampolines' stamp: 'eem 9/23/2010 20:49' prior: 34413332!
+ceSend: selector "<Integer>" super: superNormalBar to: rcvr "<Integer>" numArgs: numArgs "<Integer>"
+ "Entry-point for an unlinked send in a CogMethod, or, if numArgs < 0, a send of
+ a return escape case (cannotReturn:, aboutToReturn:through:, mustBeBoolean)
+ in machine-code. Smalltalk stack looks like
+ receiver
+ args
+ head sp -> sender return pc
+
+ If a return escape then simply try and dispatch the send, but the send may turn into an MNU.
+ If a normal send then try and link the send site as efficiently as possible.
+
+ If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
+ may choose to allocate a closed PIC with a fast MNU dispatch for this send.
+
+ If not an MNU and the receiver's class is old then try to link to the target method.
+ If not an MNU but the receiver's class is young then try and link to an Open PIC for
+ this selector. All link attempts may fail; e.g. because we're out of code memory.
+
+ Continue execution via either executeCogMethodFromUnlinkedSend:withReceiver: or
+ activateInterpreterMethodFromMachineCode: depending on whether the target method
+ is cogged or not."
+ <api>
+ | class mayLink canLinkCacheTag |
+ <inline: false>
+ <var: #cogMethod type: #'CogMethod *'>
+ "self printExternalHeadFrame"
+ "self printStringOf: selector"
+ cogit assertCStackWellAligned.
+ self assert: ((self isIntegerObject: rcvr) or: [self addressCouldBeObj: rcvr]).
+ self sendBreak: selector + BaseHeaderSize
+ point: (self lengthOf: selector)
+ receiver: rcvr.
+ superNormalBar = 0
+ ifTrue: [class := self fetchClassOf: rcvr]
+ ifFalse: [class := self superclassOf: (self methodClassOf: (self frameMethodObject: framePointer))].
+ numArgs >= 0
+ ifTrue:
+ [mayLink := linkSends.
+ canLinkCacheTag := (self isYoungObject: class) not or: [cogit canLinkToYoungClasses].
+ argumentCount := numArgs]
+ ifFalse: "This is a cannotReturn:, nonLocalreturn:through: or mustBeBoolean send. Must not link."
+ [mayLink := false.
+ argumentCount := -1 - numArgs].
+ (self lookupInMethodCacheSel: selector class: class)
+ ifTrue:"check for coggability because method is in the cache"
+ [self
+ ifAppropriateCompileToNativeCode: newMethod
+ selector: selector]
+ ifFalse:
+ [messageSelector := selector.
+ (self lookupMethodNoMNUEtcInClass: class) ifFalse:
+ [^self handleMNUInMachineCodeTo: rcvr
+ lookupClass: class
+ mayLink: (mayLink and: [canLinkCacheTag])].
+ self addNewMethodToCache: class].
+ "Method found and has a cog method. Attempt to link to it. The receiver's class may be young.
+ If the Cogit can't store young classes in inline caches we can link to an open PIC instead."
+ (self maybeMethodHasCogMethod: newMethod) ifTrue:
+ [mayLink ifTrue:
+ [| cogMethod |
+ cogMethod := self cogMethodOf: newMethod.
+ cogMethod selector = nilObj ifTrue:
+ [cogit setSelectorOf: cogMethod to: selector].
+ canLinkCacheTag
+ ifTrue:
+ [cogit
+ linkSendAt: (stackPages longAt: stackPointer)
+ in: (self mframeHomeMethod: framePointer)
+ to: cogMethod
+ checked: superNormalBar = 0
+ receiver: rcvr]
+ ifFalse:
+ [cogit
+ patchToOpenPICFor: selector
+ numArgs: numArgs
+ receiver: rcvr]].
+ "Smalltalk stack contains pushed receiver and arguments and return address for sender.
+ Push the registers to be reloaded and the entry-point and jump/return to the new cog method."
+ self executeCogMethodFromUnlinkedSend: (self cogMethodOf: newMethod) withReceiver: rcvr
+ "NOTREACHED"].
+ ^self activateInterpreterMethodFromMachineCode
+ "NOTREACHED"! !
+!CoInterpreter methodsFor: 'trampolines' stamp: 'eem 9/23/2010 20:49' prior: 34416964!
+ceSendFromInLineCacheMiss: oPIC
+ "Send from an Open PIC when the first-level method lookup probe has failed,
+ or to continue when PIC creation has failed (e.g. because we're out of code space)."
+ <api>
+ <var: #oPIC type: #'CogMethod *'>
+ | numArgs rcvr class |
+ "self printFrame: stackPage headFP WithSP: stackPage headSP"
+ "self printStringOf: selector"
+ numArgs := oPIC cmNumArgs.
+ rcvr := self stackValue: numArgs + 1. "skip return pc"
+ self assert: ((self isIntegerObject: rcvr) or: [self addressCouldBeObj: rcvr]).
+ class := self fetchClassOf: rcvr.
+ argumentCount := numArgs.
+ (self lookupInMethodCacheSel: oPIC selector class: class)
+ ifTrue:"check for coggability because method is in the cache"
+ [self
+ ifAppropriateCompileToNativeCode: newMethod
+ selector: oPIC selector]
+ ifFalse:
+ [messageSelector := oPIC selector.
+ (self lookupMethodNoMNUEtcInClass: class) ifFalse:
+ [self handleMNUInMachineCodeTo: rcvr
+ lookupClass: class
+ mayLink: false].
+ self addNewMethodToCache: class].
+ (self maybeMethodHasCogMethod: newMethod) ifTrue:
+ ["Smalltalk stack contains pushed receiver and arguments and return address for sender.
+ Push the registers to be reloaded and the entry-point and jump/return to the new cog method."
+ self executeCogMethodFromUnlinkedSend: (self cogMethodOf: newMethod) withReceiver: rcvr
+ "NOTREACHED"].
+ ^self activateInterpreterMethodFromMachineCode
+ "NOTREACHED"! !
+!CoInterpreter methodsFor: 'message sending' stamp: 'eem 9/25/2010 19:00' prior: 34438920!
+executeNewMethod
+ "Execute newMethod - either primitiveFunctionPointer must be set directly
+ (i.e. from primitiveExecuteMethod et al), or it would have been set probing
+ the method cache (i.e. primitivePerform et al).
+ Eagerly compile it appropriate so that doits are fast."
+ | methodHeader inInterpreter |
+ primitiveFunctionPointer ~= 0 ifTrue:
+ [self isPrimitiveFunctionPointerAnIndex ifTrue:
+ [self externalQuickPrimitiveResponse.
+ ^nil].
+ "slowPrimitiveResponse may of course context-switch. If so we must reenter the
+ new process appopriately, returning only if we've reached here directly from the
+ interpreter and have found an interpreter frame. The instructionPointer tells us
+ from whence we came."
+ inInterpreter := instructionPointer >= self startOfMemory.
+ self slowPrimitiveResponse ifTrue:
+ [self return: self popStack toExecutive: inInterpreter.
+ ^nil]].
+ "Eagerly compile it appropriate so that doits are fast."
+ methodHeader := self rawHeaderOf: newMethod.
+ (self isCogMethodReference: methodHeader) ifFalse:
+ [(self methodWithHeaderShouldBeCogged: methodHeader)
+ ifTrue:
+ [cogit cog: newMethod selector: nilObj.
+ methodHeader := self rawHeaderOf: newMethod]
+ ifFalse: [self maybeFlagMethodAsInterpreted: newMethod]].
+ (primitiveFunctionPointer = 0 "don't repeat primitive evaluation!!!!"
+ and: [self isCogMethodReference: methodHeader]) ifTrue:
+ [^self executeCogMethod: (self cCoerceSimple: methodHeader to: #'CogMethod *')].
+ "if not primitive, or primitive failed, activate the method"
+ self activateNewMethod! !
+!CoInterpreter methodsFor: 'message sending' stamp: 'eem 9/23/2010 20:49' prior: 34441064!
+handleMNUInMachineCodeTo: rcvr lookupClass: class mayLink: mayLinkBoolean
+ "A message send from either an open PIC or an unlinked send has not
+ been understood. Load newMethod with the MNU method. If linking
+ is allowed and the target MNU method is in the cache then create a
+ closed PIC with an mnu-entry and link the send to it. messageSelector
+ and argumentCount have already been set by the caller."
+ self assert: ((self isIntegerObject: rcvr) or: [self addressCouldBeObj: rcvr]).
+ instructionPointer := self popStack.
+ self createActualMessageTo: class.
+ messageSelector := self splObj: SelectorDoesNotUnderstand.
+ (self lookupInMethodCacheSel: messageSelector class: class)
+ ifTrue:"check for coggability because method is in the cache"
+ [self
+ ifAppropriateCompileToNativeCode: newMethod
+ selector: messageSelector]
+ ifFalse:
+ [(self lookupMethodNoMNUEtcInClass: class) ifFalse:
+ [self error: 'Recursive not understood error encountered'].
+ self addNewMethodToCache: class].
+ (self maybeMethodHasCogMethod: newMethod) ifTrue:
+ [mayLinkBoolean ifTrue:
+ [self flag: 'implement creating an MNU PIC sometime'.
+ false ifTrue: [self shouldBeImplemented]].
+ self push: instructionPointer.
+ self executeCogMethodFromUnlinkedSend: (self cogMethodOf: newMethod)
+ withReceiver: rcvr
+ "NOTREACHED"].
+ self push: instructionPointer.
+ ^self activateInterpreterMethodFromMachineCode
+ "NOTREACHED"! !
+!CoInterpreter methodsFor: 'message sending' stamp: 'eem 9/24/2010 20:18' prior: 34443300!
+internalActivateNewMethod
+ | methodHeader numTemps rcvr errorCode switched |
+ <inline: true>
+
+ self assert: (self isCompiledMethod: newMethod).
+ methodHeader := self headerOf: newMethod.
+ numTemps := self tempCountOfMethodHeader: methodHeader.
+
+ rcvr := self internalStackValue: argumentCount. "could new rcvr be set at point of send?"
+
+ self internalPush: localIP.
+ self internalPush: localFP.
+ localFP := localSP.
+ self internalPush: newMethod.
+ self setMethod: newMethod.
+ self internalPush: nilObj. "FxThisContext field"
+ self internalPush: (self
+ encodeFrameFieldHasContext: false
+ isBlock: false
+ numArgs: (self argumentCountOfMethodHeader: methodHeader)).
+ self internalPush: 0. "FoxIFSavedIP"
+ self internalPush: rcvr.
+
+ "Initialize temps..."
+ argumentCount + 1 to: numTemps do:
+ [:i | self internalPush: nilObj].
+
+ "-1 to account for pre-increment in fetchNextBytecode"
+ localIP := self pointerForOop: (self initialPCForHeader: methodHeader method: newMethod) - 1.
+
+ "Pass primitive error code to last temp if method receives it (indicated
+ by an initial long store temp bytecode). Protect against obsolete values
+ in primFailCode by checking that newMethod actually has a primitive?"
+ primFailCode ~= 0 ifTrue:
+ [((self methodHeaderHasPrimitive: methodHeader)
+ and: [(self byteAtPointer: localIP + 1) = 129 "long store temp"]) ifTrue:
+ [errorCode := self getErrorObjectFromPrimFailCode.
+ self internalStackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"].
+ primFailCode := 0].
+
+ self assert: (self frameNumArgs: localFP) == argumentCount.
+ self assert: (self frameIsBlockActivation: localFP) not.
+ self assert: (self frameHasContext: localFP) not.
+
+ "Now check for stack overflow or an event (interrupt, must scavenge, etc)."
+ localSP < stackLimit ifTrue:
+ [self externalizeIPandSP.
+ switched := self handleStackOverflowOrEventAllowContextSwitch:
+ (self canContextSwitchIfActivating: methodHeader).
+ self returnToExecutive: true postContextSwitch: switched.
+ self internalizeIPandSP]! !
+!CoInterpreter methodsFor: 'message sending' stamp: 'eem 9/25/2010 18:58' prior: 34445442!
+internalExecuteNewMethod
+ | methodHeader succeeded |
+ <inline: true>
+ "For interpreter performance and to ease the objectAsMethod implementation eagerly
+ evaluate the primtiive, i.e. if the method is cogged and has a primitive /do not/ evaluate
+ the machine code primitive, just evaluate primitiveFunctionPointer directly."
+ primitiveFunctionPointer ~~ 0
+ ifTrue:
+ [self isPrimitiveFunctionPointerAnIndex ifTrue:
+ [^self internalQuickPrimitiveResponse].
+ "slowPrimitiveResponse may of course context-switch. If so we must reenter the
+ new process appropriately, returning only if we've found an interpreter frame."
+ self externalizeIPandSP.
+ succeeded := self slowPrimitiveResponse.
+ self internalizeIPandSP.
+ succeeded ifTrue:
+ [self return: self popStack toExecutive: false.
+ self browserPluginReturnIfNeeded.
+ ^nil]]
+ ifFalse: "Entry into a cogged method evaluates the primitive if it has one, but since we must not
+ invoke the primitive twice we only execute the cogged method if it has no primitive."
+ [methodHeader := self rawHeaderOf: newMethod.
+ (self isCogMethodReference: methodHeader) ifTrue:
+ [self externalizeIPandSP.
+ self executeCogMethod: (self cCoerceSimple: methodHeader to: #'CogMethod *').
+ "At least in the simulator control returns here on return."
+ self internalizeIPandSP.
+ ^nil]].
+ "if not primitive, or primitive failed, activate the method"
+ ^self internalActivateNewMethod! !
+!CoInterpreter methodsFor: 'compiled methods' stamp: 'eem 9/23/2010 20:48'!
+maybeMethodHasCogMethod: anOop
+ ^(self isNonIntegerObject: anOop)
+ and: [(self isCompiledMethod: anOop)
+ and: [self isCogMethodReference: (self rawHeaderOf: anOop)]]! !
+!CoInterpreter methodsFor: 'indexing primitives' stamp: 'eem 9/23/2010 20:52' prior: 34626453!
+primitiveContextXray
+ "Lift the veil from a context and answer an integer describing its interior state.
+ Used for e.g. VM tests so they can verify they're testing what they think they're testing.
+ 0 implies a vanilla heap context.
+ Bit 0 = is or was married to a frame
+ Bit 1 = is still married to a frame
+ Bit 2 = frame is executing machine code
+ Bit 3 = has machine code pc (as opposed to nil or a bytecode pc)
+ Bit 4 = method is currently compiled to machine code"
+ | context pc flags theFP theMethod |
+ <var: #theFP type: #'char *'>
+ context := self stackTop.
+ pc := self fetchPointer: InstructionPointerIndex ofObject: context.
+ (self isMarriedOrWidowedContext: context)
+ ifTrue:
+ [(self checkIsStillMarriedContext: context currentFP: framePointer)
+ ifTrue: [theFP := self frameOfMarriedContext: context.
+ (self isMachineCodeFrame: theFP)
+ ifTrue: [flags := 7]
+ ifFalse: [flags := 3]]
+ ifFalse: [flags := 1]]
+ ifFalse:
+ [flags := 0].
+ ((self isIntegerObject: pc)
+ and: [(self integerValueOf: pc) < 0]) ifTrue:
+ [flags := flags bitOr: 8].
+ theMethod := self fetchPointer: MethodIndex ofObject: context.
+ (self maybeMethodHasCogMethod: theMethod) ifTrue:
+ [flags := flags bitOr: 16].
+ self pop: 1 thenPush: (self integerObjectOf: flags)! !
+!Cogit methodsFor: 'in-line cacheing' stamp: 'eem 9/23/2010 21:06' prior: 35122173!
+lookupAndCog: selector for: receiver
+ "Lookup selector in the class of receiver. If not found answer nil.
+ If not a method (objectAsMethod) answer nil. Otherwise try to
+ compile it to machine code if appropriate. Answer the method."
+ | newTargetMethodOrNil |
+ <inline: false>
+ newTargetMethodOrNil := coInterpreter lookup: selector receiver: receiver.
+ (newTargetMethodOrNil notNil
+ and: [coInterpreter isOopCompiledMethod: newTargetMethodOrNil]) ifFalse:
+ [^nil].
+ ((coInterpreter methodHasCogMethod: newTargetMethodOrNil) not
+ and: [coInterpreter methodShouldBeCogged: newTargetMethodOrNil]) ifTrue:
+ ["We assume cog:selector: will *not* reclaim the method zone"
+ self cog: newTargetMethodOrNil selector: selector].
+ ^newTargetMethodOrNil! !
+
+Interpreter removeSelector: #executeNewMethodFromCache!
+!Interpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:00' prior: 35792506!
+primitiveClosureValue
+ | blockClosure blockArgumentCount closureMethod outerContext |
+ blockClosure := self stackValue: argumentCount.
+ blockArgumentCount := self argumentCountOfClosure: blockClosure.
+ argumentCount = blockArgumentCount ifFalse:
+ [^self primitiveFail].
+
+ "Somewhat paranoiac checks we need while debugging that we may be able to discard
+ in a robust system."
+ outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
+ (self isContext: outerContext) ifFalse:
+ [^self primitiveFail].
+ closureMethod := self fetchPointer: MethodIndex ofObject: outerContext.
+ "Check if the closure's method is actually a CompiledMethod."
+ (self isOopCompiledMethod: closureMethod) ifFalse:
+ [^self primitiveFail].
+
+ self activateNewClosureMethod: blockClosure.
+ self quickCheckForInterrupts! !
+!Interpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:00' prior: 35793449!
+primitiveClosureValueNoContextSwitch
+ "An exact clone of primitiveClosureValue except that this version will not
+ check for interrupts on stack overflow."
+ | blockClosure blockArgumentCount closureMethod outerContext |
+ blockClosure := self stackValue: argumentCount.
+ blockArgumentCount := self argumentCountOfClosure: blockClosure.
+ argumentCount = blockArgumentCount ifFalse:
+ [^self primitiveFail].
+
+ "Somewhat paranoiac checks we need while debugging that we may be able to discard
+ in a robust system."
+ outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
+ (self isContext: outerContext) ifFalse:
+ [^self primitiveFail].
+ closureMethod := self fetchPointer: MethodIndex ofObject: outerContext.
+ "Check if the closure's method is actually a CompiledMethod."
+ (self isOopCompiledMethod: closureMethod) ifFalse:
+ [^self primitiveFail].
+
+ self activateNewClosureMethod: blockClosure! !
+!Interpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:00' prior: 35794495!
+primitiveClosureValueWithArgs
+ | argumentArray arraySize cntxSize blockClosure blockArgumentCount closureMethod index outerContext |
+ argumentArray := self stackTop.
+ (self isArray: argumentArray) ifFalse:
+ [^self primitiveFail].
+
+ "Check for enough space in thisContext to push all args"
+ arraySize := self fetchWordLengthOf: argumentArray.
+ cntxSize := self fetchWordLengthOf: activeContext.
+ (self stackPointerIndex + arraySize) < cntxSize ifFalse:
+ [^self primitiveFail].
+
+ blockClosure := self stackValue: argumentCount.
+ blockArgumentCount := self argumentCountOfClosure: blockClosure.
+ arraySize = blockArgumentCount ifFalse:
+ [^self primitiveFail].
+
+ "Somewhat paranoiac checks we need while debugging that we may be able to discard
+ in a robust system."
+ outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
+ (self isContext: outerContext) ifFalse:
+ [^self primitiveFail].
+ closureMethod := self fetchPointer: MethodIndex ofObject: outerContext.
+ "Check if the closure's method is actually a CompiledMethod."
+ (self isOopCompiledMethod: closureMethod) ifFalse:
+ [^self primitiveFail].
+
+ self popStack.
+
+ "Copy the arguments to the stack, and activate"
+ index := 1.
+ [index <= arraySize]
+ whileTrue:
+ [self push: (self fetchPointer: index - 1 ofObject: argumentArray).
+ index := index + 1].
+
+ argumentCount := arraySize.
+ self activateNewClosureMethod: blockClosure.
+ self quickCheckForInterrupts! !
+!Interpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:01' prior: 35797770!
+primitiveExecuteMethodArgsArray
+ "receiver, argsArray, then method are on top of stack. Execute method against receiver and args.
+ Set primitiveFunctionPointer because no cache lookup has been done for the method, and
+ hence primitiveFunctionPointer is stale."
+
+ | methodArgument argCnt argumentArray |
+ methodArgument := self popStack.
+ argumentArray := self popStack.
+ ((self isOopCompiledMethod: methodArgument)
+ and: [self isArray: argumentArray]) ifFalse:
+ [self unPop: 2. ^self primitiveFail].
+ argCnt := self argumentCountOf: methodArgument.
+ argCnt = (self fetchWordLengthOf: argumentArray) ifFalse:
+ [self unPop: 2. ^self primitiveFail].
+ self transfer: argCnt from: argumentArray + BaseHeaderSize to: stackPointer + BytesPerWord.
+ self unPop: argCnt.
+ newMethod := methodArgument.
+ primitiveIndex := self primitiveIndexOf: newMethod.
+ argumentCount := argCnt.
+ self executeNewMethod.
+ "Recursive xeq affects successFlag"
+ successFlag := true! !
+!Interpreter methodsFor: 'control primitives' stamp: 'eem 9/25/2010 09:40' prior: 35798856!
+primitiveInvokeObjectAsMethod
+ "Primitive. 'Invoke' an object like a function, sending the special message
+ run: originalSelector with: arguments in: aReceiver.
+ "
+ | runSelector runReceiver runArgs newReceiver lookupClass |
+ runArgs := self instantiateClass: (self splObj: ClassArray) indexableSize: argumentCount.
+ self beRootIfOld: runArgs. "do we really need this?"
+ self transfer: argumentCount from: stackPointer - ((argumentCount - 1) * BytesPerWord) to: runArgs + BaseHeaderSize.
+
+ runSelector := messageSelector.
+ runReceiver := self stackValue: argumentCount.
+ self pop: argumentCount+1.
+
+ "stack is clean here"
+
+ newReceiver := newMethod.
+ messageSelector := self splObj: SelectorRunWithIn.
+ argumentCount := 3.
+
+ self push: newReceiver.
+ self push: runSelector.
+ self push: runArgs.
+ self push: runReceiver.
+
+ lookupClass := self fetchClassOf: newReceiver.
+ self findNewMethodInClass: lookupClass.
+ self executeNewMethod. "Recursive xeq affects successFlag"
+ successFlag := true.
+! !
+!Interpreter methodsFor: 'control primitives' stamp: 'eem 9/25/2010 09:40' prior: 35799941!
+primitivePerform
+ | performSelector newReceiver selectorIndex lookupClass performMethod |
+ performSelector := messageSelector.
+ performMethod := newMethod.
+ messageSelector := self stackValue: argumentCount - 1.
+ newReceiver := self stackValue: argumentCount.
+
+ "NOTE: the following lookup may fail and be converted to #doesNotUnderstand:, so we must adjust argumentCount and slide args now, so that would work."
+
+ "Slide arguments down over selector"
+ argumentCount := argumentCount - 1.
+ selectorIndex := self stackPointerIndex - argumentCount.
+ self
+ transfer: argumentCount
+ fromIndex: selectorIndex + 1
+ ofObject: activeContext
+ toIndex: selectorIndex
+ ofObject: activeContext.
+ self pop: 1.
+ lookupClass := self fetchClassOf: newReceiver.
+ self findNewMethodInClass: lookupClass.
+
+ "Only test CompiledMethods for argument count - other objects will have to take their chances"
+ (self isOopCompiledMethod: newMethod)
+ ifTrue: [self success: (self argumentCountOf: newMethod) = argumentCount].
+
+ successFlag
+ ifTrue: [self executeNewMethod.
+ "Recursive xeq affects successFlag"
+ successFlag := true]
+ ifFalse: ["Slide the args back up (sigh) and re-insert the
+ selector. "
+ 1 to: argumentCount do: [:i | self
+ storePointer: argumentCount - i + 1 + selectorIndex
+ ofObject: activeContext
+ withValue: (self fetchPointer: argumentCount - i + selectorIndex ofObject: activeContext)].
+ self unPop: 1.
+ self storePointer: selectorIndex
+ ofObject: activeContext
+ withValue: messageSelector.
+ argumentCount := argumentCount + 1.
+ newMethod := performMethod.
+ messageSelector := performSelector]! !
+!Interpreter methodsFor: 'control primitives' stamp: 'eem 9/25/2010 09:40' prior: 35801667!
+primitivePerformAt: lookupClass
+ "Common routine used by perform:withArgs: and perform:withArgs:inSuperclass:"
+
+ "NOTE: The case of doesNotUnderstand: is not a failure to perform.
+ The only failures are arg types and consistency of argumentCount."
+
+ | performSelector argumentArray arraySize index cntxSize performMethod performArgCount |
+ argumentArray := self stackTop.
+ (self isArray: argumentArray) ifFalse:[^self primitiveFail].
+
+ successFlag ifTrue:
+ ["Check for enough space in thisContext to push all args"
+ arraySize := self fetchWordLengthOf: argumentArray.
+ cntxSize := self fetchWordLengthOf: activeContext.
+ self success: (self stackPointerIndex + arraySize) < cntxSize].
+ successFlag ifFalse: [^nil].
+
+ performSelector := messageSelector.
+ performMethod := newMethod.
+ performArgCount := argumentCount.
+ "pop the arg array and the selector, then push the args out of the array, as if they were on the stack"
+ self popStack.
+ messageSelector := self popStack.
+
+ "Copy the arguments to the stack, and execute"
+ index := 1.
+ [index <= arraySize]
+ whileTrue:
+ [self push: (self fetchPointer: index - 1 ofObject: argumentArray).
+ index := index + 1].
+ argumentCount := arraySize.
+
+ self findNewMethodInClass: lookupClass.
+
+ "Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances"
+ (self isOopCompiledMethod: newMethod)
+ ifTrue: [self success: (self argumentCountOf: newMethod) = argumentCount].
+
+ successFlag
+ ifTrue: [self executeNewMethod. "Recursive xeq affects successFlag"
+ successFlag := true]
+ ifFalse: ["Restore the state by popping all those array entries and pushing back the selector and array, and fail"
+ self pop: argumentCount.
+ self push: messageSelector.
+ self push: argumentArray.
+ messageSelector := performSelector.
+ newMethod := performMethod.
+ argumentCount := performArgCount]
+! !
+!MessageNode methodsFor: '*VMMaker-C translation' stamp: 'eem 9/18/2010 11:09' prior: 39012469!
+asTranslatorNodeIn: aTMethod
+ "make a CCodeGenerator equivalent of me"
+ "selector is sometimes a Symbol, sometimes a SelectorNode!!
+ On top of this, numArgs is needed due to the (truly grody) use of
+ arguments as a place to store the extra expressions needed to generate
+ code for in-line to:by:do:, etc. see below, where it is used."
+ | rcvrOrNil sel args |
+ rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod].
+ (rcvrOrNil notNil
+ and: [rcvrOrNil isVariable
+ and: [rcvrOrNil name = 'super']]) ifTrue:
+ [^self superExpansionNodesIn: aTMethod].
+ sel := (selector isSymbol) ifTrue: [selector] ifFalse: [selector key].
+ (sel = #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
+ and: [arguments first isBlockNode]) ifTrue:
+ [| block |
+ ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1
+ ifTrue: [block statements first]
+ ifFalse: [block]].
+ args := (1 to: sel numArgs) collect:
+ [:i | (arguments at: i) asTranslatorNodeIn: aTMethod].
+ (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]])
+ ifTrue: ["Restore limit expr that got moved by transformToDo:"
+ args at: 1 put: ((arguments at: 7) value asTranslatorNodeIn: aTMethod)].
+ (sel = #or: and: [arguments size = 2 and: [(arguments at: 2) notNil]])
+ ifTrue: ["Restore argument block that got moved by transformOr:"
+ args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)].
+ (sel = #ifFalse: and: [arguments size = 2 and: [(arguments at: 2) notNil]])
+ ifTrue: ["Restore argument block that got moved by transformIfFalse:"
+ args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)].
+ ^ TSendNode new
+ setSelector: sel
+ receiver: rcvrOrNil
+ arguments: args! !
+!MessageNode methodsFor: '*VMMaker-C translation' stamp: 'eem 9/24/2010 09:31'!
+superExpansionNodesIn: aTMethod
+ (selector key = aTMethod selector
+ and: [(arguments allSatisfy: [:arg| arg isTemp and: [arg isArg]])
+ and: [(arguments collect: [:ea| ea name]) hasEqualElements: aTMethod args]]) ifFalse:
+ [self error: 'can only send to super with same selector and argument names'].
+ ^aTMethod superExpansionNode! !
+!ObjectMemory methodsFor: 'interpreter access' stamp: 'eem 9/23/2010 20:59' prior: 36881540!
+isCompiledMethod: oop
+ "Answer whether the argument object is of compiled method format"
+ ^(self formatOf: oop) >= 12
+! !
+!ObjectMemory methodsFor: 'interpreter access' stamp: 'eem 9/23/2010 21:00'!
+isOopCompiledMethod: oop
+ "Answer whether the oop is an object of compiled method format"
+ <api>
+ ^(self isNonIntegerObject: oop) and: [(self formatOf: oop) >= 12]
+! !
+!StackInterpreter class methodsFor: 'initialization' stamp: 'eem 9/25/2010 09:42' prior: 38093039!
+initializePrimitiveTable
+ "This table generates a C function address table use in primitiveResponse along with dispatchFunctionPointerOn:in:"
+
+ "NOTE: The real limit here is 2047 because of the method header layout but there is no point in going over the needed size"
+ MaxPrimitiveIndex := 575.
+ MaxQuickPrimitiveIndex := 519.
+ PrimitiveTable := Array new: MaxPrimitiveIndex + 1.
+ self table: PrimitiveTable from:
+ #( "Integer Primitives (0-19)"
+ (0 0 "a.k.a. primitiveFail but faster because primitiveFail won't even be called")
+ (1 primitiveAdd)
+ (2 primitiveSubtract)
+ (3 primitiveLessThan)
+ (4 primitiveGreaterThan)
+ (5 primitiveLessOrEqual)
+ (6 primitiveGreaterOrEqual)
+ (7 primitiveEqual)
+ (8 primitiveNotEqual)
+ (9 primitiveMultiply)
+ (10 primitiveDivide)
+ (11 primitiveMod)
+ (12 primitiveDiv)
+ (13 primitiveQuo)
+ (14 primitiveBitAnd)
+ (15 primitiveBitOr)
+ (16 primitiveBitXor)
+ (17 primitiveBitShift)
+ (18 primitiveMakePoint)
+ (19 primitiveFail) "Guard primitive for simulation -- *must* fail"
+
+ "LargeInteger Primitives (20-37)"
+ (20 primitiveFail)
+ (21 primitiveAddLargeIntegers)
+ (22 primitiveSubtractLargeIntegers)
+ (23 primitiveLessThanLargeIntegers)
+ (24 primitiveGreaterThanLargeIntegers)
+ (25 primitiveLessOrEqualLargeIntegers)
+ (26 primitiveGreaterOrEqualLargeIntegers)
+ (27 primitiveEqualLargeIntegers)
+ (28 primitiveNotEqualLargeIntegers)
+ (29 primitiveMultiplyLargeIntegers)
+ (30 primitiveDivideLargeIntegers)
+ (31 primitiveModLargeIntegers)
+ (32 primitiveDivLargeIntegers)
+ (33 primitiveQuoLargeIntegers)
+ (34 primitiveBitAndLargeIntegers)
+ (35 primitiveBitOrLargeIntegers)
+ (36 primitiveBitXorLargeIntegers)
+ (37 primitiveBitShiftLargeIntegers)
+
+ "Float Primitives (38-59)"
+ (38 primitiveFloatAt)
+ (39 primitiveFloatAtPut)
+ (40 primitiveAsFloat)
+ (41 primitiveFloatAdd)
+ (42 primitiveFloatSubtract)
+ (43 primitiveFloatLessThan)
+ (44 primitiveFloatGreaterThan)
+ (45 primitiveFloatLessOrEqual)
+ (46 primitiveFloatGreaterOrEqual)
+ (47 primitiveFloatEqual)
+ (48 primitiveFloatNotEqual)
+ (49 primitiveFloatMultiply)
+ (50 primitiveFloatDivide)
+ (51 primitiveTruncated)
+ (52 primitiveFractionalPart)
+ (53 primitiveExponent)
+ (54 primitiveTimesTwoPower)
+ (55 primitiveSquareRoot)
+ (56 primitiveSine)
+ (57 primitiveArctan)
+ (58 primitiveLogN)
+ (59 primitiveExp)
+
+ "Subscript and Stream Primitives (60-67)"
+ (60 primitiveAt)
+ (61 primitiveAtPut)
+ (62 primitiveSize)
+ (63 primitiveStringAt)
+ (64 primitiveStringAtPut)
+ "The stream primitives no longer pay their way; normal Smalltalk code is faster."
+ (65 0 "a.k.a. primitiveFail but faster because primitiveFail won't even be called")"was primitiveNext"
+ (66 0 "a.k.a. primitiveFail but faster because primitiveFail won't even be called") "was primitiveNextPut"
+ (67 0 "a.k.a. primitiveFail but faster because primitiveFail won't even be called") "was primitiveAtEnd"
+
+ "StorageManagement Primitives (68-79)"
+ (68 primitiveObjectAt)
+ (69 primitiveObjectAtPut)
+ (70 primitiveNew)
+ (71 primitiveNewWithArg)
+ (72 primitiveArrayBecomeOneWay) "Blue Book: primitiveBecome"
+ (73 primitiveInstVarAt)
+ (74 primitiveInstVarAtPut)
+ (75 primitiveIdentityHash)
+ (76 primitiveStoreStackp) "Blue Book: primitiveAsObject"
+ (77 primitiveSomeInstance)
+ (78 primitiveNextInstance)
+ (79 primitiveNewMethod)
+
+ "Control Primitives (80-89)"
+ (80 primitiveFail) "Blue Book: primitiveBlockCopy"
+ (81 primitiveFail) "Blue Book: primitiveValue"
+ (82 primitiveFail) "Blue Book: primitiveValueWithArgs"
+ (83 primitivePerform)
+ (84 primitivePerformWithArgs)
+ (85 primitiveSignal)
+ (86 primitiveWait)
+ (87 primitiveResume)
+ (88 primitiveSuspend)
+ (89 primitiveFlushCache)
+
+ "Input/Output Primitives (90-109)"
+ (90 primitiveMousePoint)
+ (91 primitiveTestDisplayDepth) "Blue Book: primitiveCursorLocPut"
+ (92 primitiveSetDisplayMode) "Blue Book: primitiveCursorLink"
+ (93 primitiveInputSemaphore)
+ (94 primitiveGetNextEvent) "Blue Book: primitiveSampleInterval"
+ (95 primitiveInputWord)
+ (96 primitiveFail) "primitiveCopyBits"
+ (97 primitiveSnapshot)
+ (98 primitiveStoreImageSegment)
+ (99 primitiveLoadImageSegment)
+ (100 primitivePerformInSuperclass) "Blue Book: primitiveSignalAtTick"
+ (101 primitiveBeCursor)
+ (102 primitiveBeDisplay)
+ (103 primitiveScanCharacters)
+ (104 primitiveFail) "primitiveDrawLoop"
+ (105 primitiveStringReplace)
+ (106 primitiveScreenSize)
+ (107 primitiveMouseButtons)
+ (108 primitiveKbdNext)
+ (109 primitiveKbdPeek)
+
+ "System Primitives (110-119)"
+ (110 primitiveIdentical)
+ (111 primitiveClass)
+ (112 primitiveBytesLeft)
+ (113 primitiveQuit)
+ (114 primitiveExitToDebugger)
+ (115 primitiveChangeClass) "Blue Book: primitiveOopsLeft"
+ (116 primitiveFlushCacheByMethod)
+ (117 primitiveExternalCall)
+ (118 primitiveDoPrimitiveWithArgs)
+ (119 primitiveFlushCacheBySelector)
+ "Squeak 2.2 and earlier use 119. Squeak 2.3 and later use 116.
+ Both are supported for backward compatibility."
+
+ "Miscellaneous Primitives (120-127)"
+ (120 primitiveCalloutToFFI)
+ (121 primitiveImageName)
+ (122 primitiveNoop) "Blue Book: primitiveImageVolume"
+ (123 primitiveFail) "was primitiveValueUninterruptably"
+ (124 primitiveLowSpaceSemaphore)
+ (125 primitiveSignalAtBytesLeft)
+
+ "Squeak Primitives Start Here"
+
+ "Squeak Miscellaneous Primitives (128-149)"
+ (126 primitiveDeferDisplayUpdates)
+ (127 primitiveShowDisplayRect)
+ (128 primitiveArrayBecome)
+ (129 primitiveSpecialObjectsOop)
+ (130 primitiveFullGC)
+ (131 primitiveIncrementalGC)
+ (132 primitiveObjectPointsTo)
+ (133 primitiveSetInterruptKey)
+ (134 primitiveInterruptSemaphore)
+ (135 primitiveMillisecondClock)
+ (136 primitiveSignalAtMilliseconds)
+ (137 primitiveSecondsClock)
+ (138 primitiveSomeObject)
+ (139 primitiveNextObject)
+ (140 primitiveBeep)
+ (141 primitiveClipboardText)
+ (142 primitiveVMPath)
+ (143 primitiveShortAt)
+ (144 primitiveShortAtPut)
+ (145 primitiveConstantFill)
+ "NOTE: When removing the obsolete indexed primitives,
+ the following two should go become #primitiveIntegerAt / atPut"
+ (146 primitiveFail) "primitiveReadJoystick"
+ (147 primitiveFail) "primitiveWarpBits"
+ (148 primitiveClone)
+ (149 primitiveGetAttribute)
+
+ "File Primitives (150-169) - NO LONGER INDEXED"
+ (150 159 primitiveFail)
+ (160 primitiveAdoptInstance)
+ (161 164 primitiveFail)
+ (165 primitiveIntegerAt) "hacked in here for now"
+ (166 primitiveIntegerAtPut)
+ (167 primitiveYield)
+ (168 primitiveCopyObject)
+ (169 primitiveFail)
+
+ "Sound Primitives (170-199) - NO LONGER INDEXED"
+ (170 184 primitiveFail)
+
+ "CriticalSection primitives"
+ (185 primitiveExitCriticalSection) "similar to signal hence index = signal + 100"
+ (186 primitiveEnterCriticalSection) "similar to wait hence index = wait + 100. was primitiveClosureValue"
+ (187 primitiveTestAndSetOwnershipOfCriticalSection) "was primitiveClosureValueWithArgs"
+
+ "Perform method directly"
+ (188 primitiveExecuteMethodArgsArray)
+ (189 primitiveExecuteMethod)
+
+ "Sound Primitives (continued) - NO LONGER INDEXED"
+ (190 194 primitiveFail)
+
+ "Unwind primitives"
+ (195 primitiveFindNextUnwindContext)
+ (196 primitiveTerminateTo)
+ (197 primitiveFindHandlerContext)
+ (198 primitiveMarkUnwindMethod)
+ (199 primitiveMarkHandlerMethod)
+
+ "new closure primitives (were Networking primitives)"
+ (200 primitiveClosureCopyWithCopiedValues)
+ (201 primitiveClosureValue) "value"
+ (202 primitiveClosureValue) "value:"
+ (203 primitiveClosureValue) "value:value:"
+ (204 primitiveClosureValue) "value:value:value:"
+ (205 primitiveClosureValue) "value:value:value:value:"
+ (206 primitiveClosureValueWithArgs) "valueWithArguments:"
+
+ (207 209 primitiveFail) "reserved for Cog primitives"
+
+ (210 primitiveContextAt)
+ (211 primitiveContextAtPut)
+ (212 primitiveContextSize)
+ (213 primitiveContextXray)
+ (214 primitiveVoidVMState)
+ (215 217 primitiveFail) "reserved for Cog primitives"
+ (218 primitiveDoNamedPrimitiveWithArgs)
+ (219 primitiveFail) "reserved for Cog primitives"
+
+ (220 primitiveFail) "reserved for Cog primitives"
+
+ (221 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch"
+ (222 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch:"
+
+ (223 229 primitiveFail) "reserved for Cog primitives"
+
+ (230 primitiveRelinquishProcessor)
+ (231 primitiveForceDisplayUpdate)
+ (232 primitiveFormPrint)
+ (233 primitiveSetFullScreen)
+ (234 primitiveFail) "primBitmapdecompressfromByteArrayat"
+ (235 primitiveFail) "primStringcomparewithcollated"
+ (236 primitiveFail) "primSampledSoundconvert8bitSignedFromto16Bit"
+ (237 primitiveFail) "primBitmapcompresstoByteArray"
+ (238 239 primitiveFail) "serial port primitives"
+ (240 primitiveUTCMicrosecondClock) "was serial port primitive"
+ (241 primitiveLocalMicrosecondClock) "was serial port primitive"
+ (242 primitiveSignalAtUTCMicroseconds)
+ (243 primitiveUpdateTimezone) "primStringtranslatefromtotable"
+ (244 primitiveFail) "primStringfindFirstInStringinSetstartingAt"
+ (245 primitiveFail) "primStringindexOfAsciiinStringstartingAt"
+ (246 primitiveFail) "primStringfindSubstringinstartingAtmatchTable"
+ (247 primitiveSnapshotEmbedded)
+ (248 primitiveInvokeObjectAsMethod)
+ (249 primitiveArrayBecomeOneWayCopyHash)
+
+ "VM Implementor Primitives (250-255)"
+ (250 primitiveClearVMProfile)
+ (251 primitiveControlVMProfiling "primitiveStartVMProfiling")
+ (252 primitiveVMProfileSamplesInto "primitiveStopVMProfiling")
+ (253 primitiveFail "N.B. primitiveCollectCogCodeConstituents in CoInterpreter below")
+ (254 primitiveVMParameter)
+ (255 primitiveFail) "primitiveInstVarsPutFromStack. Never used except in Disney tests."
+
+ "Quick Push Const Methods"
+ (256 nil) "primitivePushSelf"
+ (257 nil) "primitivePushTrue"
+ (258 nil) "primitivePushFalse"
+ (259 nil) "primitivePushNil"
+ (260 nil) "primitivePushMinusOne"
+ (261 nil) "primitivePushZero"
+ (262 nil) "primitivePushOne"
+ (263 nil) "primitivePushTwo"
+
+ "Quick Push Inst Var Methods"
+ (264 519 nil) "primitiveLoadInstVar"
+
+ (520 primitiveFail)
+ "MIDI Primitives (521-539) - NO LONGER INDEXED"
+ (521 529 primitiveFail)
+ (530 539 primitiveFail) "reserved for extended MIDI primitives"
+
+ "Experimental Asynchrous File Primitives - NO LONGER INDEXED"
+ "Pen Tablet Primitives - NO LONGER INDEXED"
+ (540 549 primitiveFail)
+
+ "Sound Codec Primitives - NO LONGER INDEXED"
+ (550 569 primitiveFail)
+
+ "External primitive support primitives"
+ (570 primitiveFlushExternalPrimitives)
+ (571 primitiveUnloadModule)
+ (572 primitiveListBuiltinModule)
+ (573 primitiveListExternalModule)
+ (574 primitiveFail) "reserved for addl. external support prims"
+
+ "Unassigned Primitives"
+ (575 primitiveFail))! !
+!StackInterpreter methodsFor: 'method lookup cache' stamp: 'eem 9/25/2010 10:52' prior: 37584667!
+addNewMethodToCache: class
+ "Add the given entry to the method cache.
+ The policy is as follows:
+ Look for an empty entry anywhere in the reprobe chain.
+ If found, install the new entry there.
+ If not found, then install the new entry at the first probe position
+ and delete the entries in the rest of the reprobe chain.
+ This has two useful purposes:
+ If there is active contention over the first slot, the second
+ or third will likely be free for reentry after ejection.
+ Also, flushing is good when reprobe chains are getting full."
+ | probe hash primitiveIndex |
+ <inline: false>
+ hash := messageSelector bitXor: class. "drop low-order zeros from addresses"
+ (self isOopCompiledMethod: newMethod)
+ ifTrue:
+ [primitiveIndex := self primitiveIndexOf: newMethod.
+ primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: class]
+ ifFalse:
+ [primitiveFunctionPointer := #primitiveInvokeObjectAsMethod asSymbol].
+
+ 0 to: CacheProbeMax-1 do:
+ [:p | probe := (hash >> p) bitAnd: MethodCacheMask.
+ (methodCache at: probe + MethodCacheSelector) = 0 ifTrue:
+ ["Found an empty entry -- use it"
+ methodCache at: probe + MethodCacheSelector put: messageSelector.
+ methodCache at: probe + MethodCacheClass put: class.
+ methodCache at: probe + MethodCacheMethod put: newMethod.
+ methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
+ lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
+ ^ nil]].
+
+ "OK, we failed to find an entry -- install at the first slot..."
+ probe := hash bitAnd: MethodCacheMask. "first probe"
+ methodCache at: probe + MethodCacheSelector put: messageSelector.
+ methodCache at: probe + MethodCacheClass put: class.
+ methodCache at: probe + MethodCacheMethod put: newMethod.
+ methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
+ lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
+
+ "...and zap the following entries"
+ 1 to: CacheProbeMax-1 do:
+ [:p | probe := (hash >> p) bitAnd: MethodCacheMask.
+ methodCache at: probe + MethodCacheSelector put: 0]! !
+!StackInterpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:02' prior: 37524688!
+primitiveClosureValue
+ | blockClosure numArgs closureMethod outerContext |
+ blockClosure := self stackValue: argumentCount.
+ numArgs := self argumentCountOfClosure: blockClosure.
+ argumentCount = numArgs ifFalse:
+ [^self primitiveFail].
+
+ "Somewhat paranoiac checks we need while debugging that we may be able to discard
+ in a robust system."
+ outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
+ (self isContext: outerContext) ifFalse:
+ [^self primitiveFail].
+ closureMethod := self fetchPointer: MethodIndex ofObject: outerContext.
+ "Check if the closure's method is actually a CompiledMethod."
+ (self isOopCompiledMethod: closureMethod) ifFalse:
+ [^self primitiveFail].
+
+ "Note we use activateNewMethod, not executeNewMethodFromCache, to
+ avoid quickCheckForInterrupts. Don't check until we have a full activation."
+ self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true! !
+!StackInterpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:02' prior: 37525759!
+primitiveClosureValueNoContextSwitch
+ "An exact clone of primitiveClosureValue except that this version will not
+ check for interrupts on stack overflow. It may invoke the garbage collector
+ but will not switch processes. See checkForInterruptsMayContextSwitch:"
+ | blockClosure numArgs closureMethod outerContext |
+ blockClosure := self stackValue: argumentCount.
+ numArgs := self argumentCountOfClosure: blockClosure.
+ argumentCount = numArgs ifFalse:
+ [^self primitiveFail].
+
+ "Somewhat paranoiac checks we need while debugging that we may be able to discard
+ in a robust system."
+ outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
+ (self isContext: outerContext) ifFalse:
+ [^self primitiveFail].
+ closureMethod := self fetchPointer: MethodIndex ofObject: outerContext.
+ "Check if the closure's method is actually a CompiledMethod."
+ (self isOopCompiledMethod: closureMethod) ifFalse:
+ [^self primitiveFail].
+
+ "Note we use activateNewMethod, not executeNewMethodFromCache, to
+ avoid quickCheckForInterrupts. Don't check until we have a full activation."
+ self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: false! !
+!StackInterpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:02' prior: 37527076!
+primitiveClosureValueWithArgs
+ | argumentArray arraySize blockClosure numArgs closureMethod index outerContext |
+ argumentArray := self stackTop.
+ (self isArray: argumentArray) ifFalse:
+ [^self primitiveFail].
+
+ "Check for enough space in thisContext to push all args"
+ arraySize := self fetchWordLengthOf: argumentArray.
+ (self roomToPushNArgs: arraySize) ifFalse:
+ [^self primitiveFail].
+
+ blockClosure := self stackValue: argumentCount.
+ numArgs := self argumentCountOfClosure: blockClosure.
+ arraySize = numArgs ifFalse:
+ [^self primitiveFail].
+
+ "Somewhat paranoiac checks we need while debugging that we may be able to discard
+ in a robust system."
+ outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
+ (self isContext: outerContext) ifFalse:
+ [^self primitiveFail].
+ closureMethod := self fetchPointer: MethodIndex ofObject: outerContext.
+ "Check if the closure's method is actually a CompiledMethod."
+ (self isOopCompiledMethod: closureMethod) ifFalse:
+ [^self primitiveFail].
+
+ self popStack.
+
+ "Copy the arguments to the stack, and activate"
+ index := 1.
+ [index <= numArgs]
+ whileTrue:
+ [self push: (self fetchPointer: index - 1 ofObject: argumentArray).
+ index := index + 1].
+
+ "Note we use activateNewMethod, not executeNewMethodFromCache, to
+ avoid quickCheckForInterrupts. Don't check until we have a full activation."
+ self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true! !
+!StackInterpreter methodsFor: 'plugin primitives' stamp: 'eem 9/23/2010 21:02' prior: 38571872!
+primitiveDoNamedPrimitiveWithArgs
+ "Simulate an primitiveExternalCall invocation (e.g. for the Debugger). Do not cache anything.
+ e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
+ | argumentArray arraySize methodArg methodHeader
+ moduleName functionName moduleLength functionLength
+ spec addr primRcvr ctxtRcvr |
+ <var: #addr declareC: 'void (*addr)()'>
+ argumentArray := self stackTop.
+ (self isArray: argumentArray) ifFalse:
+ [^self primitiveFailFor: -2]. "invalid args"
+ arraySize := self fetchWordLengthOf: argumentArray.
+ self success: (self roomToPushNArgs: arraySize).
+
+ methodArg := self stackObjectValue: 2.
+ self successful ifFalse:
+ [^self primitiveFailFor: -2]. "invalid args"
+
+ (self isOopCompiledMethod: methodArg) ifFalse:
+ [^self primitiveFailFor: -2]. "invalid args"
+
+ methodHeader := self headerOf: methodArg.
+
+ (self literalCountOfHeader: methodHeader) > 2 ifFalse:
+ [^self primitiveFailFor: -3]. "invalid methodArg state"
+ (self assertClassOf: (spec := self fetchPointer: 1 "first literal" ofObject: methodArg)
+ is: (self splObj: ClassArray)
+ compactClassIndex: ClassArrayCompactIndex).
+ (self successful
+ and: [(self lengthOf: spec) = 4
+ and: [(self primitiveIndexOfMethodHeader: methodHeader) = 117]]) ifFalse:
+ [^self primitiveFailFor: -3]. "invalid methodArg state"
+
+ (self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
+ [^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
+
+ "The function has not been loaded yet. Fetch module and function name."
+ moduleName := self fetchPointer: 0 ofObject: spec.
+ moduleName = nilObj
+ ifTrue: [moduleLength := 0]
+ ifFalse: [self success: (self isBytes: moduleName).
+ moduleLength := self lengthOf: moduleName.
+ self cCode: '' inSmalltalk:
+ [ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
+ ifTrue: [moduleLength := 0 "Cause all of these to fail"]]].
+ functionName := self fetchPointer: 1 ofObject: spec.
+ self success: (self isBytes: functionName).
+ functionLength := self lengthOf: functionName.
+ self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
+
+ addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
+ OfLength: functionLength
+ FromModule: moduleName + BaseHeaderSize
+ OfLength: moduleLength.
+ addr = 0 ifTrue:
+ [^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
+
+ "Cannot fail this primitive from now on. Can only fail the external primitive."
+ self pushRemappableOop: (argumentArray := self popStack).
+ self pushRemappableOop: (primRcvr := self popStack).
+ self pushRemappableOop: self popStack. "the method"
+ self pushRemappableOop: self popStack. "the context receiver"
+ self push: primRcvr. "replace context receiver with actual receiver"
+ argumentCount := arraySize.
+ 1 to: arraySize do:
+ [:index| self push: (self fetchPointer: index - 1 ofObject: argumentArray)].
+ "Run the primitive (sets primFailCode)"
+ lkupClass := nilObj.
+ self callExternalPrimitive: addr.
+ ctxtRcvr := self popRemappableOop.
+ methodArg := self popRemappableOop.
+ primRcvr := self popRemappableOop.
+ argumentArray := self popRemappableOop.
+ self successful ifFalse: "If primitive failed, then restore state for failure code"
+ [self pop: arraySize + 1.
+ self push: ctxtRcvr.
+ self push: methodArg.
+ self push: primRcvr.
+ self push: argumentArray.
+ argumentCount := 3.
+ "Hack. A nil prim error code (primErrorCode = 1) is interpreted by the image
+ as meaning this primitive is not implemented. So to pass back nil as an error
+ code we use -1 to indicate generic failure."
+ primFailCode = 1 ifTrue:
+ [primFailCode := -1]]! !
+!StackInterpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:03' prior: 37529935!
+primitiveExecuteMethod
+ "receiver, args, then method are on top of stack. Execute method against receiver and args.
+ Set primitiveFunctionPointer because no cache lookup has been done for the method, and
+ hence primitiveFunctionPointer is stale."
+ | methodArgument primitiveIndex |
+ methodArgument := self stackTop.
+ (self isOopCompiledMethod: methodArgument) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ argumentCount - 1 = (self argumentCountOf: methodArgument) ifFalse:
+ [^self primitiveFailFor: PrimErrBadNumArgs].
+ newMethod := self popStack.
+ primitiveIndex := self primitiveIndexOf: newMethod.
+ primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: nil.
+ argumentCount := argumentCount - 1.
+ self executeNewMethod.
+ "Recursive xeq affects primErrorCode"
+ self initPrimCall! !
+!StackInterpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:03' prior: 37530887!
+primitiveExecuteMethodArgsArray
+ "receiver, argsArray, then method are on top of stack. Execute method against receiver and args.
+ Set primitiveFunctionPointer because no cache lookup has been done for the method, and
+ hence primitiveFunctionPointer is stale."
+ | methodArgument argCnt argumentArray primitiveIndex |
+ methodArgument := self stackTop.
+ argumentArray := self stackValue: 1.
+ ((self isOopCompiledMethod: methodArgument)
+ and: [self isArray: argumentArray]) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ argCnt := self argumentCountOf: methodArgument.
+ argCnt = (self fetchWordLengthOf: argumentArray) ifFalse:
+ [^self primitiveFailFor: PrimErrBadNumArgs].
+ self pop: 2.
+ 0 to: argCnt - 1 do:
+ [:i|
+ self push: (self fetchPointer: i ofObject: argumentArray)].
+ newMethod := methodArgument.
+ primitiveIndex := self primitiveIndexOf: newMethod.
+ primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: nil.
+ argumentCount := argCnt.
+ self executeNewMethod.
+ "Recursive xeq affects primErrorCode"
+ self initPrimCall! !
+!StackInterpreter methodsFor: 'control primitives' stamp: 'eem 9/25/2010 18:42'!
+primitiveInvokeObjectAsMethod
+ "Primitive. 'Invoke' an object like a function, sending the special message
+ run: originalSelector with: arguments in: aReceiver.
+ "
+ | runReceiver runArgs lookupClass |
+ runArgs := self instantiateClass: (self splObj: ClassArray) indexableSize: argumentCount.
+ argumentCount - 1 to: 0 by: -1 do:
+ [:i| self storePointerUnchecked: i ofObject: runArgs withValue: self popStack].
+
+ runReceiver := self popStack.
+ "setup send of newMethod run: originalSelector with: runArgs in: runReceiver"
+ self push: newMethod. "newReceiver"
+ self push: messageSelector "original selector".
+ self push: runArgs.
+ self push: runReceiver.
+
+ "stack is clean here"
+
+ messageSelector := self splObj: SelectorRunWithIn.
+ argumentCount := 3.
+ lookupClass := self fetchClassOf: newMethod.
+ self findNewMethodInClass: lookupClass.
+ self executeNewMethod. "Recursive xeq affects successFlag"
+ self initPrimCall
+! !
+!StackInterpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:04' prior: 37534806!
+primitiveObject: actualReceiver perform: selector withArguments: argumentArray lookedUpIn: lookupClass
+ "Common routine used by perform:withArgs:, perform:withArgs:inSuperclass:,
+ object:perform:withArgs:inClass: et al. Answer nil on success.
+
+ NOTE: The case of doesNotUnderstand: is not a failure to perform.
+ The only failures are arg types and consistency of argumentCount.
+
+ Since we're in the stack VM we can assume there is space to push the arguments
+ provided they are within limits (max argument count is 15). We can therefore deal
+ with the arbitrary amount of state to remove from the stack (lookup class, selector,
+ mirror receiver) and arbitrary argument orders by deferring popping anything until
+ we know whether the send has succeeded. So on failure we merely have to remove
+ the actual receiver and arguments pushed, and on success we have to slide the actual
+ receiver and arguments down to replace the original ones."
+
+ | arraySize performArgCount delta |
+ (self isArray: argumentArray) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+
+ "Check if number of arguments is reasonable; MaxNumArgs isn't available
+ so just use LargeContextSize"
+ arraySize := self fetchWordLengthOf: argumentArray.
+ arraySize > (LargeContextSize / BytesPerWord) ifTrue:
+ [^self primitiveFailFor: PrimErrBadNumArgs].
+
+ performArgCount := argumentCount.
+ "Push newMethod to save it in case of failure,
+ then push the actual receiver and args out of the array."
+ self push: newMethod.
+ self push: actualReceiver.
+ "Copy the arguments to the stack, and execute"
+ 1 to: arraySize do:
+ [:index| self push: (self fetchPointer: index - 1 ofObject: argumentArray)].
+ argumentCount := arraySize.
+ messageSelector := selector.
+
+ self findNewMethodInClass: lookupClass.
+
+ "Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances"
+ ((self isOopCompiledMethod: newMethod)
+ and: [(self argumentCountOf: newMethod) = argumentCount]) ifFalse:
+ ["Restore the state by popping all those array entries and pushing back the selector and array, and fail"
+ self pop: arraySize + 1.
+ newMethod := self popStack.
+ ^self primitiveFailFor: PrimErrBadNumArgs].
+
+ "Cannot fail this primitive from here-on. Slide the actual receiver and arguments down
+ to replace the perform arguments and saved newMethod and then execute the new
+ method. Use argumentCount not arraySize because an MNU may have changed it."
+ delta := BytesPerWord * (performArgCount + 2). "+2 = receiver + saved newMethod"
+ argumentCount * BytesPerWord to: 0 by: BytesPerWord negated do:
+ [:offset|
+ stackPages
+ longAt: stackPointer + offset + delta
+ put: (stackPages longAt: stackPointer + offset)].
+ self pop: performArgCount + 2.
+ self executeNewMethod.
+ self initPrimCall. "Recursive xeq affects primErrorCode"
+ ^nil! !
+!StackInterpreter methodsFor: 'control primitives' stamp: 'eem 9/23/2010 21:04' prior: 37537755!
+primitivePerform
+ | performSelector newReceiver lookupClass performMethod |
+ performSelector := messageSelector.
+ performMethod := newMethod.
+ messageSelector := self stackValue: argumentCount - 1.
+ newReceiver := self stackValue: argumentCount.
+
+ "NOTE: the following lookup may fail and be converted to #doesNotUnderstand:,
+ so we must adjust argumentCount and slide args now, so that will work."
+
+ "Slide arguments down over selector"
+ argumentCount := argumentCount - 1.
+ argumentCount to: 1 by: -1 do:
+ [:i|
+ stackPages
+ longAt: stackPointer + (i * BytesPerWord)
+ put: (stackPages longAt: stackPointer + ((i - 1) * BytesPerWord))].
+ self pop: 1.
+ lookupClass := self fetchClassOf: newReceiver.
+ self findNewMethodInClass: lookupClass.
+
+ "Only test CompiledMethods for argument count - other objects will have to take their chances"
+ ((self isOopCompiledMethod: newMethod)
+ and: [(self argumentCountOf: newMethod) = argumentCount]) ifFalse:
+ ["Slide the args back up (sigh) and re-insert the selector."
+ self unPop: 1.
+ 1 to: argumentCount by: 1 do:
+ [:i |
+ stackPages longAt: stackPointer + ((i - 1) * BytesPerWord)
+ put: (stackPages longAt: stackPointer + (i * BytesPerWord))].
+ stackPages longAt: stackPointer + (argumentCount * BytesPerWord) put: messageSelector.
+ argumentCount := argumentCount + 1.
+ newMethod := performMethod.
+ messageSelector := performSelector.
+ ^self primitiveFail].
+
+ self executeNewMethod.
+ "Recursive xeq affects primErrorCode"
+ self initPrimCall.
+ ^nil! !
+!TMethod methodsFor: 'accessing' stamp: 'eem 9/24/2010 09:54'!
+comment
+ ^comment! !
+!TMethod methodsFor: 'testing' stamp: 'eem 9/13/2010 12:12'!
+hasProperties
+ ^properties notNil and: [properties notEmpty]! !
+!TMethod methodsFor: 'inlining' stamp: 'eem 9/24/2010 09:47'!
+mergePropertiesOfSuperMethod: superTMethod
+ superTMethod hasProperties ifFalse:
+ [^self].
+ self hasProperties ifFalse:
+ [properties := superTMethod properties.
+ ^self].
+ superTMethod properties pragmas do:
+ [:aPragma|
+ (self shouldIncorporatePragmaFromSuperMethod: aPragma) ifTrue:
+ [properties := properties copyWith: aPragma]]! !
+!TMethod methodsFor: 'accessing' stamp: 'eem 9/13/2010 12:10'!
+properties
+ ^properties! !
+!TMethod methodsFor: 'inlining' stamp: 'eem 9/24/2010 09:46'!
+shouldIncorporatePragmaFromSuperMethod: aPragma
+ (properties includesKey: aPragma keyword) ifFalse:
+ [^true].
+ ((aPragma keyword beginsWith: #var:)
+ and: [properties pragmas noneSatisfy:
+ [:p|
+ (p keyword beginsWith: #var:)
+ and: [(p argumentAt: 1) = (aPragma argumentAt: 1)]]]) ifTrue:
+ [^true].
+ ^false! !
+!TMethod methodsFor: 'inlining' stamp: 'eem 9/24/2010 14:54'!
+superExpansionNode
+ "Answer the expansion of a super send of this method's selector. A super send
+ is restricted to a super send of this method's selector, /not/ an arbitrary selector.
+ Merge the super expansion's properties into this method's properties."
+ (definingClass superclass lookupSelector: selector)
+ ifNil: [self error: 'superclass does not define super method']
+ ifNotNil:
+ [:superMethod| | superTMethod varMap |
+ superTMethod := superMethod methodNode asTranslationMethodOfClass: self class.
+ self mergePropertiesOfSuperMethod: superTMethod.
+ (varMap := superTMethod locals intersection: locals) notEmpty ifTrue:
+ [varMap := Dictionary new addAll: varMap; yourself.
+ varMap keys do:
+ [:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: locals)].
+ superTMethod renameVariablesUsing: varMap].
+ self assert: (superTMethod locals allSatisfy: [:var| (locals includes: var) not]).
+ locals addAllFirst: superTMethod locals.
+ superTMethod locals do:
+ [:var|
+ (superTMethod declarations includesKey: var) ifTrue:
+ [self declarationAt: var put: (superTMethod declarationAt: var)]].
+ superTMethod comment ifNotNil:
+ [:superComment|
+ comment := comment
+ ifNil: [superComment]
+ ifNotNil: [superComment, comment]].
+ ^superTMethod parseTree]! !
+
+| user pw |
+Utilities setAuthorInitials.
+user := UIManager default request: 'Repository user name'.
+pw := UIManager default requestPassword: 'Monticello password'.
+MCHttpRepository allSubInstancesDo: [ : rep |
+ rep user: user;
+ password: pw ].
+user = 'anon' ifTrue: [MCFileBasedRepository flushAllCaches]!
+
+"VMMaker"!
+
+| user pw |
+Utilities setAuthorInitials.
+user := UIManager default request: 'Repository user name'.
+pw := UIManager default requestPassword: 'Monticello password'.
+MCHttpRepository allSubInstancesDo: [ : rep |
+ rep user: user;
+ password: pw ].
+user = 'anon' ifTrue: [MCFileBasedRepository flushAllCaches]!
+
+| user pw |
+Utilities setAuthorInitials.
+user := UIManager default request: 'Repository user name'.
+pw := UIManager default requestPassword: 'Monticello password'.
+MCHttpRepository allSubInstancesDo: [ : rep |
+ rep user: user;
+ password: pw ].
+user = 'anon' ifTrue: [MCFileBasedRepository flushAllCaches]!
+
+----QUIT----{25 September 2010 . 7:21:28 pm} VMMaker-Squeak4.1.image priorSource: 5468190!
\ No newline at end of file
Modified: branches/Cog/image/VMMaker-Squeak4.1.image
===================================================================
(Binary files differ)
Modified: branches/Cog/src/vm/cogit.c
===================================================================
--- branches/Cog/src/vm/cogit.c 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/src/vm/cogit.c 2010-09-26 02:24:21 UTC (rev 2313)
@@ -1,9 +1,9 @@
/* Automatically generated by
- CCodeGenerator VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19
+ CCodeGenerator VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
from
- SimpleStackBasedCogit VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19
+ SimpleStackBasedCogit VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
*/
-static char __buildInfo[] = "SimpleStackBasedCogit VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19 " __DATE__ ;
+static char __buildInfo[] = "SimpleStackBasedCogit VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf " __DATE__ ;
char *__cogitBuildInfo = __buildInfo;
@@ -10031,17 +10031,20 @@
/* Lookup selector in the class of receiver. If not found answer nil.
- If found try to compile it to machine code if appropriate. Answer
- the method. */
+ If not a method (objectAsMethod) answer nil. Otherwise try to
+ compile it to machine code if appropriate. Answer the method. */
static sqInt
lookupAndCogfor(sqInt selector, sqInt receiver) {
sqInt newTargetMethodOrNil;
newTargetMethodOrNil = lookupreceiver(selector, receiver);
- if ((newTargetMethodOrNil != null)
- && ((!(methodHasCogMethod(newTargetMethodOrNil)))
- && (methodShouldBeCogged(newTargetMethodOrNil)))) {
+ if (!((newTargetMethodOrNil != null)
+ && (isOopCompiledMethod(newTargetMethodOrNil)))) {
+ return null;
+ }
+ if ((!(methodHasCogMethod(newTargetMethodOrNil)))
+ && (methodShouldBeCogged(newTargetMethodOrNil))) {
cogselector(newTargetMethodOrNil, selector);
}
return newTargetMethodOrNil;
Modified: branches/Cog/src/vm/cogit.h
===================================================================
--- branches/Cog/src/vm/cogit.h 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/src/vm/cogit.h 2010-09-26 02:24:21 UTC (rev 2313)
@@ -1,5 +1,5 @@
/* Automatically generated by
- CCodeGenerator VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19
+ CCodeGenerator VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
*/
Modified: branches/Cog/src/vm/cogmethod.h
===================================================================
--- branches/Cog/src/vm/cogmethod.h 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/src/vm/cogmethod.h 2010-09-26 02:24:21 UTC (rev 2313)
@@ -1,5 +1,5 @@
/* Automatically generated by
- CCodeGenerator VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19
+ CCodeGenerator VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
*/
typedef struct {
Modified: branches/Cog/src/vm/cointerp.c
===================================================================
--- branches/Cog/src/vm/cointerp.c 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/src/vm/cointerp.c 2010-09-26 02:24:21 UTC (rev 2313)
@@ -1,9 +1,9 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19
+ CCodeGeneratorGlobalStructure VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
from
- CoInterpreter VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19
+ CoInterpreter VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
*/
-static char __buildInfo[] = "CoInterpreter VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19 " __DATE__ ;
+static char __buildInfo[] = "CoInterpreter VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf " __DATE__ ;
char *__interpBuildInfo = __buildInfo;
@@ -267,6 +267,7 @@
#define SelectorCannotReturn 21
#define SelectorDoesNotUnderstand 20
#define SelectorMustBeBoolean 25
+#define SelectorRunWithIn 49
#define SelectorStart 2
#define SenderIndex 0
#define ShiftForWord 2
@@ -556,6 +557,7 @@
static sqInt isBaseFrame(char *theFP);
sqInt isBytes(sqInt oop);
static sqInt isCogMethodReference(sqInt methodHeader);
+static sqInt isCompiledMethod(sqInt oop);
static sqInt isContextHeader(sqInt aHeader);
static sqInt isContext(sqInt oop);
sqInt isFloatObject(sqInt oop);
@@ -569,6 +571,7 @@
sqInt isMarked(sqInt oop);
static sqInt isMarriedOrWidowedContext(sqInt aContext);
sqInt isNonIntegerObject(sqInt objectPointer);
+sqInt isOopCompiledMethod(sqInt oop);
sqInt isPointers(sqInt oop);
static sqInt isPrimitiveFunctionPointerAnIndex(void);
sqInt isQuickPrimitiveIndex(sqInt anInteger);
@@ -793,6 +796,7 @@
static void primitiveIntegerAtPut(void);
EXPORT(void) primitiveInterruptChecksPerMSec(void);
static void primitiveInterruptSemaphore(void);
+static void primitiveInvokeObjectAsMethod(void);
EXPORT(void) primitiveIsRoot(void);
EXPORT(void) primitiveIsWindowObscured(void);
EXPORT(void) primitiveIsYoung(void);
@@ -1001,6 +1005,7 @@
static sqInt sizeOfFree(sqInt oop);
sqInt sizeOfSTArrayFromCPrimitive(void *cPtr);
sqInt slotSizeOf(sqInt oop);
+static sqInt slowPrimitiveResponse(void);
static void snapshot(sqInt embedded);
static void space(void);
sqInt specialSelectorNumArgs(sqInt index);
@@ -1079,8 +1084,8 @@
_iss usqInt method;
_iss sqInt argumentCount;
_iss usqInt youngStart;
+_iss usqInt newMethod;
_iss sqInt messageSelector;
-_iss usqInt newMethod;
_iss usqInt endOfMemory;
_iss sqInt rootTableCount;
_iss StackPage * pages;
@@ -1483,7 +1488,7 @@
/* 245 */ (void (*)(void))0,
/* 246 */ (void (*)(void))0,
/* 247 */ primitiveSnapshotEmbedded,
- /* 248 */ (void (*)(void))0,
+ /* 248 */ primitiveInvokeObjectAsMethod,
/* 249 */ primitiveArrayBecomeOneWayCopyHash,
/* 250 */ primitiveClearVMProfile,
/* 251 */ primitiveControlVMProfiling,
@@ -1813,7 +1818,7 @@
/* 575 */ (void (*)(void))0,
0 };
static void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* 4097 */])(void);
-const char *interpreterVersion = "Croquet Closure Cog VM [CoInterpreter VMMaker-oscog.32]";
+const char *interpreterVersion = "Croquet Closure Cog VM [CoInterpreter VMMaker-oscog.33]";
static volatile int sendTrace;
sqInt suppressHeartbeatFlag;
@@ -4655,7 +4660,7 @@
sqInt probe;
CogMethod *cogMethod;
sqInt methodHeader;
- sqInt methodHeader2;
+ sqInt methodHeader3;
sqInt succeeded;
sqInt rcvr;
sqInt offset;
@@ -4670,11 +4675,12 @@
char *savedStackPointer;
sqInt errorCode;
sqInt i;
- sqInt methodHeader1;
+ sqInt methodHeader2;
sqInt numTemps;
sqInt rcvr1;
sqInt switched;
sqInt table;
+ sqInt methodHeader1;
sqInt object2;
sqInt localPrimIndex;
sqInt oop;
@@ -4765,50 +4771,6 @@
}
/* begin internalExecuteNewMethod */
VM_LABEL(0internalExecuteNewMethod);
- methodHeader2 = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
- if (isCogMethodReference(methodHeader2)) {
- /* begin externalizeIPandSP */
- assert((((usqInt)localIP)) != (ceReturnToInterpreterPC()));
- GIV(instructionPointer) = oopForPointer(localIP);
- GIV(stackPointer) = localSP;
- GIV(framePointer) = localFP;
- /* begin executeCogMethod: */
- VM_LABEL(0executeCogMethod);
- assertCStackWellAligned();
- /* begin assertValidExecutionPointe:r:s: */
- assertValidExecutionPointersimbar(GIV(instructionPointer), GIV(framePointer), GIV(stackPointer), !((((usqInt)(longAt(GIV(framePointer) + FoxMethod)))) < heapBase));
- /* begin stackValue: */
- offset = (((CogMethod *) methodHeader2)->cmNumArgs);
- rcvr = longAt(GIV(stackPointer) + (offset * BytesPerWord));
- /* begin ensurePushedInstructionPointer */
- if ((((usqInt)GIV(instructionPointer))) >= heapBase) {
- /* begin iframeSavedIP:put: */
- longAtput(GIV(framePointer) + FoxIFSavedIP, GIV(instructionPointer));
- /* begin push: */
- object1 = ceReturnToInterpreterPC();
- longAtput(sp2 = GIV(stackPointer) - BytesPerWord, object1);
- GIV(stackPointer) = sp2;
- }
- else {
- /* begin push: */
- longAtput(sp11 = GIV(stackPointer) - BytesPerWord, GIV(instructionPointer));
- GIV(stackPointer) = sp11;
- }
- /* begin push: */
- object = (((usqInt)(((CogMethod *) methodHeader2)))) + (noCheckEntryOffset());
- longAtput(sp = GIV(stackPointer) - BytesPerWord, object);
- GIV(stackPointer) = sp;
- /* begin push: */
- longAtput(sp1 = GIV(stackPointer) - BytesPerWord, rcvr);
- GIV(stackPointer) = sp1;
- ceEnterCogCodePopReceiverReg();
- /* begin internalizeIPandSP */
- assert(GIV(instructionPointer) != (ceReturnToInterpreterPC()));
- localIP = pointerForOop(GIV(instructionPointer));
- localSP = pointerForOop(GIV(stackPointer));
- localFP = pointerForOop(GIV(framePointer));
- goto l105;
- }
if (primitiveFunctionPointer != 0) {
if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
/* begin internalQuickPrimitiveResponse */
@@ -4899,11 +4861,65 @@
goto l105;
}
}
+ else {
+
+ /* Entry into a cogged method evaluates the primitive if it has one, but since we must not
+ invoke the primitive twice we only execute the cogged method if it has no primitive. */
+
+ methodHeader3 = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
+ if (isCogMethodReference(methodHeader3)) {
+ /* begin externalizeIPandSP */
+ assert((((usqInt)localIP)) != (ceReturnToInterpreterPC()));
+ GIV(instructionPointer) = oopForPointer(localIP);
+ GIV(stackPointer) = localSP;
+ GIV(framePointer) = localFP;
+ /* begin executeCogMethod: */
+ VM_LABEL(0executeCogMethod);
+ assertCStackWellAligned();
+ /* begin assertValidExecutionPointe:r:s: */
+ assertValidExecutionPointersimbar(GIV(instructionPointer), GIV(framePointer), GIV(stackPointer), !((((usqInt)(longAt(GIV(framePointer) + FoxMethod)))) < heapBase));
+ /* begin stackValue: */
+ offset = (((CogMethod *) methodHeader3)->cmNumArgs);
+ rcvr = longAt(GIV(stackPointer) + (offset * BytesPerWord));
+ /* begin ensurePushedInstructionPointer */
+ if ((((usqInt)GIV(instructionPointer))) >= heapBase) {
+ /* begin iframeSavedIP:put: */
+ longAtput(GIV(framePointer) + FoxIFSavedIP, GIV(instructionPointer));
+ /* begin push: */
+ object1 = ceReturnToInterpreterPC();
+ longAtput(sp2 = GIV(stackPointer) - BytesPerWord, object1);
+ GIV(stackPointer) = sp2;
+ }
+ else {
+ /* begin push: */
+ longAtput(sp11 = GIV(stackPointer) - BytesPerWord, GIV(instructionPointer));
+ GIV(stackPointer) = sp11;
+ }
+ /* begin push: */
+ object = (((usqInt)(((CogMethod *) methodHeader3)))) + (noCheckEntryOffset());
+ longAtput(sp = GIV(stackPointer) - BytesPerWord, object);
+ GIV(stackPointer) = sp;
+ /* begin push: */
+ longAtput(sp1 = GIV(stackPointer) - BytesPerWord, rcvr);
+ GIV(stackPointer) = sp1;
+ ceEnterCogCodePopReceiverReg();
+ /* begin internalizeIPandSP */
+ assert(GIV(instructionPointer) != (ceReturnToInterpreterPC()));
+ localIP = pointerForOop(GIV(instructionPointer));
+ localSP = pointerForOop(GIV(stackPointer));
+ localFP = pointerForOop(GIV(framePointer));
+ goto l105;
+ }
+ }
/* begin internalActivateNewMethod */
VM_LABEL(0internalActivateNewMethod);
+ assert(isCompiledMethod(GIV(newMethod)));
+ /* begin headerOf: */
methodHeader1 = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
- assert(!(isCogMethodReference(methodHeader1)));
- numTemps = (((usqInt) methodHeader1) >> 19) & 63;
+ methodHeader2 = (isCogMethodReference(methodHeader1)
+ ? (((CogMethod *) methodHeader1)->methodHeader)
+ : methodHeader1);
+ numTemps = (((usqInt) methodHeader2) >> 19) & 63;
/* could new rcvr be set at point of send? */
@@ -4922,12 +4938,12 @@
longAtPointerput(localSP -= BytesPerWord, GIV(nilObj));
/* begin internalPush: */
object2 = (VMBIGENDIAN
- ? ((1 + (((((usqInt) methodHeader1) >> 25) & 15) << ((BytesPerWord * 8) - 8))) + ((0
+ ? ((1 + (((((usqInt) methodHeader2) >> 25) & 15) << ((BytesPerWord * 8) - 8))) + ((0
? 1 << ((BytesPerWord * 8) - 16)
: 0))) + ((0
? 1 << ((BytesPerWord * 8) - 24)
: 0))
- : ((1 + (((((usqInt) methodHeader1) >> 25) & 15) << 8)) + ((0
+ : ((1 + (((((usqInt) methodHeader2) >> 25) & 15) << 8)) + ((0
? 1 << 16
: 0))) + ((0
? 1 << 24
@@ -4946,9 +4962,9 @@
by an initial long store temp bytecode). Protect against obsolete values
in primFailCode by checking that newMethod actually has a primitive? */
- localIP = pointerForOop(((GIV(newMethod) + ((LiteralStart + ((((usqInt) methodHeader1) >> 10) & 255)) * BytesPerWord)) + BaseHeaderSize) - 1);
+ localIP = pointerForOop(((GIV(newMethod) + ((LiteralStart + ((((usqInt) methodHeader2) >> 10) & 255)) * BytesPerWord)) + BaseHeaderSize) - 1);
if (GIV(primFailCode) != 0) {
- if (((methodHeader1 & 536871934) != 0)
+ if (((methodHeader2 & 536871934) != 0)
&& ((byteAtPointer(localIP + 1)) == 129)) {
/* begin getErrorObjectFromPrimFailCode */
if (GIV(primFailCode) > 0) {
@@ -4973,7 +4989,7 @@
GIV(instructionPointer) = oopForPointer(localIP);
GIV(stackPointer) = localSP;
GIV(framePointer) = localFP;
- switched = handleStackOverflowOrEventAllowContextSwitch(canContextSwitchIfActivating(methodHeader1));
+ switched = handleStackOverflowOrEventAllowContextSwitch(canContextSwitchIfActivating(methodHeader2));
returnToExecutivepostContextSwitch(1, switched);
/* begin internalizeIPandSP */
assert(GIV(instructionPointer) != (ceReturnToInterpreterPC()));
@@ -9221,6 +9237,8 @@
If there is active contention over the first slot, the second
or third will likely be free for reentry after ejection.
Also, flushing is good when reprobe chains are getting full. */
+/* Override to refuse to cache other than compiled methods.
+ This protects open PICs against having to test for compiled methods. */
static void
addNewMethodToCache(sqInt class) {
@@ -9231,17 +9249,28 @@
sqInt primitiveIndex;
sqInt probe;
+ if (!(((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12))) {
+ primitiveFunctionPointer = primitiveInvokeObjectAsMethod;
+ return;
+ }
/* drop low-order zeros from addresses */
hash = GIV(messageSelector) ^ class;
- /* begin primitiveIndexOf: */
- primBits = (((usqInt) (headerOf(GIV(newMethod)))) >> 1) & 268435967;
- primitiveIndex = (primBits & 511) + (((usqInt) primBits) >> 19);
- /* begin functionPointerFor:inClass: */
- primitiveFunctionPointer = ((void (*)(void)) ((primitiveIndex > MaxPrimitiveIndex
+ if (((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12)) {
+ /* begin primitiveIndexOf: */
+ primBits = (((usqInt) (headerOf(GIV(newMethod)))) >> 1) & 268435967;
+ primitiveIndex = (primBits & 511) + (((usqInt) primBits) >> 19);
+ /* begin functionPointerFor:inClass: */
+ primitiveFunctionPointer = ((void (*)(void)) ((primitiveIndex > MaxPrimitiveIndex
? 0
: primitiveTable[primitiveIndex])));
+ }
+ else {
+ primitiveFunctionPointer = primitiveInvokeObjectAsMethod;
+ }
for (p = 0; p <= (CacheProbeMax - 1); p += 1) {
probe = (((usqInt) hash) >> p) & MethodCacheMask;
if ((GIV(methodCache)[probe + MethodCacheSelector]) == 0) {
@@ -10975,7 +11004,9 @@
}
addNewMethodToCache(class);
}
- if (methodHasCogMethod(GIV(newMethod))) {
+ if (((GIV(newMethod) & 1) == 0)
+ && ((((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12)
+ && (isCogMethodReference(longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))))) {
/* begin executeCogMethodFromUnlinkedSend:withReceiver: */
/* begin cogMethodOf: */
aMethodOop = GIV(newMethod);
@@ -11146,7 +11177,9 @@
}
addNewMethodToCache(class);
}
- if (methodHasCogMethod(GIV(newMethod))) {
+ if (((GIV(newMethod) & 1) == 0)
+ && ((((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12)
+ && (isCogMethodReference(longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))))) {
if (mayLink) {
/* begin cogMethodOf: */
methodHeader1 = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
@@ -14333,26 +14366,33 @@
/* Execute newMethod - either primitiveFunctionPointer must be set directly
(i.e. from primitiveExecuteMethod et al), or it would have been set
probing the method cache (i.e. primitivePerform et al).
- Eagerly compile it if it is large enough so that doits are fast. */
+ Eagerly compile it appropriate so that doits are fast. */
static void
executeNewMethod(void) {
DECL_MAYBE_SQ_GLOBAL_STRUCT
- sqInt aPrimitiveMethod;
sqInt inInterpreter;
sqInt methodHeader;
- sqInt nArgs;
sqInt object;
sqInt object1;
sqInt offset;
sqInt rcvr;
- char *savedFramePointer;
- char *savedStackPointer;
char *sp;
char *sp1;
char *sp11;
char *sp2;
+ if (primitiveFunctionPointer != 0) {
+ if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
+ externalQuickPrimitiveResponse();
+ return;
+ }
+ inInterpreter = GIV(instructionPointer) >= heapBase;
+ if (slowPrimitiveResponse()) {
+ returntoExecutive(popStack(), inInterpreter);
+ return;
+ }
+ }
methodHeader = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
if (!(isCogMethodReference(methodHeader))) {
if (((((usqInt) methodHeader) >> 10) & 255) <= maxLiteralCountForCompile) {
@@ -14363,7 +14403,8 @@
maybeFlagMethodAsInterpreted(GIV(newMethod));
}
}
- if (isCogMethodReference(methodHeader)) {
+ if ((primitiveFunctionPointer == 0)
+ && (isCogMethodReference(methodHeader))) {
/* begin executeCogMethod: */
VM_LABEL(1executeCogMethod);
assertCStackWellAligned();
@@ -14396,55 +14437,6 @@
ceEnterCogCodePopReceiverReg();
return;
}
- if (primitiveFunctionPointer != 0) {
- if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
- externalQuickPrimitiveResponse();
- return;
- }
- inInterpreter = GIV(instructionPointer) >= heapBase;
- /* begin slowPrimitiveResponse */
- if (recordPrimTrace()) {
- /* begin fastLogPrim: */
- GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
- primTraceLogIndex(GIV(primTraceLogIndex) + 1);
- }
- if (FailImbalancedPrimitives) {
- nArgs = GIV(argumentCount);
- savedStackPointer = GIV(stackPointer);
- savedFramePointer = GIV(framePointer);
- }
- /* begin initPrimCall */
- GIV(primFailCode) = 0;
- dispatchFunctionPointer(primitiveFunctionPointer);
- if (FailImbalancedPrimitives
- && ((GIV(primFailCode) == 0)
- && ((GIV(framePointer) == savedFramePointer)
- && (!((((usqInt)(longAt(GIV(framePointer) + FoxMethod)))) < heapBase))))) {
- if (GIV(stackPointer) != (savedStackPointer + (nArgs * BytesPerWord))) {
- flag("Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context");
- GIV(stackPointer) = savedStackPointer;
- failUnbalancedPrimitive();
- }
- }
- if (GIV(nextProfileTick) > 0) {
- /* begin checkProfileTick: */
- aPrimitiveMethod = GIV(newMethod);
- assert(GIV(nextProfileTick) != 0);
- if ((ioHighResClock()) >= GIV(nextProfileTick)) {
- GIV(profileProcess) = longAt(((longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SchedulerAssociation << ShiftForWord))) + BaseHeaderSize) + (ValueIndex << ShiftForWord))) + BaseHeaderSize) + (ActiveProcessIndex << ShiftForWord));
- GIV(profileMethod) = (GIV(primFailCode) == 0
- ? aPrimitiveMethod
- : GIV(nilObj));
- forceInterruptCheck();
- GIV(nextProfileTick) = 0;
- }
- }
- GIV(primFailCode) == 0;
- if (GIV(primFailCode) == 0) {
- returntoExecutive(popStack(), inInterpreter);
- return;
- }
- }
activateNewMethod();
}
@@ -16666,7 +16658,9 @@
}
addNewMethodToCache(class);
}
- if (methodHasCogMethod(GIV(newMethod))) {
+ if (((GIV(newMethod) & 1) == 0)
+ && ((((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12)
+ && (isCogMethodReference(longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))))) {
if (mayLinkBoolean) {
flag("implement creating an MNU PIC sometime");
if (0) {
@@ -18266,6 +18260,14 @@
}
+/* Answer whether the argument object is of compiled method format */
+
+static sqInt
+isCompiledMethod(sqInt oop) {
+ return ((((usqInt) (longAt(oop))) >> 8) & 15) >= 12;
+}
+
+
/* c.f. {BlockContext. MethodContext. PseudoContext} collect: [:class| class
-> class indexIfCompact]
*/
@@ -18357,6 +18359,15 @@
}
+/* Answer whether the oop is an object of compiled method format */
+
+sqInt
+isOopCompiledMethod(sqInt oop) {
+ return ((oop & 1) == 0)
+ && (((((usqInt) (longAt(oop))) >> 8) & 15) >= 12);
+}
+
+
/* Answer true if the argument has only fields that can hold oops. See
comment in formatOf:
*/
@@ -25331,7 +25342,7 @@
theMethod = longAt((context + BaseHeaderSize) + (MethodIndex << ShiftForWord));
if (((theMethod & 1) == 0)
&& ((((((usqInt) (longAt(theMethod))) >> 8) & 15) >= 12)
- && (methodHasCogMethod(theMethod)))) {
+ && (isCogMethodReference(longAt((theMethod + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))))) {
flags = flags | 16;
}
/* begin pop:thenPush: */
@@ -25906,7 +25917,8 @@
if (!(GIV(primFailCode) == 0)) {
GIV(primFailCode) = -2; return;
}
- if (!(((((usqInt) (longAt(methodArg))) >> 8) & 15) >= 12)) {
+ if (!(((methodArg & 1) == 0)
+ && (((((usqInt) (longAt(methodArg))) >> 8) & 15) >= 12))) {
GIV(primFailCode) = -2; return;
}
/* begin headerOf: */
@@ -26496,10 +26508,10 @@
methodArgument = longAt(GIV(stackPointer));
argumentArray = longAt(GIV(stackPointer) + (1 * BytesPerWord));
- if (!(((methodArgument & 1) == 0)
- && ((((((usqInt) (longAt(methodArgument))) >> 8) & 15) >= 12)
- && (((argumentArray & 1) == 0)
- && (((((usqInt) (longAt(argumentArray))) >> 8) & 15) == 2))))) {
+ if (!((((methodArgument & 1) == 0)
+ && (((((usqInt) (longAt(methodArgument))) >> 8) & 15) >= 12))
+ && (((argumentArray & 1) == 0)
+ && (((((usqInt) (longAt(argumentArray))) >> 8) & 15) == 2)))) {
GIV(primFailCode) = PrimErrBadArgument; return;
}
/* begin argumentCountOf: */
@@ -30389,6 +30401,74 @@
}
+/* Primitive. 'Invoke' an object like a function, sending the special message
+ run: originalSelector with: arguments in: aReceiver.
+ */
+
+static void
+primitiveInvokeObjectAsMethod(void) {
+DECL_MAYBE_SQ_GLOBAL_STRUCT
+ sqInt ccIndex;
+ sqInt i;
+ sqInt lookupClass;
+ sqInt runArgs;
+ sqInt runReceiver;
+ char *sp;
+ char *sp1;
+ char *sp2;
+ char *sp3;
+ sqInt top;
+ sqInt top1;
+ sqInt valuePointer;
+
+ runArgs = instantiateClassindexableSize(longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassArray << ShiftForWord)), GIV(argumentCount));
+ for (i = (GIV(argumentCount) - 1); i >= 0; i += -1) {
+ /* begin storePointerUnchecked:ofObject:withValue: */
+ /* begin popStack */
+ top1 = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ valuePointer = top1;
+ longAtput((runArgs + BaseHeaderSize) + (i << ShiftForWord), valuePointer);
+ }
+ /* begin popStack */
+ top = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ runReceiver = top;
+ /* begin push: */
+ longAtput(sp = GIV(stackPointer) - BytesPerWord, GIV(newMethod));
+ GIV(stackPointer) = sp;
+ /* begin push: */
+ longAtput(sp1 = GIV(stackPointer) - BytesPerWord, GIV(messageSelector));
+ GIV(stackPointer) = sp1;
+ /* begin push: */
+ longAtput(sp2 = GIV(stackPointer) - BytesPerWord, runArgs);
+ GIV(stackPointer) = sp2;
+ /* begin push: */
+ longAtput(sp3 = GIV(stackPointer) - BytesPerWord, runReceiver);
+ GIV(stackPointer) = sp3;
+ GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorRunWithIn << ShiftForWord));
+ GIV(argumentCount) = 3;
+ /* begin fetchClassOf: */
+ if ((GIV(newMethod) & 1)) {
+ lookupClass = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassInteger << ShiftForWord));
+ goto l1;
+ }
+ if (((ccIndex = (((usqInt) (longAt(GIV(newMethod)))) >> 12) & 31)) == 0) {
+ lookupClass = (longAt(GIV(newMethod) - BaseHeaderSize)) & AllButTypeMask;
+ goto l1;
+ }
+ else {
+ lookupClass = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
+ goto l1;
+ }
+l1: /* end fetchClassOf: */;
+ findNewMethodInClass(lookupClass);
+ executeNewMethod();
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+}
+
+
/* Primitive. Answer whether the argument to the primitive is a root for
young space
*/
@@ -32713,16 +32793,16 @@
GIV(argumentCount) = arraySize;
GIV(messageSelector) = selector;
findNewMethodInClass(lookupClass);
- if (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12) {
- if ((argumentCountOf(GIV(newMethod))) != GIV(argumentCount)) {
- /* begin pop: */
- GIV(stackPointer) += (arraySize + 1) * BytesPerWord;
- /* begin popStack */
- top = longAt(GIV(stackPointer));
- GIV(stackPointer) += BytesPerWord;
- GIV(newMethod) = ((sqInt) top);
- return GIV(primFailCode) = PrimErrBadNumArgs;
- }
+ if (!((((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12))
+ && ((argumentCountOf(GIV(newMethod))) == GIV(argumentCount)))) {
+ /* begin pop: */
+ GIV(stackPointer) += (arraySize + 1) * BytesPerWord;
+ /* begin popStack */
+ top = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ GIV(newMethod) = ((sqInt) top);
+ return GIV(primFailCode) = PrimErrBadNumArgs;
}
/* +2 = receiver + saved newMethod */
@@ -32765,7 +32845,6 @@
sqInt newReceiver;
sqInt performMethod;
sqInt performSelector;
- sqInt successBoolean;
performSelector = GIV(messageSelector);
performMethod = GIV(newMethod);
@@ -32797,24 +32876,9 @@
}
l1: /* end fetchClassOf: */;
findNewMethodInClass(lookupClass);
- if (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12) {
- /* begin success: */
- successBoolean = (argumentCountOf(GIV(newMethod))) == GIV(argumentCount);
- if (!(successBoolean)) {
- if (GIV(primFailCode) == 0) {
-
- /* Don't overwrite an error code that has already been set. */
-
- GIV(primFailCode) = 1;
- }
- }
- }
- if (GIV(primFailCode) == 0) {
- executeNewMethod();
- /* begin initPrimCall */
- GIV(primFailCode) = 0;
- }
- else {
+ if (!((((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12))
+ && ((argumentCountOf(GIV(newMethod))) == GIV(argumentCount)))) {
/* begin unPop: */
GIV(stackPointer) -= 1 * BytesPerWord;
for (i = 1; i <= GIV(argumentCount); i += 1) {
@@ -32824,7 +32888,16 @@
GIV(argumentCount) += 1;
GIV(newMethod) = performMethod;
GIV(messageSelector) = performSelector;
+ /* begin primitiveFail */
+ if (GIV(primFailCode) == 0) {
+ GIV(primFailCode) = 1;
+ }
+ return;
}
+ executeNewMethod();
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+ return;
}
static void
@@ -41238,6 +41311,56 @@
}
+/* Called under the assumption that primFunctionPtr has been preloaded */
+
+static sqInt
+slowPrimitiveResponse(void) {
+DECL_MAYBE_SQ_GLOBAL_STRUCT
+ sqInt aPrimitiveMethod;
+ sqInt nArgs;
+ char *savedFramePointer;
+ char *savedStackPointer;
+
+ if (recordPrimTrace()) {
+ /* begin fastLogPrim: */
+ GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
+ primTraceLogIndex(GIV(primTraceLogIndex) + 1);
+ }
+ if (FailImbalancedPrimitives) {
+ nArgs = GIV(argumentCount);
+ savedStackPointer = GIV(stackPointer);
+ savedFramePointer = GIV(framePointer);
+ }
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+ dispatchFunctionPointer(primitiveFunctionPointer);
+ if (FailImbalancedPrimitives
+ && ((GIV(primFailCode) == 0)
+ && ((GIV(framePointer) == savedFramePointer)
+ && (!((((usqInt)(longAt(GIV(framePointer) + FoxMethod)))) < heapBase))))) {
+ if (GIV(stackPointer) != (savedStackPointer + (nArgs * BytesPerWord))) {
+ flag("Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context");
+ GIV(stackPointer) = savedStackPointer;
+ failUnbalancedPrimitive();
+ }
+ }
+ if (GIV(nextProfileTick) > 0) {
+ /* begin checkProfileTick: */
+ aPrimitiveMethod = GIV(newMethod);
+ assert(GIV(nextProfileTick) != 0);
+ if ((ioHighResClock()) >= GIV(nextProfileTick)) {
+ GIV(profileProcess) = longAt(((longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SchedulerAssociation << ShiftForWord))) + BaseHeaderSize) + (ValueIndex << ShiftForWord))) + BaseHeaderSize) + (ActiveProcessIndex << ShiftForWord));
+ GIV(profileMethod) = (GIV(primFailCode) == 0
+ ? aPrimitiveMethod
+ : GIV(nilObj));
+ forceInterruptCheck();
+ GIV(nextProfileTick) = 0;
+ }
+ }
+ return GIV(primFailCode) == 0;
+}
+
+
/* update state of active context */
static void
Modified: branches/Cog/src/vm/cointerp.h
===================================================================
--- branches/Cog/src/vm/cointerp.h 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/src/vm/cointerp.h 2010-09-26 02:24:21 UTC (rev 2313)
@@ -1,5 +1,5 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19
+ CCodeGeneratorGlobalStructure VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
*/
@@ -73,6 +73,7 @@
usqInt instructionPointerAddress(void);
sqInt isMarked(sqInt oop);
sqInt isNonIntegerObject(sqInt objectPointer);
+sqInt isOopCompiledMethod(sqInt oop);
sqInt isQuickPrimitiveIndex(sqInt anInteger);
sqInt isReallyYoungObject(sqInt obj);
sqInt isYoung(sqInt oop);
Modified: branches/Cog/src/vm/gcc3x-cointerp.c
===================================================================
--- branches/Cog/src/vm/gcc3x-cointerp.c 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/src/vm/gcc3x-cointerp.c 2010-09-26 02:24:21 UTC (rev 2313)
@@ -2,11 +2,11 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19
+ CCodeGeneratorGlobalStructure VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
from
- CoInterpreter VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19
+ CoInterpreter VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
*/
-static char __buildInfo[] = "CoInterpreter VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19 " __DATE__ ;
+static char __buildInfo[] = "CoInterpreter VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf " __DATE__ ;
char *__interpBuildInfo = __buildInfo;
@@ -270,6 +270,7 @@
#define SelectorCannotReturn 21
#define SelectorDoesNotUnderstand 20
#define SelectorMustBeBoolean 25
+#define SelectorRunWithIn 49
#define SelectorStart 2
#define SenderIndex 0
#define ShiftForWord 2
@@ -559,6 +560,7 @@
static sqInt isBaseFrame(char *theFP);
sqInt isBytes(sqInt oop);
static sqInt isCogMethodReference(sqInt methodHeader);
+static sqInt isCompiledMethod(sqInt oop);
static sqInt isContextHeader(sqInt aHeader);
static sqInt isContext(sqInt oop);
sqInt isFloatObject(sqInt oop);
@@ -572,6 +574,7 @@
sqInt isMarked(sqInt oop);
static sqInt isMarriedOrWidowedContext(sqInt aContext);
sqInt isNonIntegerObject(sqInt objectPointer);
+sqInt isOopCompiledMethod(sqInt oop);
sqInt isPointers(sqInt oop);
static sqInt isPrimitiveFunctionPointerAnIndex(void);
sqInt isQuickPrimitiveIndex(sqInt anInteger);
@@ -796,6 +799,7 @@
static void primitiveIntegerAtPut(void);
EXPORT(void) primitiveInterruptChecksPerMSec(void);
static void primitiveInterruptSemaphore(void);
+static void primitiveInvokeObjectAsMethod(void);
EXPORT(void) primitiveIsRoot(void);
EXPORT(void) primitiveIsWindowObscured(void);
EXPORT(void) primitiveIsYoung(void);
@@ -1004,6 +1008,7 @@
static sqInt sizeOfFree(sqInt oop);
sqInt sizeOfSTArrayFromCPrimitive(void *cPtr);
sqInt slotSizeOf(sqInt oop);
+static sqInt slowPrimitiveResponse(void);
static void snapshot(sqInt embedded);
static void space(void);
sqInt specialSelectorNumArgs(sqInt index);
@@ -1082,8 +1087,8 @@
_iss usqInt method;
_iss sqInt argumentCount;
_iss usqInt youngStart;
+_iss usqInt newMethod;
_iss sqInt messageSelector;
-_iss usqInt newMethod;
_iss usqInt endOfMemory;
_iss sqInt rootTableCount;
_iss StackPage * pages;
@@ -1486,7 +1491,7 @@
/* 245 */ (void (*)(void))0,
/* 246 */ (void (*)(void))0,
/* 247 */ primitiveSnapshotEmbedded,
- /* 248 */ (void (*)(void))0,
+ /* 248 */ primitiveInvokeObjectAsMethod,
/* 249 */ primitiveArrayBecomeOneWayCopyHash,
/* 250 */ primitiveClearVMProfile,
/* 251 */ primitiveControlVMProfiling,
@@ -1816,7 +1821,7 @@
/* 575 */ (void (*)(void))0,
0 };
static void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* 4097 */])(void);
-const char *interpreterVersion = "Croquet Closure Cog VM [CoInterpreter VMMaker-oscog.32]";
+const char *interpreterVersion = "Croquet Closure Cog VM [CoInterpreter VMMaker-oscog.33]";
static volatile int sendTrace;
sqInt suppressHeartbeatFlag;
@@ -4659,7 +4664,7 @@
sqInt probe;
CogMethod *cogMethod;
sqInt methodHeader;
- sqInt methodHeader2;
+ sqInt methodHeader3;
sqInt succeeded;
sqInt rcvr;
sqInt offset;
@@ -4674,11 +4679,12 @@
char *savedStackPointer;
sqInt errorCode;
sqInt i;
- sqInt methodHeader1;
+ sqInt methodHeader2;
sqInt numTemps;
sqInt rcvr1;
sqInt switched;
sqInt table;
+ sqInt methodHeader1;
sqInt object2;
sqInt localPrimIndex;
sqInt oop;
@@ -4769,50 +4775,6 @@
}
/* begin internalExecuteNewMethod */
VM_LABEL(0internalExecuteNewMethod);
- methodHeader2 = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
- if (isCogMethodReference(methodHeader2)) {
- /* begin externalizeIPandSP */
- assert((((usqInt)localIP)) != (ceReturnToInterpreterPC()));
- GIV(instructionPointer) = oopForPointer(localIP);
- GIV(stackPointer) = localSP;
- GIV(framePointer) = localFP;
- /* begin executeCogMethod: */
- VM_LABEL(0executeCogMethod);
- assertCStackWellAligned();
- /* begin assertValidExecutionPointe:r:s: */
- assertValidExecutionPointersimbar(GIV(instructionPointer), GIV(framePointer), GIV(stackPointer), !((((usqInt)(longAt(GIV(framePointer) + FoxMethod)))) < heapBase));
- /* begin stackValue: */
- offset = (((CogMethod *) methodHeader2)->cmNumArgs);
- rcvr = longAt(GIV(stackPointer) + (offset * BytesPerWord));
- /* begin ensurePushedInstructionPointer */
- if ((((usqInt)GIV(instructionPointer))) >= heapBase) {
- /* begin iframeSavedIP:put: */
- longAtput(GIV(framePointer) + FoxIFSavedIP, GIV(instructionPointer));
- /* begin push: */
- object1 = ceReturnToInterpreterPC();
- longAtput(sp2 = GIV(stackPointer) - BytesPerWord, object1);
- GIV(stackPointer) = sp2;
- }
- else {
- /* begin push: */
- longAtput(sp11 = GIV(stackPointer) - BytesPerWord, GIV(instructionPointer));
- GIV(stackPointer) = sp11;
- }
- /* begin push: */
- object = (((usqInt)(((CogMethod *) methodHeader2)))) + (noCheckEntryOffset());
- longAtput(sp = GIV(stackPointer) - BytesPerWord, object);
- GIV(stackPointer) = sp;
- /* begin push: */
- longAtput(sp1 = GIV(stackPointer) - BytesPerWord, rcvr);
- GIV(stackPointer) = sp1;
- ceEnterCogCodePopReceiverReg();
- /* begin internalizeIPandSP */
- assert(GIV(instructionPointer) != (ceReturnToInterpreterPC()));
- localIP = pointerForOop(GIV(instructionPointer));
- localSP = pointerForOop(GIV(stackPointer));
- localFP = pointerForOop(GIV(framePointer));
- goto l105;
- }
if (primitiveFunctionPointer != 0) {
if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
/* begin internalQuickPrimitiveResponse */
@@ -4903,11 +4865,65 @@
goto l105;
}
}
+ else {
+
+ /* Entry into a cogged method evaluates the primitive if it has one, but since we must not
+ invoke the primitive twice we only execute the cogged method if it has no primitive. */
+
+ methodHeader3 = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
+ if (isCogMethodReference(methodHeader3)) {
+ /* begin externalizeIPandSP */
+ assert((((usqInt)localIP)) != (ceReturnToInterpreterPC()));
+ GIV(instructionPointer) = oopForPointer(localIP);
+ GIV(stackPointer) = localSP;
+ GIV(framePointer) = localFP;
+ /* begin executeCogMethod: */
+ VM_LABEL(0executeCogMethod);
+ assertCStackWellAligned();
+ /* begin assertValidExecutionPointe:r:s: */
+ assertValidExecutionPointersimbar(GIV(instructionPointer), GIV(framePointer), GIV(stackPointer), !((((usqInt)(longAt(GIV(framePointer) + FoxMethod)))) < heapBase));
+ /* begin stackValue: */
+ offset = (((CogMethod *) methodHeader3)->cmNumArgs);
+ rcvr = longAt(GIV(stackPointer) + (offset * BytesPerWord));
+ /* begin ensurePushedInstructionPointer */
+ if ((((usqInt)GIV(instructionPointer))) >= heapBase) {
+ /* begin iframeSavedIP:put: */
+ longAtput(GIV(framePointer) + FoxIFSavedIP, GIV(instructionPointer));
+ /* begin push: */
+ object1 = ceReturnToInterpreterPC();
+ longAtput(sp2 = GIV(stackPointer) - BytesPerWord, object1);
+ GIV(stackPointer) = sp2;
+ }
+ else {
+ /* begin push: */
+ longAtput(sp11 = GIV(stackPointer) - BytesPerWord, GIV(instructionPointer));
+ GIV(stackPointer) = sp11;
+ }
+ /* begin push: */
+ object = (((usqInt)(((CogMethod *) methodHeader3)))) + (noCheckEntryOffset());
+ longAtput(sp = GIV(stackPointer) - BytesPerWord, object);
+ GIV(stackPointer) = sp;
+ /* begin push: */
+ longAtput(sp1 = GIV(stackPointer) - BytesPerWord, rcvr);
+ GIV(stackPointer) = sp1;
+ ceEnterCogCodePopReceiverReg();
+ /* begin internalizeIPandSP */
+ assert(GIV(instructionPointer) != (ceReturnToInterpreterPC()));
+ localIP = pointerForOop(GIV(instructionPointer));
+ localSP = pointerForOop(GIV(stackPointer));
+ localFP = pointerForOop(GIV(framePointer));
+ goto l105;
+ }
+ }
/* begin internalActivateNewMethod */
VM_LABEL(0internalActivateNewMethod);
+ assert(isCompiledMethod(GIV(newMethod)));
+ /* begin headerOf: */
methodHeader1 = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
- assert(!(isCogMethodReference(methodHeader1)));
- numTemps = (((usqInt) methodHeader1) >> 19) & 63;
+ methodHeader2 = (isCogMethodReference(methodHeader1)
+ ? (((CogMethod *) methodHeader1)->methodHeader)
+ : methodHeader1);
+ numTemps = (((usqInt) methodHeader2) >> 19) & 63;
/* could new rcvr be set at point of send? */
@@ -4926,12 +4942,12 @@
longAtPointerput(localSP -= BytesPerWord, GIV(nilObj));
/* begin internalPush: */
object2 = (VMBIGENDIAN
- ? ((1 + (((((usqInt) methodHeader1) >> 25) & 15) << ((BytesPerWord * 8) - 8))) + ((0
+ ? ((1 + (((((usqInt) methodHeader2) >> 25) & 15) << ((BytesPerWord * 8) - 8))) + ((0
? 1 << ((BytesPerWord * 8) - 16)
: 0))) + ((0
? 1 << ((BytesPerWord * 8) - 24)
: 0))
- : ((1 + (((((usqInt) methodHeader1) >> 25) & 15) << 8)) + ((0
+ : ((1 + (((((usqInt) methodHeader2) >> 25) & 15) << 8)) + ((0
? 1 << 16
: 0))) + ((0
? 1 << 24
@@ -4950,9 +4966,9 @@
by an initial long store temp bytecode). Protect against obsolete values
in primFailCode by checking that newMethod actually has a primitive? */
- localIP = pointerForOop(((GIV(newMethod) + ((LiteralStart + ((((usqInt) methodHeader1) >> 10) & 255)) * BytesPerWord)) + BaseHeaderSize) - 1);
+ localIP = pointerForOop(((GIV(newMethod) + ((LiteralStart + ((((usqInt) methodHeader2) >> 10) & 255)) * BytesPerWord)) + BaseHeaderSize) - 1);
if (GIV(primFailCode) != 0) {
- if (((methodHeader1 & 536871934) != 0)
+ if (((methodHeader2 & 536871934) != 0)
&& ((byteAtPointer(localIP + 1)) == 129)) {
/* begin getErrorObjectFromPrimFailCode */
if (GIV(primFailCode) > 0) {
@@ -4977,7 +4993,7 @@
GIV(instructionPointer) = oopForPointer(localIP);
GIV(stackPointer) = localSP;
GIV(framePointer) = localFP;
- switched = handleStackOverflowOrEventAllowContextSwitch(canContextSwitchIfActivating(methodHeader1));
+ switched = handleStackOverflowOrEventAllowContextSwitch(canContextSwitchIfActivating(methodHeader2));
returnToExecutivepostContextSwitch(1, switched);
/* begin internalizeIPandSP */
assert(GIV(instructionPointer) != (ceReturnToInterpreterPC()));
@@ -9225,6 +9241,8 @@
If there is active contention over the first slot, the second
or third will likely be free for reentry after ejection.
Also, flushing is good when reprobe chains are getting full. */
+/* Override to refuse to cache other than compiled methods.
+ This protects open PICs against having to test for compiled methods. */
static void
addNewMethodToCache(sqInt class) {
@@ -9235,17 +9253,28 @@
sqInt primitiveIndex;
sqInt probe;
+ if (!(((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12))) {
+ primitiveFunctionPointer = primitiveInvokeObjectAsMethod;
+ return;
+ }
/* drop low-order zeros from addresses */
hash = GIV(messageSelector) ^ class;
- /* begin primitiveIndexOf: */
- primBits = (((usqInt) (headerOf(GIV(newMethod)))) >> 1) & 268435967;
- primitiveIndex = (primBits & 511) + (((usqInt) primBits) >> 19);
- /* begin functionPointerFor:inClass: */
- primitiveFunctionPointer = ((void (*)(void)) ((primitiveIndex > MaxPrimitiveIndex
+ if (((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12)) {
+ /* begin primitiveIndexOf: */
+ primBits = (((usqInt) (headerOf(GIV(newMethod)))) >> 1) & 268435967;
+ primitiveIndex = (primBits & 511) + (((usqInt) primBits) >> 19);
+ /* begin functionPointerFor:inClass: */
+ primitiveFunctionPointer = ((void (*)(void)) ((primitiveIndex > MaxPrimitiveIndex
? 0
: primitiveTable[primitiveIndex])));
+ }
+ else {
+ primitiveFunctionPointer = primitiveInvokeObjectAsMethod;
+ }
for (p = 0; p <= (CacheProbeMax - 1); p += 1) {
probe = (((usqInt) hash) >> p) & MethodCacheMask;
if ((GIV(methodCache)[probe + MethodCacheSelector]) == 0) {
@@ -10979,7 +11008,9 @@
}
addNewMethodToCache(class);
}
- if (methodHasCogMethod(GIV(newMethod))) {
+ if (((GIV(newMethod) & 1) == 0)
+ && ((((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12)
+ && (isCogMethodReference(longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))))) {
/* begin executeCogMethodFromUnlinkedSend:withReceiver: */
/* begin cogMethodOf: */
aMethodOop = GIV(newMethod);
@@ -11150,7 +11181,9 @@
}
addNewMethodToCache(class);
}
- if (methodHasCogMethod(GIV(newMethod))) {
+ if (((GIV(newMethod) & 1) == 0)
+ && ((((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12)
+ && (isCogMethodReference(longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))))) {
if (mayLink) {
/* begin cogMethodOf: */
methodHeader1 = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
@@ -14337,26 +14370,33 @@
/* Execute newMethod - either primitiveFunctionPointer must be set directly
(i.e. from primitiveExecuteMethod et al), or it would have been set
probing the method cache (i.e. primitivePerform et al).
- Eagerly compile it if it is large enough so that doits are fast. */
+ Eagerly compile it appropriate so that doits are fast. */
static void
executeNewMethod(void) {
DECL_MAYBE_SQ_GLOBAL_STRUCT
- sqInt aPrimitiveMethod;
sqInt inInterpreter;
sqInt methodHeader;
- sqInt nArgs;
sqInt object;
sqInt object1;
sqInt offset;
sqInt rcvr;
- char *savedFramePointer;
- char *savedStackPointer;
char *sp;
char *sp1;
char *sp11;
char *sp2;
+ if (primitiveFunctionPointer != 0) {
+ if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
+ externalQuickPrimitiveResponse();
+ return;
+ }
+ inInterpreter = GIV(instructionPointer) >= heapBase;
+ if (slowPrimitiveResponse()) {
+ returntoExecutive(popStack(), inInterpreter);
+ return;
+ }
+ }
methodHeader = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
if (!(isCogMethodReference(methodHeader))) {
if (((((usqInt) methodHeader) >> 10) & 255) <= maxLiteralCountForCompile) {
@@ -14367,7 +14407,8 @@
maybeFlagMethodAsInterpreted(GIV(newMethod));
}
}
- if (isCogMethodReference(methodHeader)) {
+ if ((primitiveFunctionPointer == 0)
+ && (isCogMethodReference(methodHeader))) {
/* begin executeCogMethod: */
VM_LABEL(1executeCogMethod);
assertCStackWellAligned();
@@ -14400,55 +14441,6 @@
ceEnterCogCodePopReceiverReg();
return;
}
- if (primitiveFunctionPointer != 0) {
- if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
- externalQuickPrimitiveResponse();
- return;
- }
- inInterpreter = GIV(instructionPointer) >= heapBase;
- /* begin slowPrimitiveResponse */
- if (recordPrimTrace()) {
- /* begin fastLogPrim: */
- GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
- primTraceLogIndex(GIV(primTraceLogIndex) + 1);
- }
- if (FailImbalancedPrimitives) {
- nArgs = GIV(argumentCount);
- savedStackPointer = GIV(stackPointer);
- savedFramePointer = GIV(framePointer);
- }
- /* begin initPrimCall */
- GIV(primFailCode) = 0;
- dispatchFunctionPointer(primitiveFunctionPointer);
- if (FailImbalancedPrimitives
- && ((GIV(primFailCode) == 0)
- && ((GIV(framePointer) == savedFramePointer)
- && (!((((usqInt)(longAt(GIV(framePointer) + FoxMethod)))) < heapBase))))) {
- if (GIV(stackPointer) != (savedStackPointer + (nArgs * BytesPerWord))) {
- flag("Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context");
- GIV(stackPointer) = savedStackPointer;
- failUnbalancedPrimitive();
- }
- }
- if (GIV(nextProfileTick) > 0) {
- /* begin checkProfileTick: */
- aPrimitiveMethod = GIV(newMethod);
- assert(GIV(nextProfileTick) != 0);
- if ((ioHighResClock()) >= GIV(nextProfileTick)) {
- GIV(profileProcess) = longAt(((longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SchedulerAssociation << ShiftForWord))) + BaseHeaderSize) + (ValueIndex << ShiftForWord))) + BaseHeaderSize) + (ActiveProcessIndex << ShiftForWord));
- GIV(profileMethod) = (GIV(primFailCode) == 0
- ? aPrimitiveMethod
- : GIV(nilObj));
- forceInterruptCheck();
- GIV(nextProfileTick) = 0;
- }
- }
- GIV(primFailCode) == 0;
- if (GIV(primFailCode) == 0) {
- returntoExecutive(popStack(), inInterpreter);
- return;
- }
- }
activateNewMethod();
}
@@ -16670,7 +16662,9 @@
}
addNewMethodToCache(class);
}
- if (methodHasCogMethod(GIV(newMethod))) {
+ if (((GIV(newMethod) & 1) == 0)
+ && ((((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12)
+ && (isCogMethodReference(longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))))) {
if (mayLinkBoolean) {
flag("implement creating an MNU PIC sometime");
if (0) {
@@ -18270,6 +18264,14 @@
}
+/* Answer whether the argument object is of compiled method format */
+
+static sqInt
+isCompiledMethod(sqInt oop) {
+ return ((((usqInt) (longAt(oop))) >> 8) & 15) >= 12;
+}
+
+
/* c.f. {BlockContext. MethodContext. PseudoContext} collect: [:class| class
-> class indexIfCompact]
*/
@@ -18361,6 +18363,15 @@
}
+/* Answer whether the oop is an object of compiled method format */
+
+sqInt
+isOopCompiledMethod(sqInt oop) {
+ return ((oop & 1) == 0)
+ && (((((usqInt) (longAt(oop))) >> 8) & 15) >= 12);
+}
+
+
/* Answer true if the argument has only fields that can hold oops. See
comment in formatOf:
*/
@@ -25335,7 +25346,7 @@
theMethod = longAt((context + BaseHeaderSize) + (MethodIndex << ShiftForWord));
if (((theMethod & 1) == 0)
&& ((((((usqInt) (longAt(theMethod))) >> 8) & 15) >= 12)
- && (methodHasCogMethod(theMethod)))) {
+ && (isCogMethodReference(longAt((theMethod + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))))) {
flags = flags | 16;
}
/* begin pop:thenPush: */
@@ -25910,7 +25921,8 @@
if (!(GIV(primFailCode) == 0)) {
GIV(primFailCode) = -2; return;
}
- if (!(((((usqInt) (longAt(methodArg))) >> 8) & 15) >= 12)) {
+ if (!(((methodArg & 1) == 0)
+ && (((((usqInt) (longAt(methodArg))) >> 8) & 15) >= 12))) {
GIV(primFailCode) = -2; return;
}
/* begin headerOf: */
@@ -26500,10 +26512,10 @@
methodArgument = longAt(GIV(stackPointer));
argumentArray = longAt(GIV(stackPointer) + (1 * BytesPerWord));
- if (!(((methodArgument & 1) == 0)
- && ((((((usqInt) (longAt(methodArgument))) >> 8) & 15) >= 12)
- && (((argumentArray & 1) == 0)
- && (((((usqInt) (longAt(argumentArray))) >> 8) & 15) == 2))))) {
+ if (!((((methodArgument & 1) == 0)
+ && (((((usqInt) (longAt(methodArgument))) >> 8) & 15) >= 12))
+ && (((argumentArray & 1) == 0)
+ && (((((usqInt) (longAt(argumentArray))) >> 8) & 15) == 2)))) {
GIV(primFailCode) = PrimErrBadArgument; return;
}
/* begin argumentCountOf: */
@@ -30393,6 +30405,74 @@
}
+/* Primitive. 'Invoke' an object like a function, sending the special message
+ run: originalSelector with: arguments in: aReceiver.
+ */
+
+static void
+primitiveInvokeObjectAsMethod(void) {
+DECL_MAYBE_SQ_GLOBAL_STRUCT
+ sqInt ccIndex;
+ sqInt i;
+ sqInt lookupClass;
+ sqInt runArgs;
+ sqInt runReceiver;
+ char *sp;
+ char *sp1;
+ char *sp2;
+ char *sp3;
+ sqInt top;
+ sqInt top1;
+ sqInt valuePointer;
+
+ runArgs = instantiateClassindexableSize(longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassArray << ShiftForWord)), GIV(argumentCount));
+ for (i = (GIV(argumentCount) - 1); i >= 0; i += -1) {
+ /* begin storePointerUnchecked:ofObject:withValue: */
+ /* begin popStack */
+ top1 = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ valuePointer = top1;
+ longAtput((runArgs + BaseHeaderSize) + (i << ShiftForWord), valuePointer);
+ }
+ /* begin popStack */
+ top = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ runReceiver = top;
+ /* begin push: */
+ longAtput(sp = GIV(stackPointer) - BytesPerWord, GIV(newMethod));
+ GIV(stackPointer) = sp;
+ /* begin push: */
+ longAtput(sp1 = GIV(stackPointer) - BytesPerWord, GIV(messageSelector));
+ GIV(stackPointer) = sp1;
+ /* begin push: */
+ longAtput(sp2 = GIV(stackPointer) - BytesPerWord, runArgs);
+ GIV(stackPointer) = sp2;
+ /* begin push: */
+ longAtput(sp3 = GIV(stackPointer) - BytesPerWord, runReceiver);
+ GIV(stackPointer) = sp3;
+ GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorRunWithIn << ShiftForWord));
+ GIV(argumentCount) = 3;
+ /* begin fetchClassOf: */
+ if ((GIV(newMethod) & 1)) {
+ lookupClass = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassInteger << ShiftForWord));
+ goto l1;
+ }
+ if (((ccIndex = (((usqInt) (longAt(GIV(newMethod)))) >> 12) & 31)) == 0) {
+ lookupClass = (longAt(GIV(newMethod) - BaseHeaderSize)) & AllButTypeMask;
+ goto l1;
+ }
+ else {
+ lookupClass = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
+ goto l1;
+ }
+l1: /* end fetchClassOf: */;
+ findNewMethodInClass(lookupClass);
+ executeNewMethod();
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+}
+
+
/* Primitive. Answer whether the argument to the primitive is a root for
young space
*/
@@ -32717,16 +32797,16 @@
GIV(argumentCount) = arraySize;
GIV(messageSelector) = selector;
findNewMethodInClass(lookupClass);
- if (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12) {
- if ((argumentCountOf(GIV(newMethod))) != GIV(argumentCount)) {
- /* begin pop: */
- GIV(stackPointer) += (arraySize + 1) * BytesPerWord;
- /* begin popStack */
- top = longAt(GIV(stackPointer));
- GIV(stackPointer) += BytesPerWord;
- GIV(newMethod) = ((sqInt) top);
- return GIV(primFailCode) = PrimErrBadNumArgs;
- }
+ if (!((((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12))
+ && ((argumentCountOf(GIV(newMethod))) == GIV(argumentCount)))) {
+ /* begin pop: */
+ GIV(stackPointer) += (arraySize + 1) * BytesPerWord;
+ /* begin popStack */
+ top = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ GIV(newMethod) = ((sqInt) top);
+ return GIV(primFailCode) = PrimErrBadNumArgs;
}
/* +2 = receiver + saved newMethod */
@@ -32769,7 +32849,6 @@
sqInt newReceiver;
sqInt performMethod;
sqInt performSelector;
- sqInt successBoolean;
performSelector = GIV(messageSelector);
performMethod = GIV(newMethod);
@@ -32801,24 +32880,9 @@
}
l1: /* end fetchClassOf: */;
findNewMethodInClass(lookupClass);
- if (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12) {
- /* begin success: */
- successBoolean = (argumentCountOf(GIV(newMethod))) == GIV(argumentCount);
- if (!(successBoolean)) {
- if (GIV(primFailCode) == 0) {
-
- /* Don't overwrite an error code that has already been set. */
-
- GIV(primFailCode) = 1;
- }
- }
- }
- if (GIV(primFailCode) == 0) {
- executeNewMethod();
- /* begin initPrimCall */
- GIV(primFailCode) = 0;
- }
- else {
+ if (!((((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12))
+ && ((argumentCountOf(GIV(newMethod))) == GIV(argumentCount)))) {
/* begin unPop: */
GIV(stackPointer) -= 1 * BytesPerWord;
for (i = 1; i <= GIV(argumentCount); i += 1) {
@@ -32828,7 +32892,16 @@
GIV(argumentCount) += 1;
GIV(newMethod) = performMethod;
GIV(messageSelector) = performSelector;
+ /* begin primitiveFail */
+ if (GIV(primFailCode) == 0) {
+ GIV(primFailCode) = 1;
+ }
+ return;
}
+ executeNewMethod();
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+ return;
}
static void
@@ -41242,6 +41315,56 @@
}
+/* Called under the assumption that primFunctionPtr has been preloaded */
+
+static sqInt
+slowPrimitiveResponse(void) {
+DECL_MAYBE_SQ_GLOBAL_STRUCT
+ sqInt aPrimitiveMethod;
+ sqInt nArgs;
+ char *savedFramePointer;
+ char *savedStackPointer;
+
+ if (recordPrimTrace()) {
+ /* begin fastLogPrim: */
+ GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
+ primTraceLogIndex(GIV(primTraceLogIndex) + 1);
+ }
+ if (FailImbalancedPrimitives) {
+ nArgs = GIV(argumentCount);
+ savedStackPointer = GIV(stackPointer);
+ savedFramePointer = GIV(framePointer);
+ }
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+ dispatchFunctionPointer(primitiveFunctionPointer);
+ if (FailImbalancedPrimitives
+ && ((GIV(primFailCode) == 0)
+ && ((GIV(framePointer) == savedFramePointer)
+ && (!((((usqInt)(longAt(GIV(framePointer) + FoxMethod)))) < heapBase))))) {
+ if (GIV(stackPointer) != (savedStackPointer + (nArgs * BytesPerWord))) {
+ flag("Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context");
+ GIV(stackPointer) = savedStackPointer;
+ failUnbalancedPrimitive();
+ }
+ }
+ if (GIV(nextProfileTick) > 0) {
+ /* begin checkProfileTick: */
+ aPrimitiveMethod = GIV(newMethod);
+ assert(GIV(nextProfileTick) != 0);
+ if ((ioHighResClock()) >= GIV(nextProfileTick)) {
+ GIV(profileProcess) = longAt(((longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SchedulerAssociation << ShiftForWord))) + BaseHeaderSize) + (ValueIndex << ShiftForWord))) + BaseHeaderSize) + (ActiveProcessIndex << ShiftForWord));
+ GIV(profileMethod) = (GIV(primFailCode) == 0
+ ? aPrimitiveMethod
+ : GIV(nilObj));
+ forceInterruptCheck();
+ GIV(nextProfileTick) = 0;
+ }
+ }
+ return GIV(primFailCode) == 0;
+}
+
+
/* update state of active context */
static void
Modified: branches/Cog/src/vm/interp.h
===================================================================
--- branches/Cog/src/vm/interp.h 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/src/vm/interp.h 2010-09-26 02:24:21 UTC (rev 2313)
@@ -1,5 +1,5 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.32 uuid: 610266ce-1a35-4d42-8ff9-b30ed3736b19
+ CCodeGeneratorGlobalStructure VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
*/
#define COGVM 1
Modified: branches/Cog/stacksrc/vm/gcc3x-interp.c
===================================================================
--- branches/Cog/stacksrc/vm/gcc3x-interp.c 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/stacksrc/vm/gcc3x-interp.c 2010-09-26 02:24:21 UTC (rev 2313)
@@ -2,11 +2,11 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.31 uuid: d80799cf-0dd2-40dd-b3a6-f8bca14bdc3d
+ CCodeGeneratorGlobalStructure VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
from
- StackInterpreter VMMaker-oscog.31 uuid: d80799cf-0dd2-40dd-b3a6-f8bca14bdc3d
+ StackInterpreter VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
*/
-static char __buildInfo[] = "StackInterpreter VMMaker-oscog.31 uuid: d80799cf-0dd2-40dd-b3a6-f8bca14bdc3d " __DATE__ ;
+static char __buildInfo[] = "StackInterpreter VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf " __DATE__ ;
char *__interpBuildInfo = __buildInfo;
@@ -228,6 +228,7 @@
#define SelectorCannotReturn 21
#define SelectorDoesNotUnderstand 20
#define SelectorMustBeBoolean 25
+#define SelectorRunWithIn 49
#define SelectorStart 2
#define SenderIndex 0
#define ShiftForWord 2
@@ -634,6 +635,7 @@
static void primitiveIntegerAtPut(void);
EXPORT(void) primitiveInterruptChecksPerMSec(void);
static void primitiveInterruptSemaphore(void);
+static void primitiveInvokeObjectAsMethod(void);
EXPORT(void) primitiveIsRoot(void);
EXPORT(void) primitiveIsWindowObscured(void);
EXPORT(void) primitiveIsYoung(void);
@@ -884,27 +886,27 @@
_iss sqInt argumentCount;
_iss usqInt youngStart;
_iss sqInt messageSelector;
+_iss usqInt newMethod;
_iss usqInt endOfMemory;
_iss sqInt rootTableCount;
_iss usqInt instructionPointer;
-_iss usqInt newMethod;
_iss sqInt remapBufferCount;
_iss sqInt trueObj;
_iss sqInt falseObj;
_iss usqInt reserveStart;
_iss StackPage * pages;
_iss char * stackLimit;
+_iss sqLong nextProfileTick;
_iss sqInt lkupClass;
_iss char * stackMemory;
_iss sqInt bytesPerPage;
_iss usqInt memoryLimit;
-_iss sqLong nextProfileTick;
_iss StackPage * mostRecentlyUsedPage;
_iss sqInt needGCFlag;
_iss usqInt scavengeThreshold;
+_iss sqInt profileProcess;
_iss usqInt fwdTableNext;
_iss sqInt jmpDepth;
-_iss sqInt profileProcess;
_iss sqInt numStackPages;
_iss sqInt profileMethod;
_iss usqInt compStart;
@@ -1267,7 +1269,7 @@
/* 245 */ (void (*)(void))0,
/* 246 */ (void (*)(void))0,
/* 247 */ primitiveSnapshotEmbedded,
- /* 248 */ (void (*)(void))0,
+ /* 248 */ primitiveInvokeObjectAsMethod,
/* 249 */ primitiveArrayBecomeOneWayCopyHash,
/* 250 */ primitiveClearVMProfile,
/* 251 */ primitiveControlVMProfiling,
@@ -1598,7 +1600,7 @@
0 };
char * breakSelector;
sqInt breakSelectorLength = -1;
-const char *interpreterVersion = "Croquet Closure Stack VM [StackInterpreter VMMaker-oscog.31]";
+const char *interpreterVersion = "Croquet Closure Stack VM [StackInterpreter VMMaker-oscog.33]";
static volatile int sendTrace;
sqInt suppressHeartbeatFlag;
@@ -8414,13 +8416,19 @@
/* drop low-order zeros from addresses */
hash = GIV(messageSelector) ^ class;
- /* begin primitiveIndexOf: */
- primBits = (((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 1) & 268435967;
- primitiveIndex = (primBits & 511) + (((usqInt) primBits) >> 19);
- /* begin functionPointerFor:inClass: */
- primitiveFunctionPointer = ((void (*)(void)) ((primitiveIndex > MaxPrimitiveIndex
+ if (((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12)) {
+ /* begin primitiveIndexOf: */
+ primBits = (((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 1) & 268435967;
+ primitiveIndex = (primBits & 511) + (((usqInt) primBits) >> 19);
+ /* begin functionPointerFor:inClass: */
+ primitiveFunctionPointer = ((void (*)(void)) ((primitiveIndex > MaxPrimitiveIndex
? 0
: primitiveTable[primitiveIndex])));
+ }
+ else {
+ primitiveFunctionPointer = primitiveInvokeObjectAsMethod;
+ }
for (p = 0; p <= (CacheProbeMax - 1); p += 1) {
probe = (((usqInt) hash) >> p) & MethodCacheMask;
if ((GIV(methodCache)[probe + MethodCacheSelector]) == 0) {
@@ -21176,7 +21184,8 @@
if (!(GIV(primFailCode) == 0)) {
GIV(primFailCode) = -2; return;
}
- if (!(((((usqInt) (longAt(methodArg))) >> 8) & 15) >= 12)) {
+ if (!(((methodArg & 1) == 0)
+ && (((((usqInt) (longAt(methodArg))) >> 8) & 15) >= 12))) {
GIV(primFailCode) = -2; return;
}
methodHeader = longAt((methodArg + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
@@ -21895,10 +21904,10 @@
methodArgument = longAt(GIV(stackPointer));
argumentArray = longAt(GIV(stackPointer) + (1 * BytesPerWord));
- if (!(((methodArgument & 1) == 0)
- && ((((((usqInt) (longAt(methodArgument))) >> 8) & 15) >= 12)
- && (((argumentArray & 1) == 0)
- && (((((usqInt) (longAt(argumentArray))) >> 8) & 15) == 2))))) {
+ if (!((((methodArgument & 1) == 0)
+ && (((((usqInt) (longAt(methodArgument))) >> 8) & 15) >= 12))
+ && (((argumentArray & 1) == 0)
+ && (((((usqInt) (longAt(argumentArray))) >> 8) & 15) == 2)))) {
GIV(primFailCode) = PrimErrBadArgument; return;
}
argCnt = (((usqInt) (longAt((methodArgument + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 25) & 15;
@@ -25919,6 +25928,207 @@
}
+/* Primitive. 'Invoke' an object like a function, sending the special message
+ run: originalSelector with: arguments in: aReceiver.
+ */
+
+static void
+primitiveInvokeObjectAsMethod(void) {
+DECL_MAYBE_SQ_GLOBAL_STRUCT
+ sqInt aPrimitiveMethod;
+ sqInt ccIndex;
+ sqInt errorCode;
+ sqInt i;
+ sqInt i1;
+ sqInt lookupClass;
+ sqInt methodHeader;
+ sqInt nArgs;
+ sqInt numArgs;
+ sqInt numTemps;
+ sqInt object;
+ sqInt rcvr;
+ sqInt runArgs;
+ sqInt runReceiver;
+ char *savedFramePointer;
+ char *savedStackPointer;
+ char *sp;
+ char *sp1;
+ char *sp11;
+ char *sp2;
+ char *sp21;
+ char *sp3;
+ char *sp31;
+ char *sp4;
+ char *sp5;
+ char *sp6;
+ char *sp7;
+ sqInt table;
+ sqInt top;
+ sqInt top1;
+ sqInt valuePointer;
+
+ runArgs = instantiateClassindexableSize(longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassArray << ShiftForWord)), GIV(argumentCount));
+ for (i = (GIV(argumentCount) - 1); i >= 0; i += -1) {
+ /* begin storePointerUnchecked:ofObject:withValue: */
+ /* begin popStack */
+ top1 = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ valuePointer = top1;
+ longAtput((runArgs + BaseHeaderSize) + (i << ShiftForWord), valuePointer);
+ }
+ /* begin popStack */
+ top = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ runReceiver = top;
+ /* begin push: */
+ longAtput(sp = GIV(stackPointer) - BytesPerWord, GIV(newMethod));
+ GIV(stackPointer) = sp;
+ /* begin push: */
+ longAtput(sp1 = GIV(stackPointer) - BytesPerWord, GIV(messageSelector));
+ GIV(stackPointer) = sp1;
+ /* begin push: */
+ longAtput(sp2 = GIV(stackPointer) - BytesPerWord, runArgs);
+ GIV(stackPointer) = sp2;
+ /* begin push: */
+ longAtput(sp3 = GIV(stackPointer) - BytesPerWord, runReceiver);
+ GIV(stackPointer) = sp3;
+ GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorRunWithIn << ShiftForWord));
+ GIV(argumentCount) = 3;
+ /* begin fetchClassOf: */
+ if ((GIV(newMethod) & 1)) {
+ lookupClass = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassInteger << ShiftForWord));
+ goto l1;
+ }
+ if (((ccIndex = (((usqInt) (longAt(GIV(newMethod)))) >> 12) & 31)) == 0) {
+ lookupClass = (longAt(GIV(newMethod) - BaseHeaderSize)) & AllButTypeMask;
+ goto l1;
+ }
+ else {
+ lookupClass = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
+ goto l1;
+ }
+l1: /* end fetchClassOf: */;
+ findNewMethodInClass(lookupClass);
+ /* begin executeNewMethod */
+ if (primitiveFunctionPointer != 0) {
+ if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
+ externalQuickPrimitiveResponse();
+ goto l2;
+ }
+ /* begin slowPrimitiveResponse */
+ if (FailImbalancedPrimitives) {
+ nArgs = GIV(argumentCount);
+ savedStackPointer = GIV(stackPointer);
+ savedFramePointer = GIV(framePointer);
+ }
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+ dispatchFunctionPointer(primitiveFunctionPointer);
+ if (FailImbalancedPrimitives
+ && ((GIV(primFailCode) == 0)
+ && (GIV(framePointer) == savedFramePointer))) {
+ if (GIV(stackPointer) != (savedStackPointer + (nArgs * BytesPerWord))) {
+ flag("Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context");
+ GIV(stackPointer) = savedStackPointer;
+ failUnbalancedPrimitive();
+ }
+ }
+ if (GIV(nextProfileTick) > 0) {
+ /* begin checkProfileTick: */
+ aPrimitiveMethod = GIV(newMethod);
+ assert(GIV(nextProfileTick) != 0);
+ if ((ioHighResClock()) >= GIV(nextProfileTick)) {
+ GIV(profileProcess) = longAt(((longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SchedulerAssociation << ShiftForWord))) + BaseHeaderSize) + (ValueIndex << ShiftForWord))) + BaseHeaderSize) + (ActiveProcessIndex << ShiftForWord));
+ GIV(profileMethod) = (GIV(primFailCode) == 0
+ ? aPrimitiveMethod
+ : GIV(nilObj));
+ forceInterruptCheck();
+ GIV(nextProfileTick) = 0;
+ }
+ }
+ GIV(primFailCode) == 0;
+ if (GIV(primFailCode) == 0) {
+ goto l2;
+ }
+ }
+ /* begin activateNewMethod */
+ VM_LABEL(2activateNewMethod);
+ methodHeader = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
+ numTemps = (((usqInt) methodHeader) >> 19) & 63;
+ numArgs = (((usqInt) methodHeader) >> 25) & 15;
+
+ /* could new rcvr be set at point of send? */
+
+ rcvr = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
+ /* begin push: */
+ longAtput(sp11 = GIV(stackPointer) - BytesPerWord, GIV(instructionPointer));
+ GIV(stackPointer) = sp11;
+ /* begin push: */
+ longAtput(sp21 = GIV(stackPointer) - BytesPerWord, GIV(framePointer));
+ GIV(stackPointer) = sp21;
+ GIV(framePointer) = GIV(stackPointer);
+ /* begin push: */
+ longAtput(sp31 = GIV(stackPointer) - BytesPerWord, GIV(newMethod));
+ GIV(stackPointer) = sp31;
+ /* begin setMethod: */
+ GIV(method) = GIV(newMethod);
+ /* begin push: */
+ object = (VMBIGENDIAN
+ ? ((1 + (numArgs << ((BytesPerWord * 8) - 8))) + ((0
+ ? 1 << ((BytesPerWord * 8) - 16)
+ : 0))) + ((0
+ ? 1 << ((BytesPerWord * 8) - 24)
+ : 0))
+ : ((1 + (numArgs << 8)) + ((0
+ ? 1 << 16
+ : 0))) + ((0
+ ? 1 << 24
+ : 0)));
+ longAtput(sp4 = GIV(stackPointer) - BytesPerWord, object);
+ GIV(stackPointer) = sp4;
+ /* begin push: */
+ longAtput(sp5 = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
+ GIV(stackPointer) = sp5;
+ /* begin push: */
+ longAtput(sp6 = GIV(stackPointer) - BytesPerWord, rcvr);
+ GIV(stackPointer) = sp6;
+ for (i1 = (numArgs + 1); i1 <= numTemps; i1 += 1) {
+ /* begin push: */
+ longAtput(sp7 = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
+ GIV(stackPointer) = sp7;
+ }
+
+ /* Pass primitive error code to last temp if method receives it (indicated
+ by an initial long store temp bytecode). Protect against obsolete values
+ in primFailCode by checking that newMethod actually has a primitive? */
+
+ GIV(instructionPointer) = ((GIV(newMethod) + ((LiteralStart + ((((usqInt) methodHeader) >> 10) & 255)) * BytesPerWord)) + BaseHeaderSize) - 1;
+ if (GIV(primFailCode) != 0) {
+ if (((methodHeader & 536871934) != 0)
+ && ((byteAtPointer(GIV(instructionPointer) + 1)) == 129)) {
+ /* begin getErrorObjectFromPrimFailCode */
+ if (GIV(primFailCode) > 0) {
+ table = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (PrimErrTableIndex << ShiftForWord));
+ if (GIV(primFailCode) <= (((sqInt) (lastPointerOf(table)) >> 2))) {
+ errorCode = longAt((table + BaseHeaderSize) + ((GIV(primFailCode) - 1) << ShiftForWord));
+ goto l3;
+ }
+ }
+ errorCode = ((GIV(primFailCode) << 1) | 1);
+ l3: /* end getErrorObjectFromPrimFailCode */;
+ longAtPointerput(GIV(stackPointer), errorCode);
+ }
+ GIV(primFailCode) = 0;
+ }
+ if (GIV(stackPointer) < GIV(stackLimit)) {
+ handleStackOverflowOrEventAllowContextSwitch(canContextSwitchIfActivating(methodHeader));
+ }
+l2: /* end executeNewMethod */;
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+}
+
+
/* Primitive. Answer whether the argument to the primitive is a root for
young space
*/
@@ -28124,16 +28334,16 @@
GIV(argumentCount) = arraySize;
GIV(messageSelector) = selector;
findNewMethodInClass(lookupClass);
- if (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12) {
- if (((((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 25) & 15) != GIV(argumentCount)) {
- /* begin pop: */
- GIV(stackPointer) += (arraySize + 1) * BytesPerWord;
- /* begin popStack */
- top = longAt(GIV(stackPointer));
- GIV(stackPointer) += BytesPerWord;
- GIV(newMethod) = ((sqInt) top);
- return GIV(primFailCode) = PrimErrBadNumArgs;
- }
+ if (!((((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12))
+ && (((((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 25) & 15) == GIV(argumentCount)))) {
+ /* begin pop: */
+ GIV(stackPointer) += (arraySize + 1) * BytesPerWord;
+ /* begin popStack */
+ top = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ GIV(newMethod) = ((sqInt) top);
+ return GIV(primFailCode) = PrimErrBadNumArgs;
}
/* +2 = receiver + saved newMethod */
@@ -28188,7 +28398,7 @@
}
}
/* begin activateNewMethod */
- VM_LABEL(2activateNewMethod);
+ VM_LABEL(3activateNewMethod);
methodHeader = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
numTemps = (((usqInt) methodHeader) >> 19) & 63;
numArgs = (((usqInt) methodHeader) >> 25) & 15;
@@ -28329,160 +28539,155 @@
/* begin fetchClassOf: */
if ((newReceiver & 1)) {
lookupClass = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassInteger << ShiftForWord));
- goto l2;
+ goto l1;
}
if (((ccIndex = (((usqInt) (longAt(newReceiver))) >> 12) & 31)) == 0) {
lookupClass = (longAt(newReceiver - BaseHeaderSize)) & AllButTypeMask;
- goto l2;
+ goto l1;
}
else {
lookupClass = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
- goto l2;
+ goto l1;
}
-l2: /* end fetchClassOf: */;
+l1: /* end fetchClassOf: */;
findNewMethodInClass(lookupClass);
- if (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12) {
- /* begin success: */
- if (!(((((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 25) & 15) == GIV(argumentCount))) {
- if (GIV(primFailCode) == 0) {
-
- /* Don't overwrite an error code that has already been set. */
-
- GIV(primFailCode) = 1;
- }
+ if (!((((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12))
+ && (((((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 25) & 15) == GIV(argumentCount)))) {
+ /* begin unPop: */
+ GIV(stackPointer) -= 1 * BytesPerWord;
+ for (i = 1; i <= GIV(argumentCount); i += 1) {
+ longAtput(GIV(stackPointer) + ((i - 1) * BytesPerWord), longAt(GIV(stackPointer) + (i * BytesPerWord)));
}
+ longAtput(GIV(stackPointer) + (GIV(argumentCount) * BytesPerWord), GIV(messageSelector));
+ GIV(argumentCount) += 1;
+ GIV(newMethod) = performMethod;
+ GIV(messageSelector) = performSelector;
+ /* begin primitiveFail */
+ if (GIV(primFailCode) == 0) {
+ GIV(primFailCode) = 1;
+ }
+ return;
}
- if (GIV(primFailCode) == 0) {
- /* begin executeNewMethod */
- VM_LABEL(3executeNewMethod);
- if (primitiveFunctionPointer != 0) {
- if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
- externalQuickPrimitiveResponse();
- goto l1;
- }
- /* begin slowPrimitiveResponse */
- if (FailImbalancedPrimitives) {
- nArgs = GIV(argumentCount);
- savedStackPointer = GIV(stackPointer);
- savedFramePointer = GIV(framePointer);
- }
- /* begin initPrimCall */
- GIV(primFailCode) = 0;
- dispatchFunctionPointer(primitiveFunctionPointer);
- if (FailImbalancedPrimitives
- && ((GIV(primFailCode) == 0)
+ /* begin executeNewMethod */
+ VM_LABEL(3executeNewMethod);
+ if (primitiveFunctionPointer != 0) {
+ if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
+ externalQuickPrimitiveResponse();
+ goto l2;
+ }
+ /* begin slowPrimitiveResponse */
+ if (FailImbalancedPrimitives) {
+ nArgs = GIV(argumentCount);
+ savedStackPointer = GIV(stackPointer);
+ savedFramePointer = GIV(framePointer);
+ }
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+ dispatchFunctionPointer(primitiveFunctionPointer);
+ if (FailImbalancedPrimitives
+ && ((GIV(primFailCode) == 0)
&& (GIV(framePointer) == savedFramePointer))) {
- if (GIV(stackPointer) != (savedStackPointer + (nArgs * BytesPerWord))) {
- flag("Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context");
- GIV(stackPointer) = savedStackPointer;
- failUnbalancedPrimitive();
- }
+ if (GIV(stackPointer) != (savedStackPointer + (nArgs * BytesPerWord))) {
+ flag("Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context");
+ GIV(stackPointer) = savedStackPointer;
+ failUnbalancedPrimitive();
}
- if (GIV(nextProfileTick) > 0) {
- /* begin checkProfileTick: */
- aPrimitiveMethod = GIV(newMethod);
- assert(GIV(nextProfileTick) != 0);
- if ((ioHighResClock()) >= GIV(nextProfileTick)) {
- GIV(profileProcess) = longAt(((longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SchedulerAssociation << ShiftForWord))) + BaseHeaderSize) + (ValueIndex << ShiftForWord))) + BaseHeaderSize) + (ActiveProcessIndex << ShiftForWord));
- GIV(profileMethod) = (GIV(primFailCode) == 0
- ? aPrimitiveMethod
- : GIV(nilObj));
- forceInterruptCheck();
- GIV(nextProfileTick) = 0;
- }
+ }
+ if (GIV(nextProfileTick) > 0) {
+ /* begin checkProfileTick: */
+ aPrimitiveMethod = GIV(newMethod);
+ assert(GIV(nextProfileTick) != 0);
+ if ((ioHighResClock()) >= GIV(nextProfileTick)) {
+ GIV(profileProcess) = longAt(((longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SchedulerAssociation << ShiftForWord))) + BaseHeaderSize) + (ValueIndex << ShiftForWord))) + BaseHeaderSize) + (ActiveProcessIndex << ShiftForWord));
+ GIV(profileMethod) = (GIV(primFailCode) == 0
+ ? aPrimitiveMethod
+ : GIV(nilObj));
+ forceInterruptCheck();
+ GIV(nextProfileTick) = 0;
}
- GIV(primFailCode) == 0;
- if (GIV(primFailCode) == 0) {
- goto l1;
- }
}
- /* begin activateNewMethod */
- VM_LABEL(3activateNewMethod);
- methodHeader = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
- numTemps = (((usqInt) methodHeader) >> 19) & 63;
- numArgs = (((usqInt) methodHeader) >> 25) & 15;
+ GIV(primFailCode) == 0;
+ if (GIV(primFailCode) == 0) {
+ goto l2;
+ }
+ }
+ /* begin activateNewMethod */
+ VM_LABEL(4activateNewMethod);
+ methodHeader = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
+ numTemps = (((usqInt) methodHeader) >> 19) & 63;
+ numArgs = (((usqInt) methodHeader) >> 25) & 15;
- /* could new rcvr be set at point of send? */
+ /* could new rcvr be set at point of send? */
- rcvr = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
- /* begin push: */
- longAtput(sp1 = GIV(stackPointer) - BytesPerWord, GIV(instructionPointer));
- GIV(stackPointer) = sp1;
- /* begin push: */
- longAtput(sp2 = GIV(stackPointer) - BytesPerWord, GIV(framePointer));
- GIV(stackPointer) = sp2;
- GIV(framePointer) = GIV(stackPointer);
- /* begin push: */
- longAtput(sp3 = GIV(stackPointer) - BytesPerWord, GIV(newMethod));
- GIV(stackPointer) = sp3;
- /* begin setMethod: */
- GIV(method) = GIV(newMethod);
- /* begin push: */
- object = (VMBIGENDIAN
- ? ((1 + (numArgs << ((BytesPerWord * 8) - 8))) + ((0
+ rcvr = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
+ /* begin push: */
+ longAtput(sp1 = GIV(stackPointer) - BytesPerWord, GIV(instructionPointer));
+ GIV(stackPointer) = sp1;
+ /* begin push: */
+ longAtput(sp2 = GIV(stackPointer) - BytesPerWord, GIV(framePointer));
+ GIV(stackPointer) = sp2;
+ GIV(framePointer) = GIV(stackPointer);
+ /* begin push: */
+ longAtput(sp3 = GIV(stackPointer) - BytesPerWord, GIV(newMethod));
+ GIV(stackPointer) = sp3;
+ /* begin setMethod: */
+ GIV(method) = GIV(newMethod);
+ /* begin push: */
+ object = (VMBIGENDIAN
+ ? ((1 + (numArgs << ((BytesPerWord * 8) - 8))) + ((0
? 1 << ((BytesPerWord * 8) - 16)
: 0))) + ((0
? 1 << ((BytesPerWord * 8) - 24)
: 0))
- : ((1 + (numArgs << 8)) + ((0
+ : ((1 + (numArgs << 8)) + ((0
? 1 << 16
: 0))) + ((0
? 1 << 24
: 0)));
- longAtput(sp4 = GIV(stackPointer) - BytesPerWord, object);
- GIV(stackPointer) = sp4;
+ longAtput(sp4 = GIV(stackPointer) - BytesPerWord, object);
+ GIV(stackPointer) = sp4;
+ /* begin push: */
+ longAtput(sp5 = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
+ GIV(stackPointer) = sp5;
+ /* begin push: */
+ longAtput(sp6 = GIV(stackPointer) - BytesPerWord, rcvr);
+ GIV(stackPointer) = sp6;
+ for (i1 = (numArgs + 1); i1 <= numTemps; i1 += 1) {
/* begin push: */
- longAtput(sp5 = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
- GIV(stackPointer) = sp5;
- /* begin push: */
- longAtput(sp6 = GIV(stackPointer) - BytesPerWord, rcvr);
- GIV(stackPointer) = sp6;
- for (i1 = (numArgs + 1); i1 <= numTemps; i1 += 1) {
- /* begin push: */
- longAtput(sp = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
- GIV(stackPointer) = sp;
- }
+ longAtput(sp = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
+ GIV(stackPointer) = sp;
+ }
- /* Pass primitive error code to last temp if method receives it (indicated
+ /* Pass primitive error code to last temp if method receives it (indicated
by an initial long store temp bytecode). Protect against obsolete values
in primFailCode by checking that newMethod actually has a primitive? */
- GIV(instructionPointer) = ((GIV(newMethod) + ((LiteralStart + ((((usqInt) methodHeader) >> 10) & 255)) * BytesPerWord)) + BaseHeaderSize) - 1;
- if (GIV(primFailCode) != 0) {
- if (((methodHeader & 536871934) != 0)
- && ((byteAtPointer(GIV(instructionPointer) + 1)) == 129)) {
- /* begin getErrorObjectFromPrimFailCode */
- if (GIV(primFailCode) > 0) {
- table = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (PrimErrTableIndex << ShiftForWord));
- if (GIV(primFailCode) <= (((sqInt) (lastPointerOf(table)) >> 2))) {
- errorCode = longAt((table + BaseHeaderSize) + ((GIV(primFailCode) - 1) << ShiftForWord));
- goto l3;
- }
+ GIV(instructionPointer) = ((GIV(newMethod) + ((LiteralStart + ((((usqInt) methodHeader) >> 10) & 255)) * BytesPerWord)) + BaseHeaderSize) - 1;
+ if (GIV(primFailCode) != 0) {
+ if (((methodHeader & 536871934) != 0)
+ && ((byteAtPointer(GIV(instructionPointer) + 1)) == 129)) {
+ /* begin getErrorObjectFromPrimFailCode */
+ if (GIV(primFailCode) > 0) {
+ table = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (PrimErrTableIndex << ShiftForWord));
+ if (GIV(primFailCode) <= (((sqInt) (lastPointerOf(table)) >> 2))) {
+ errorCode = longAt((table + BaseHeaderSize) + ((GIV(primFailCode) - 1) << ShiftForWord));
+ goto l3;
}
- errorCode = ((GIV(primFailCode) << 1) | 1);
- l3: /* end getErrorObjectFromPrimFailCode */;
- longAtPointerput(GIV(stackPointer), errorCode);
}
- GIV(primFailCode) = 0;
+ errorCode = ((GIV(primFailCode) << 1) | 1);
+ l3: /* end getErrorObjectFromPrimFailCode */;
+ longAtPointerput(GIV(stackPointer), errorCode);
}
- if (GIV(stackPointer) < GIV(stackLimit)) {
- handleStackOverflowOrEventAllowContextSwitch(canContextSwitchIfActivating(methodHeader));
- }
- l1: /* end executeNewMethod */;
- /* begin initPrimCall */
GIV(primFailCode) = 0;
}
- else {
- /* begin unPop: */
- GIV(stackPointer) -= 1 * BytesPerWord;
- for (i = 1; i <= GIV(argumentCount); i += 1) {
- longAtput(GIV(stackPointer) + ((i - 1) * BytesPerWord), longAt(GIV(stackPointer) + (i * BytesPerWord)));
- }
- longAtput(GIV(stackPointer) + (GIV(argumentCount) * BytesPerWord), GIV(messageSelector));
- GIV(argumentCount) += 1;
- GIV(newMethod) = performMethod;
- GIV(messageSelector) = performSelector;
+ if (GIV(stackPointer) < GIV(stackLimit)) {
+ handleStackOverflowOrEventAllowContextSwitch(canContextSwitchIfActivating(methodHeader));
}
+l2: /* end executeNewMethod */;
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+ return;
}
static void
Modified: branches/Cog/stacksrc/vm/interp.c
===================================================================
--- branches/Cog/stacksrc/vm/interp.c 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/stacksrc/vm/interp.c 2010-09-26 02:24:21 UTC (rev 2313)
@@ -1,9 +1,9 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.31 uuid: d80799cf-0dd2-40dd-b3a6-f8bca14bdc3d
+ CCodeGeneratorGlobalStructure VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
from
- StackInterpreter VMMaker-oscog.31 uuid: d80799cf-0dd2-40dd-b3a6-f8bca14bdc3d
+ StackInterpreter VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
*/
-static char __buildInfo[] = "StackInterpreter VMMaker-oscog.31 uuid: d80799cf-0dd2-40dd-b3a6-f8bca14bdc3d " __DATE__ ;
+static char __buildInfo[] = "StackInterpreter VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf " __DATE__ ;
char *__interpBuildInfo = __buildInfo;
@@ -225,6 +225,7 @@
#define SelectorCannotReturn 21
#define SelectorDoesNotUnderstand 20
#define SelectorMustBeBoolean 25
+#define SelectorRunWithIn 49
#define SelectorStart 2
#define SenderIndex 0
#define ShiftForWord 2
@@ -631,6 +632,7 @@
static void primitiveIntegerAtPut(void);
EXPORT(void) primitiveInterruptChecksPerMSec(void);
static void primitiveInterruptSemaphore(void);
+static void primitiveInvokeObjectAsMethod(void);
EXPORT(void) primitiveIsRoot(void);
EXPORT(void) primitiveIsWindowObscured(void);
EXPORT(void) primitiveIsYoung(void);
@@ -881,27 +883,27 @@
_iss sqInt argumentCount;
_iss usqInt youngStart;
_iss sqInt messageSelector;
+_iss usqInt newMethod;
_iss usqInt endOfMemory;
_iss sqInt rootTableCount;
_iss usqInt instructionPointer;
-_iss usqInt newMethod;
_iss sqInt remapBufferCount;
_iss sqInt trueObj;
_iss sqInt falseObj;
_iss usqInt reserveStart;
_iss StackPage * pages;
_iss char * stackLimit;
+_iss sqLong nextProfileTick;
_iss sqInt lkupClass;
_iss char * stackMemory;
_iss sqInt bytesPerPage;
_iss usqInt memoryLimit;
-_iss sqLong nextProfileTick;
_iss StackPage * mostRecentlyUsedPage;
_iss sqInt needGCFlag;
_iss usqInt scavengeThreshold;
+_iss sqInt profileProcess;
_iss usqInt fwdTableNext;
_iss sqInt jmpDepth;
-_iss sqInt profileProcess;
_iss sqInt numStackPages;
_iss sqInt profileMethod;
_iss usqInt compStart;
@@ -1264,7 +1266,7 @@
/* 245 */ (void (*)(void))0,
/* 246 */ (void (*)(void))0,
/* 247 */ primitiveSnapshotEmbedded,
- /* 248 */ (void (*)(void))0,
+ /* 248 */ primitiveInvokeObjectAsMethod,
/* 249 */ primitiveArrayBecomeOneWayCopyHash,
/* 250 */ primitiveClearVMProfile,
/* 251 */ primitiveControlVMProfiling,
@@ -1595,7 +1597,7 @@
0 };
char * breakSelector;
sqInt breakSelectorLength = -1;
-const char *interpreterVersion = "Croquet Closure Stack VM [StackInterpreter VMMaker-oscog.31]";
+const char *interpreterVersion = "Croquet Closure Stack VM [StackInterpreter VMMaker-oscog.33]";
static volatile int sendTrace;
sqInt suppressHeartbeatFlag;
@@ -8410,13 +8412,19 @@
/* drop low-order zeros from addresses */
hash = GIV(messageSelector) ^ class;
- /* begin primitiveIndexOf: */
- primBits = (((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 1) & 268435967;
- primitiveIndex = (primBits & 511) + (((usqInt) primBits) >> 19);
- /* begin functionPointerFor:inClass: */
- primitiveFunctionPointer = ((void (*)(void)) ((primitiveIndex > MaxPrimitiveIndex
+ if (((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12)) {
+ /* begin primitiveIndexOf: */
+ primBits = (((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 1) & 268435967;
+ primitiveIndex = (primBits & 511) + (((usqInt) primBits) >> 19);
+ /* begin functionPointerFor:inClass: */
+ primitiveFunctionPointer = ((void (*)(void)) ((primitiveIndex > MaxPrimitiveIndex
? 0
: primitiveTable[primitiveIndex])));
+ }
+ else {
+ primitiveFunctionPointer = primitiveInvokeObjectAsMethod;
+ }
for (p = 0; p <= (CacheProbeMax - 1); p += 1) {
probe = (((usqInt) hash) >> p) & MethodCacheMask;
if ((GIV(methodCache)[probe + MethodCacheSelector]) == 0) {
@@ -21172,7 +21180,8 @@
if (!(GIV(primFailCode) == 0)) {
GIV(primFailCode) = -2; return;
}
- if (!(((((usqInt) (longAt(methodArg))) >> 8) & 15) >= 12)) {
+ if (!(((methodArg & 1) == 0)
+ && (((((usqInt) (longAt(methodArg))) >> 8) & 15) >= 12))) {
GIV(primFailCode) = -2; return;
}
methodHeader = longAt((methodArg + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
@@ -21891,10 +21900,10 @@
methodArgument = longAt(GIV(stackPointer));
argumentArray = longAt(GIV(stackPointer) + (1 * BytesPerWord));
- if (!(((methodArgument & 1) == 0)
- && ((((((usqInt) (longAt(methodArgument))) >> 8) & 15) >= 12)
- && (((argumentArray & 1) == 0)
- && (((((usqInt) (longAt(argumentArray))) >> 8) & 15) == 2))))) {
+ if (!((((methodArgument & 1) == 0)
+ && (((((usqInt) (longAt(methodArgument))) >> 8) & 15) >= 12))
+ && (((argumentArray & 1) == 0)
+ && (((((usqInt) (longAt(argumentArray))) >> 8) & 15) == 2)))) {
GIV(primFailCode) = PrimErrBadArgument; return;
}
argCnt = (((usqInt) (longAt((methodArgument + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 25) & 15;
@@ -25915,6 +25924,207 @@
}
+/* Primitive. 'Invoke' an object like a function, sending the special message
+ run: originalSelector with: arguments in: aReceiver.
+ */
+
+static void
+primitiveInvokeObjectAsMethod(void) {
+DECL_MAYBE_SQ_GLOBAL_STRUCT
+ sqInt aPrimitiveMethod;
+ sqInt ccIndex;
+ sqInt errorCode;
+ sqInt i;
+ sqInt i1;
+ sqInt lookupClass;
+ sqInt methodHeader;
+ sqInt nArgs;
+ sqInt numArgs;
+ sqInt numTemps;
+ sqInt object;
+ sqInt rcvr;
+ sqInt runArgs;
+ sqInt runReceiver;
+ char *savedFramePointer;
+ char *savedStackPointer;
+ char *sp;
+ char *sp1;
+ char *sp11;
+ char *sp2;
+ char *sp21;
+ char *sp3;
+ char *sp31;
+ char *sp4;
+ char *sp5;
+ char *sp6;
+ char *sp7;
+ sqInt table;
+ sqInt top;
+ sqInt top1;
+ sqInt valuePointer;
+
+ runArgs = instantiateClassindexableSize(longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassArray << ShiftForWord)), GIV(argumentCount));
+ for (i = (GIV(argumentCount) - 1); i >= 0; i += -1) {
+ /* begin storePointerUnchecked:ofObject:withValue: */
+ /* begin popStack */
+ top1 = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ valuePointer = top1;
+ longAtput((runArgs + BaseHeaderSize) + (i << ShiftForWord), valuePointer);
+ }
+ /* begin popStack */
+ top = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ runReceiver = top;
+ /* begin push: */
+ longAtput(sp = GIV(stackPointer) - BytesPerWord, GIV(newMethod));
+ GIV(stackPointer) = sp;
+ /* begin push: */
+ longAtput(sp1 = GIV(stackPointer) - BytesPerWord, GIV(messageSelector));
+ GIV(stackPointer) = sp1;
+ /* begin push: */
+ longAtput(sp2 = GIV(stackPointer) - BytesPerWord, runArgs);
+ GIV(stackPointer) = sp2;
+ /* begin push: */
+ longAtput(sp3 = GIV(stackPointer) - BytesPerWord, runReceiver);
+ GIV(stackPointer) = sp3;
+ GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorRunWithIn << ShiftForWord));
+ GIV(argumentCount) = 3;
+ /* begin fetchClassOf: */
+ if ((GIV(newMethod) & 1)) {
+ lookupClass = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassInteger << ShiftForWord));
+ goto l1;
+ }
+ if (((ccIndex = (((usqInt) (longAt(GIV(newMethod)))) >> 12) & 31)) == 0) {
+ lookupClass = (longAt(GIV(newMethod) - BaseHeaderSize)) & AllButTypeMask;
+ goto l1;
+ }
+ else {
+ lookupClass = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
+ goto l1;
+ }
+l1: /* end fetchClassOf: */;
+ findNewMethodInClass(lookupClass);
+ /* begin executeNewMethod */
+ if (primitiveFunctionPointer != 0) {
+ if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
+ externalQuickPrimitiveResponse();
+ goto l2;
+ }
+ /* begin slowPrimitiveResponse */
+ if (FailImbalancedPrimitives) {
+ nArgs = GIV(argumentCount);
+ savedStackPointer = GIV(stackPointer);
+ savedFramePointer = GIV(framePointer);
+ }
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+ dispatchFunctionPointer(primitiveFunctionPointer);
+ if (FailImbalancedPrimitives
+ && ((GIV(primFailCode) == 0)
+ && (GIV(framePointer) == savedFramePointer))) {
+ if (GIV(stackPointer) != (savedStackPointer + (nArgs * BytesPerWord))) {
+ flag("Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context");
+ GIV(stackPointer) = savedStackPointer;
+ failUnbalancedPrimitive();
+ }
+ }
+ if (GIV(nextProfileTick) > 0) {
+ /* begin checkProfileTick: */
+ aPrimitiveMethod = GIV(newMethod);
+ assert(GIV(nextProfileTick) != 0);
+ if ((ioHighResClock()) >= GIV(nextProfileTick)) {
+ GIV(profileProcess) = longAt(((longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SchedulerAssociation << ShiftForWord))) + BaseHeaderSize) + (ValueIndex << ShiftForWord))) + BaseHeaderSize) + (ActiveProcessIndex << ShiftForWord));
+ GIV(profileMethod) = (GIV(primFailCode) == 0
+ ? aPrimitiveMethod
+ : GIV(nilObj));
+ forceInterruptCheck();
+ GIV(nextProfileTick) = 0;
+ }
+ }
+ GIV(primFailCode) == 0;
+ if (GIV(primFailCode) == 0) {
+ goto l2;
+ }
+ }
+ /* begin activateNewMethod */
+ VM_LABEL(2activateNewMethod);
+ methodHeader = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
+ numTemps = (((usqInt) methodHeader) >> 19) & 63;
+ numArgs = (((usqInt) methodHeader) >> 25) & 15;
+
+ /* could new rcvr be set at point of send? */
+
+ rcvr = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
+ /* begin push: */
+ longAtput(sp11 = GIV(stackPointer) - BytesPerWord, GIV(instructionPointer));
+ GIV(stackPointer) = sp11;
+ /* begin push: */
+ longAtput(sp21 = GIV(stackPointer) - BytesPerWord, GIV(framePointer));
+ GIV(stackPointer) = sp21;
+ GIV(framePointer) = GIV(stackPointer);
+ /* begin push: */
+ longAtput(sp31 = GIV(stackPointer) - BytesPerWord, GIV(newMethod));
+ GIV(stackPointer) = sp31;
+ /* begin setMethod: */
+ GIV(method) = GIV(newMethod);
+ /* begin push: */
+ object = (VMBIGENDIAN
+ ? ((1 + (numArgs << ((BytesPerWord * 8) - 8))) + ((0
+ ? 1 << ((BytesPerWord * 8) - 16)
+ : 0))) + ((0
+ ? 1 << ((BytesPerWord * 8) - 24)
+ : 0))
+ : ((1 + (numArgs << 8)) + ((0
+ ? 1 << 16
+ : 0))) + ((0
+ ? 1 << 24
+ : 0)));
+ longAtput(sp4 = GIV(stackPointer) - BytesPerWord, object);
+ GIV(stackPointer) = sp4;
+ /* begin push: */
+ longAtput(sp5 = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
+ GIV(stackPointer) = sp5;
+ /* begin push: */
+ longAtput(sp6 = GIV(stackPointer) - BytesPerWord, rcvr);
+ GIV(stackPointer) = sp6;
+ for (i1 = (numArgs + 1); i1 <= numTemps; i1 += 1) {
+ /* begin push: */
+ longAtput(sp7 = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
+ GIV(stackPointer) = sp7;
+ }
+
+ /* Pass primitive error code to last temp if method receives it (indicated
+ by an initial long store temp bytecode). Protect against obsolete values
+ in primFailCode by checking that newMethod actually has a primitive? */
+
+ GIV(instructionPointer) = ((GIV(newMethod) + ((LiteralStart + ((((usqInt) methodHeader) >> 10) & 255)) * BytesPerWord)) + BaseHeaderSize) - 1;
+ if (GIV(primFailCode) != 0) {
+ if (((methodHeader & 536871934) != 0)
+ && ((byteAtPointer(GIV(instructionPointer) + 1)) == 129)) {
+ /* begin getErrorObjectFromPrimFailCode */
+ if (GIV(primFailCode) > 0) {
+ table = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (PrimErrTableIndex << ShiftForWord));
+ if (GIV(primFailCode) <= (((sqInt) (lastPointerOf(table)) >> 2))) {
+ errorCode = longAt((table + BaseHeaderSize) + ((GIV(primFailCode) - 1) << ShiftForWord));
+ goto l3;
+ }
+ }
+ errorCode = ((GIV(primFailCode) << 1) | 1);
+ l3: /* end getErrorObjectFromPrimFailCode */;
+ longAtPointerput(GIV(stackPointer), errorCode);
+ }
+ GIV(primFailCode) = 0;
+ }
+ if (GIV(stackPointer) < GIV(stackLimit)) {
+ handleStackOverflowOrEventAllowContextSwitch(canContextSwitchIfActivating(methodHeader));
+ }
+l2: /* end executeNewMethod */;
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+}
+
+
/* Primitive. Answer whether the argument to the primitive is a root for
young space
*/
@@ -28120,16 +28330,16 @@
GIV(argumentCount) = arraySize;
GIV(messageSelector) = selector;
findNewMethodInClass(lookupClass);
- if (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12) {
- if (((((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 25) & 15) != GIV(argumentCount)) {
- /* begin pop: */
- GIV(stackPointer) += (arraySize + 1) * BytesPerWord;
- /* begin popStack */
- top = longAt(GIV(stackPointer));
- GIV(stackPointer) += BytesPerWord;
- GIV(newMethod) = ((sqInt) top);
- return GIV(primFailCode) = PrimErrBadNumArgs;
- }
+ if (!((((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12))
+ && (((((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 25) & 15) == GIV(argumentCount)))) {
+ /* begin pop: */
+ GIV(stackPointer) += (arraySize + 1) * BytesPerWord;
+ /* begin popStack */
+ top = longAt(GIV(stackPointer));
+ GIV(stackPointer) += BytesPerWord;
+ GIV(newMethod) = ((sqInt) top);
+ return GIV(primFailCode) = PrimErrBadNumArgs;
}
/* +2 = receiver + saved newMethod */
@@ -28184,7 +28394,7 @@
}
}
/* begin activateNewMethod */
- VM_LABEL(2activateNewMethod);
+ VM_LABEL(3activateNewMethod);
methodHeader = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
numTemps = (((usqInt) methodHeader) >> 19) & 63;
numArgs = (((usqInt) methodHeader) >> 25) & 15;
@@ -28325,160 +28535,155 @@
/* begin fetchClassOf: */
if ((newReceiver & 1)) {
lookupClass = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassInteger << ShiftForWord));
- goto l2;
+ goto l1;
}
if (((ccIndex = (((usqInt) (longAt(newReceiver))) >> 12) & 31)) == 0) {
lookupClass = (longAt(newReceiver - BaseHeaderSize)) & AllButTypeMask;
- goto l2;
+ goto l1;
}
else {
lookupClass = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
- goto l2;
+ goto l1;
}
-l2: /* end fetchClassOf: */;
+l1: /* end fetchClassOf: */;
findNewMethodInClass(lookupClass);
- if (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12) {
- /* begin success: */
- if (!(((((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 25) & 15) == GIV(argumentCount))) {
- if (GIV(primFailCode) == 0) {
-
- /* Don't overwrite an error code that has already been set. */
-
- GIV(primFailCode) = 1;
- }
+ if (!((((GIV(newMethod) & 1) == 0)
+ && (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12))
+ && (((((usqInt) (longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)))) >> 25) & 15) == GIV(argumentCount)))) {
+ /* begin unPop: */
+ GIV(stackPointer) -= 1 * BytesPerWord;
+ for (i = 1; i <= GIV(argumentCount); i += 1) {
+ longAtput(GIV(stackPointer) + ((i - 1) * BytesPerWord), longAt(GIV(stackPointer) + (i * BytesPerWord)));
}
+ longAtput(GIV(stackPointer) + (GIV(argumentCount) * BytesPerWord), GIV(messageSelector));
+ GIV(argumentCount) += 1;
+ GIV(newMethod) = performMethod;
+ GIV(messageSelector) = performSelector;
+ /* begin primitiveFail */
+ if (GIV(primFailCode) == 0) {
+ GIV(primFailCode) = 1;
+ }
+ return;
}
- if (GIV(primFailCode) == 0) {
- /* begin executeNewMethod */
- VM_LABEL(3executeNewMethod);
- if (primitiveFunctionPointer != 0) {
- if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
- externalQuickPrimitiveResponse();
- goto l1;
- }
- /* begin slowPrimitiveResponse */
- if (FailImbalancedPrimitives) {
- nArgs = GIV(argumentCount);
- savedStackPointer = GIV(stackPointer);
- savedFramePointer = GIV(framePointer);
- }
- /* begin initPrimCall */
- GIV(primFailCode) = 0;
- dispatchFunctionPointer(primitiveFunctionPointer);
- if (FailImbalancedPrimitives
- && ((GIV(primFailCode) == 0)
+ /* begin executeNewMethod */
+ VM_LABEL(3executeNewMethod);
+ if (primitiveFunctionPointer != 0) {
+ if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) {
+ externalQuickPrimitiveResponse();
+ goto l2;
+ }
+ /* begin slowPrimitiveResponse */
+ if (FailImbalancedPrimitives) {
+ nArgs = GIV(argumentCount);
+ savedStackPointer = GIV(stackPointer);
+ savedFramePointer = GIV(framePointer);
+ }
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+ dispatchFunctionPointer(primitiveFunctionPointer);
+ if (FailImbalancedPrimitives
+ && ((GIV(primFailCode) == 0)
&& (GIV(framePointer) == savedFramePointer))) {
- if (GIV(stackPointer) != (savedStackPointer + (nArgs * BytesPerWord))) {
- flag("Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context");
- GIV(stackPointer) = savedStackPointer;
- failUnbalancedPrimitive();
- }
+ if (GIV(stackPointer) != (savedStackPointer + (nArgs * BytesPerWord))) {
+ flag("Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context");
+ GIV(stackPointer) = savedStackPointer;
+ failUnbalancedPrimitive();
}
- if (GIV(nextProfileTick) > 0) {
- /* begin checkProfileTick: */
- aPrimitiveMethod = GIV(newMethod);
- assert(GIV(nextProfileTick) != 0);
- if ((ioHighResClock()) >= GIV(nextProfileTick)) {
- GIV(profileProcess) = longAt(((longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SchedulerAssociation << ShiftForWord))) + BaseHeaderSize) + (ValueIndex << ShiftForWord))) + BaseHeaderSize) + (ActiveProcessIndex << ShiftForWord));
- GIV(profileMethod) = (GIV(primFailCode) == 0
- ? aPrimitiveMethod
- : GIV(nilObj));
- forceInterruptCheck();
- GIV(nextProfileTick) = 0;
- }
+ }
+ if (GIV(nextProfileTick) > 0) {
+ /* begin checkProfileTick: */
+ aPrimitiveMethod = GIV(newMethod);
+ assert(GIV(nextProfileTick) != 0);
+ if ((ioHighResClock()) >= GIV(nextProfileTick)) {
+ GIV(profileProcess) = longAt(((longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SchedulerAssociation << ShiftForWord))) + BaseHeaderSize) + (ValueIndex << ShiftForWord))) + BaseHeaderSize) + (ActiveProcessIndex << ShiftForWord));
+ GIV(profileMethod) = (GIV(primFailCode) == 0
+ ? aPrimitiveMethod
+ : GIV(nilObj));
+ forceInterruptCheck();
+ GIV(nextProfileTick) = 0;
}
- GIV(primFailCode) == 0;
- if (GIV(primFailCode) == 0) {
- goto l1;
- }
}
- /* begin activateNewMethod */
- VM_LABEL(3activateNewMethod);
- methodHeader = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
- numTemps = (((usqInt) methodHeader) >> 19) & 63;
- numArgs = (((usqInt) methodHeader) >> 25) & 15;
+ GIV(primFailCode) == 0;
+ if (GIV(primFailCode) == 0) {
+ goto l2;
+ }
+ }
+ /* begin activateNewMethod */
+ VM_LABEL(4activateNewMethod);
+ methodHeader = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord));
+ numTemps = (((usqInt) methodHeader) >> 19) & 63;
+ numArgs = (((usqInt) methodHeader) >> 25) & 15;
- /* could new rcvr be set at point of send? */
+ /* could new rcvr be set at point of send? */
- rcvr = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
- /* begin push: */
- longAtput(sp1 = GIV(stackPointer) - BytesPerWord, GIV(instructionPointer));
- GIV(stackPointer) = sp1;
- /* begin push: */
- longAtput(sp2 = GIV(stackPointer) - BytesPerWord, GIV(framePointer));
- GIV(stackPointer) = sp2;
- GIV(framePointer) = GIV(stackPointer);
- /* begin push: */
- longAtput(sp3 = GIV(stackPointer) - BytesPerWord, GIV(newMethod));
- GIV(stackPointer) = sp3;
- /* begin setMethod: */
- GIV(method) = GIV(newMethod);
- /* begin push: */
- object = (VMBIGENDIAN
- ? ((1 + (numArgs << ((BytesPerWord * 8) - 8))) + ((0
+ rcvr = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
+ /* begin push: */
+ longAtput(sp1 = GIV(stackPointer) - BytesPerWord, GIV(instructionPointer));
+ GIV(stackPointer) = sp1;
+ /* begin push: */
+ longAtput(sp2 = GIV(stackPointer) - BytesPerWord, GIV(framePointer));
+ GIV(stackPointer) = sp2;
+ GIV(framePointer) = GIV(stackPointer);
+ /* begin push: */
+ longAtput(sp3 = GIV(stackPointer) - BytesPerWord, GIV(newMethod));
+ GIV(stackPointer) = sp3;
+ /* begin setMethod: */
+ GIV(method) = GIV(newMethod);
+ /* begin push: */
+ object = (VMBIGENDIAN
+ ? ((1 + (numArgs << ((BytesPerWord * 8) - 8))) + ((0
? 1 << ((BytesPerWord * 8) - 16)
: 0))) + ((0
? 1 << ((BytesPerWord * 8) - 24)
: 0))
- : ((1 + (numArgs << 8)) + ((0
+ : ((1 + (numArgs << 8)) + ((0
? 1 << 16
: 0))) + ((0
? 1 << 24
: 0)));
- longAtput(sp4 = GIV(stackPointer) - BytesPerWord, object);
- GIV(stackPointer) = sp4;
+ longAtput(sp4 = GIV(stackPointer) - BytesPerWord, object);
+ GIV(stackPointer) = sp4;
+ /* begin push: */
+ longAtput(sp5 = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
+ GIV(stackPointer) = sp5;
+ /* begin push: */
+ longAtput(sp6 = GIV(stackPointer) - BytesPerWord, rcvr);
+ GIV(stackPointer) = sp6;
+ for (i1 = (numArgs + 1); i1 <= numTemps; i1 += 1) {
/* begin push: */
- longAtput(sp5 = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
- GIV(stackPointer) = sp5;
- /* begin push: */
- longAtput(sp6 = GIV(stackPointer) - BytesPerWord, rcvr);
- GIV(stackPointer) = sp6;
- for (i1 = (numArgs + 1); i1 <= numTemps; i1 += 1) {
- /* begin push: */
- longAtput(sp = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
- GIV(stackPointer) = sp;
- }
+ longAtput(sp = GIV(stackPointer) - BytesPerWord, GIV(nilObj));
+ GIV(stackPointer) = sp;
+ }
- /* Pass primitive error code to last temp if method receives it (indicated
+ /* Pass primitive error code to last temp if method receives it (indicated
by an initial long store temp bytecode). Protect against obsolete values
in primFailCode by checking that newMethod actually has a primitive? */
- GIV(instructionPointer) = ((GIV(newMethod) + ((LiteralStart + ((((usqInt) methodHeader) >> 10) & 255)) * BytesPerWord)) + BaseHeaderSize) - 1;
- if (GIV(primFailCode) != 0) {
- if (((methodHeader & 536871934) != 0)
- && ((byteAtPointer(GIV(instructionPointer) + 1)) == 129)) {
- /* begin getErrorObjectFromPrimFailCode */
- if (GIV(primFailCode) > 0) {
- table = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (PrimErrTableIndex << ShiftForWord));
- if (GIV(primFailCode) <= (((sqInt) (lastPointerOf(table)) >> 2))) {
- errorCode = longAt((table + BaseHeaderSize) + ((GIV(primFailCode) - 1) << ShiftForWord));
- goto l3;
- }
+ GIV(instructionPointer) = ((GIV(newMethod) + ((LiteralStart + ((((usqInt) methodHeader) >> 10) & 255)) * BytesPerWord)) + BaseHeaderSize) - 1;
+ if (GIV(primFailCode) != 0) {
+ if (((methodHeader & 536871934) != 0)
+ && ((byteAtPointer(GIV(instructionPointer) + 1)) == 129)) {
+ /* begin getErrorObjectFromPrimFailCode */
+ if (GIV(primFailCode) > 0) {
+ table = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (PrimErrTableIndex << ShiftForWord));
+ if (GIV(primFailCode) <= (((sqInt) (lastPointerOf(table)) >> 2))) {
+ errorCode = longAt((table + BaseHeaderSize) + ((GIV(primFailCode) - 1) << ShiftForWord));
+ goto l3;
}
- errorCode = ((GIV(primFailCode) << 1) | 1);
- l3: /* end getErrorObjectFromPrimFailCode */;
- longAtPointerput(GIV(stackPointer), errorCode);
}
- GIV(primFailCode) = 0;
+ errorCode = ((GIV(primFailCode) << 1) | 1);
+ l3: /* end getErrorObjectFromPrimFailCode */;
+ longAtPointerput(GIV(stackPointer), errorCode);
}
- if (GIV(stackPointer) < GIV(stackLimit)) {
- handleStackOverflowOrEventAllowContextSwitch(canContextSwitchIfActivating(methodHeader));
- }
- l1: /* end executeNewMethod */;
- /* begin initPrimCall */
GIV(primFailCode) = 0;
}
- else {
- /* begin unPop: */
- GIV(stackPointer) -= 1 * BytesPerWord;
- for (i = 1; i <= GIV(argumentCount); i += 1) {
- longAtput(GIV(stackPointer) + ((i - 1) * BytesPerWord), longAt(GIV(stackPointer) + (i * BytesPerWord)));
- }
- longAtput(GIV(stackPointer) + (GIV(argumentCount) * BytesPerWord), GIV(messageSelector));
- GIV(argumentCount) += 1;
- GIV(newMethod) = performMethod;
- GIV(messageSelector) = performSelector;
+ if (GIV(stackPointer) < GIV(stackLimit)) {
+ handleStackOverflowOrEventAllowContextSwitch(canContextSwitchIfActivating(methodHeader));
}
+l2: /* end executeNewMethod */;
+ /* begin initPrimCall */
+ GIV(primFailCode) = 0;
+ return;
}
static void
Modified: branches/Cog/stacksrc/vm/interp.h
===================================================================
--- branches/Cog/stacksrc/vm/interp.h 2010-09-22 03:23:57 UTC (rev 2312)
+++ branches/Cog/stacksrc/vm/interp.h 2010-09-26 02:24:21 UTC (rev 2313)
@@ -1,5 +1,5 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.31 uuid: d80799cf-0dd2-40dd-b3a6-f8bca14bdc3d
+ CCodeGeneratorGlobalStructure VMMaker-oscog.33 uuid: 733b7c50-b973-4ca0-9831-5c84d09032bf
*/
#define STACKVM 1
More information about the Vm-dev
mailing list