Packages November 2013

packages@lists.squeakfoundation.org

1 participants
315 discussions

The Trunk: System-fbs.631.mcz
by commits＠source.squeak.org 30 Nov '13

30 Nov '13

Frank Shearar uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-fbs.631.mcz ==================== Summary ==================== Name: System-fbs.631 Author: fbs Time: 30 November 2013, 11:13:44.331 pm UUID: af2dfa8c-5be9-334b-ae24-160e896c0872 Ancestors: System-fbs.630 Remove the #browserShowsPackagePane preference, after Tools-fbs.504 removed the underlying state. =============== Diff against System-fbs.630 =============== Item was removed: - ----- Method: Preferences class>>browserShowsPackagePane (in category 'standard queries') ----- - browserShowsPackagePane - ^ self - valueOfFlag: #browserShowsPackagePane - ifAbsent: [false]!

1 0

The Trunk: System-fbs.631.mcz
by commits＠source.squeak.org 30 Nov '13

30 Nov '13

1 0

The Trunk: System-fbs.631.mcz
by commits＠source.squeak.org 30 Nov '13

30 Nov '13

1 0

The Trunk: Tools-fbs.504.mcz
by commits＠source.squeak.org 30 Nov '13

30 Nov '13

Frank Shearar uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-fbs.504.mcz ==================== Summary ==================== Name: Tools-fbs.504 Author: fbs Time: 30 November 2013, 11:05:52.941 pm UUID: 1591d949-a7a9-3148-8b42-215f7067e7e0 Ancestors: Tools-cmm.503 Move #browserShowsPackagePane to the new pragma style preference. =============== Diff against Tools-cmm.503 =============== Item was added: + ----- Method: SystemBrowser class>>browserShowsPackagePane (in category 'preferences') ----- + browserShowsPackagePane + <preference: 'Browser shows package pane' category: 'browsing' description: 'If true, then the various ''browse full'' and ''browse it'' commands (usually invoked via cmd-b) will open a Package Browser rather than a System Browser. The Package Browser includes a package pane which groups system categories into packages based on the initial portion of their category name.' type: #Boolean> + ^ SystemNavigation default browserClass == PackagePaneBrowser.! Item was added: + ----- Method: SystemBrowser class>>browserShowsPackagePane: (in category 'preferences') ----- + browserShowsPackagePane: aBoolean + | theOtherOne | + self registeredClasses size = 2 + ifTrue: [theOtherOne := (self registeredClasses copyWithout: PackagePaneBrowser) first] + ifFalse: [theOtherOne := nil]. + aBoolean + ifTrue: [self default: PackagePaneBrowser] + ifFalse: [self default: theOtherOne]. + SystemNavigation default browserClass: self default.! Item was removed: - ----- Method: SystemBrowser class>>initialize (in category 'class initialization') ----- - initialize - | pref | - pref := Preferences preferenceAt: #browserShowsPackagePane. - Preferences - addPreference: #browserShowsPackagePane - categories: pref categoryList - default: pref defaultValue - balloonHelp: pref helpString - projectLocal: pref localToProject - changeInformee: self - changeSelector: #packagePanePreferenceChanged - ! Item was removed: - ----- Method: SystemBrowser class>>packagePanePreferenceChanged (in category 'events') ----- - packagePanePreferenceChanged - | theOtherOne | - self registeredClasses size = 2 - ifTrue: [theOtherOne := (self registeredClasses copyWithout: PackagePaneBrowser) first] - ifFalse: [theOtherOne := nil]. - (Preferences valueOfFlag: #browserShowsPackagePane ifAbsent: [false]) - ifTrue: [self default: PackagePaneBrowser] - ifFalse: [self default: theOtherOne]. - SystemNavigation default browserClass: self default.! Item was removed: - ----- Method: SystemBrowser class>>unload (in category 'initialize-release') ----- - unload - | pref | - pref := Preferences preferenceAt: #browserShowsPackagePane. - Preferences - addPreference: #browserShowsPackagePane - categories: pref categoryList - default: pref defaultValue - balloonHelp: pref helpString - projectLocal: pref localToProject - changeInformee: nil - changeSelector: nil - ! Item was changed: + (PackageInfo named: 'Tools') postscript: 'Preferences removePreference: #browserShowsPackagePane'! - (PackageInfo named: 'Tools') postscript: 'Workspace allSubInstancesDo: [ :each | (each instVarNamed: #bindings) ifNil: [ each initializeBindings ] ]. - World initializeDesktopCommandKeySelectors. - RecentMessages startUp.'!

1 0

The Trunk: Tools-fbs.504.mcz
by commits＠source.squeak.org 30 Nov '13

30 Nov '13

1 0

The Trunk: Tools-fbs.504.mcz
by commits＠source.squeak.org 30 Nov '13

30 Nov '13

1 0

The Trunk: MorphicExtrasTests-fbs.3.mcz
by commits＠source.squeak.org 30 Nov '13

30 Nov '13

Frank Shearar uploaded a new version of MorphicExtrasTests to project The Trunk: http://source.squeak.org/trunk/MorphicExtrasTests-fbs.3.mcz ==================== Summary ==================== Name: MorphicExtrasTests-fbs.3 Author: fbs Time: 30 November 2013, 11:03:19.679 pm UUID: 1c039763-bc92-834c-943e-d96d8820cbd7 Ancestors: MorphicExtrasTests-fbs.2 Tests for MorphicExtras's selector mangling. =============== Diff against MorphicExtrasTests-fbs.2 =============== Item was added: + TestCase subclass: #MorphicExtrasSymbolExtensionsTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'MorphicExtrasTests-Flaps'! Item was added: + ----- Method: MorphicExtrasSymbolExtensionsTest>>testAsSimpleSetterReturnsSetterSelector (in category 'as yet unclassified') ----- + testAsSimpleSetterReturnsSetterSelector + self assert: #foo: equals: #foo asSimpleSetter. + + "And it really is 'simple':" + self assert: #foo:: equals: #foo: asSimpleSetter.!

1 0

The Trunk: MorphicExtrasTests-fbs.3.mcz
by commits＠source.squeak.org 30 Nov '13

30 Nov '13

1 0

The Trunk: MorphicExtrasTests-fbs.3.mcz
by commits＠source.squeak.org 30 Nov '13

30 Nov '13

1 0

The Trunk: Kernel-eem.822.mcz
by commits＠source.squeak.org 30 Nov '13

30 Nov '13

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.822.mcz ==================== Summary ==================== Name: Kernel-eem.822 Author: eem Time: 30 November 2013, 1:21:56.41 pm UUID: b991e66c-90bb-4118-91c7-4b7dbe38d440 Ancestors: Kernel-cmm.821 Change the execution simulation machinery (as used by the Debugger) to: - use the mirror primitives to access the receiver and literal variables, avoiding sending messages to these objects, hence mimicking the VMs behaviour, and simulating the execution of code using proxies correctly. - retrieve the primitive error code form failing primitives - fix the simulation of Object>>perform:withArguments:inSuperclass: =============== Diff against Kernel-cmm.821 =============== Item was changed: + ----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') ----- - ----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'evaluating') ----- simulateValueWithArguments: anArray caller: aContext | newContext sz | (anArray class ~~ Array or: [numArgs ~= anArray size]) ifTrue: + [^ContextPart primitiveFailTokenFor: nil]. - [^ContextPart primitiveFailToken]. newContext := (MethodContext newForMethod: outerContext method) setSender: aContext receiver: outerContext receiver method: outerContext method closure: self startpc: startpc. sz := self basicSize. newContext stackp: sz + numArgs. 1 to: numArgs do: [:i| newContext at: i put: (anArray at: i)]. 1 to: sz do: [:i| newContext at: i + numArgs put: (self at: i)]. ^newContext! Item was changed: InstructionStream subclass: #ContextPart instanceVariableNames: 'stackp' + classVariableNames: 'MaxLengthForASingleDebugLogReport MaxStackDepthForASingleDebugLogReport PrimitiveFailToken QuickStep ValueIndex' - classVariableNames: 'MaxLengthForASingleDebugLogReport MaxStackDepthForASingleDebugLogReport PrimitiveFailToken QuickStep' poolDictionaries: '' category: 'Kernel-Methods'! !ContextPart commentStamp: '<historical>' prior: 0! To the instruction parsing ability of InstructionStream I add the actual semantics for execution. The execution state is stored in the indexable fields of my subclasses. This includes temporary variables and a stack of values used in evaluating expressions. The actual semantics of execution can be found in my category "system simulation" and "instruction decode". These methods exactly parallel the operation of the Smalltalk machine itself. The simulator is a group of my methods that do what the Smalltalk interpreter does: execute Smalltalk bytecodes. By adding code to the simulator, you may take statistics on the running of Smalltalk methods. For example, Transcript show: (ContextPart runSimulated: [3 factorial]) printString.! Item was changed: + ----- Method: ContextPart class>>initialize (in category 'class initialization') ----- - ----- Method: ContextPart class>>initialize (in category 'simulation') ----- initialize + ValueIndex := 2. + self assert: (Association instVarNameForIndex:ValueIndex) = 'value'. + PrimitiveFailToken class ~~ Object ifTrue: + [PrimitiveFailToken := Object new]! - - "A unique object to be returned when a primitive fails during simulation" - PrimitiveFailToken := Object new ! Item was added: + ----- Method: ContextPart class>>primitiveFailTokenFor: (in category 'simulation') ----- + primitiveFailTokenFor: errorCode + + ^{PrimitiveFailToken. errorCode}! Item was changed: ----- Method: ContextPart>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ PrimitiveFailToken. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. hence use primtiive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ToolSet debugContext: self label:'Code simulation error' contents: nil]. "ContextPart>>blockCopy:; simulated to get startpc right" + (primitiveIndex = 80 and: [(self objectClass: receiver) includesBehavior: ContextPart]) - (primitiveIndex = 80 and: [receiver isKindOf: ContextPart]) ifTrue: [^self push: ((BlockContext newForMethod: receiver method) home: receiver home startpc: pc + 2 nargs: (arguments at: 1))]. + (primitiveIndex = 81 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>value[:value:...]" - (primitiveIndex = 81 and: [receiver isMemberOf: BlockContext]) "BlockContext>>value[:value:...]" ifTrue: [^receiver pushArgs: arguments from: self]. + (primitiveIndex = 82 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>valueWithArguments:" - (primitiveIndex = 82 and: [receiver isMemberOf: BlockContext]) "BlockContext>>valueWithArguments:" ifTrue: [^receiver pushArgs: arguments first from: self]. primitiveIndex = 83 "afr 9/11/1998 19:50" "Object>>perform:[with:...]" + ifTrue: [^self send: arguments first + to: receiver - ifTrue: [^self send: arguments first to: receiver with: arguments allButFirst super: false]. + primitiveIndex = 84 "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" + ifTrue: [^self send: arguments first + to: receiver - primitiveIndex = 84 "afr 9/11/1998 19:50" "Object>>perform:withArguments:" - ifTrue: [^self send: arguments first to: receiver with: (arguments at: 2) + startClass: nil]. + primitiveIndex = 100 "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" + ifTrue: [^self send: arguments first + to: receiver + with: (arguments at: 2) + startClass: (arguments at: 3)]. + + "Mutex>>primitiveEnterCriticalSection + Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" + (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: + [| active effective | + active := Processor activeProcess. + effective := active effectiveProcess. + "active == effective" + value := primitiveIndex = 186 + ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] + ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. + ^((self objectClass: value) == Array + and: [value size = 2 + and: [value first == PrimitiveFailToken]]) + ifTrue: [value] + ifFalse: [self push: value]]. + + primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" + [^MethodContext - super: false]. - primitiveIndex = 188 ifTrue: [ - arguments size = 2 ifTrue: [ "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" - ^MethodContext - sender: self - receiver: receiver - method: (arguments at: 2) - arguments: (arguments at: 1) ]. - arguments size = 3 ifTrue: [ "CompiledMethod class >> #receiver:withArguments:executeMethod:" - ^MethodContext - sender: self - receiver: (arguments at: 1) - method: (arguments at: 3) - arguments: (arguments at: 2) ] ]. - primitiveIndex = 189 ifTrue: [ "Object >> (#with:)*executeMethod" - ^MethodContext sender: self receiver: receiver + method: (arguments at: 2) + arguments: (arguments at: 1)]. - method: arguments last - arguments: arguments allButLast ]. "Closure primitives" + (primitiveIndex = 200 and: [self == receiver]) ifTrue: - (primitiveIndex = 200 and: [receiver == self]) ifTrue: "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right" [^self push: (BlockClosure outerContext: receiver startpc: pc + 2 numArgs: arguments first copiedValues: arguments last)]. ((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]. primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. + primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM" + [(arguments size = 2 + and: [arguments first isInteger + and: [(self objectClass: arguments last) == Array]]) ifFalse: + [^ContextPart primitiveFailTokenFor: nil]. + ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. + + value := primitiveIndex = 120 "FFI method" + ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] + ifFalse: + [primitiveIndex = 117 "named primitives" + ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] + ifFalse: + [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. + ^((self objectClass: value) == Array + and: [value size = 2 + and: [value first == PrimitiveFailToken]]) + ifTrue: [value] - primitiveIndex = 120 ifTrue:[ "FFI method" - value := meth literals first tryInvokeWithArguments: arguments. - ] ifFalse:[ - arguments size > 6 ifTrue: [^PrimitiveFailToken]. - value := primitiveIndex = 117 "named primitives" - ifTrue:[self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] - ifFalse:[receiver tryPrimitive: primitiveIndex withArgs: arguments]. - ]. - ^value == PrimitiveFailToken - ifTrue: [PrimitiveFailToken] ifFalse: [self push: value]! Item was changed: ----- Method: ContextPart>>objectClass: (in category 'mirror primitives') ----- objectClass: anObject + "Answer the class of the argument anObject without sending it a message. + This mimics the action of the VM when it fetches an object's class. Used to + simulate the execution machinery by, for example, the debugger. + Primitive. See Object documentation whatIsAPrimitive." <primitive: 111> self primitiveFailed! Item was changed: ----- Method: ContextPart>>popIntoLiteralVariable: (in category 'instruction decoding') ----- popIntoLiteralVariable: value "Simulate the action of bytecode that removes the top of the stack and stores it into a literal variable of my method." + self object: value instVarAt: ValueIndex put: self pop! - value value: self pop! Item was changed: ----- Method: ContextPart>>popIntoReceiverVariable: (in category 'instruction decoding') ----- popIntoReceiverVariable: offset "Simulate the action of bytecode that removes the top of the stack and stores it into an instance variable of my receiver." + self object: self receiver instVarAt: offset + 1 put: self pop! - self receiver instVarAt: offset + 1 put: self pop! Item was changed: ----- Method: ContextPart>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex "Simulate the action of bytecode that removes the top of the stack and stores it into an offset in one of my local variables being used as a remote temp vector." + self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1 put: self pop! - (self at: tempVectorIndex + 1) at: remoteTempIndex + 1 put: self pop! Item was changed: ----- Method: ContextPart>>printOn: (in category 'printing') ----- printOn: aStream + | method selector class mclass | + (method := self method) ifNil: [^super printOn: aStream]. + class := self objectClass: self receiver. + mclass := method methodClass. + selector := method selector ifNil: [method defaultSelector]. - | selector class mclass | - self method == nil ifTrue: [^ super printOn: aStream]. - class := self receiver class. - mclass := self methodClass. - selector := self selector ifNil:[self method defaultSelector]. aStream nextPutAll: class name. + mclass ~~ class ifTrue: + [aStream nextPut: $(; nextPutAll: mclass name; nextPut: $)]. + aStream nextPutAll: '>>'; nextPutAll: selector. + (selector == #doesNotUnderstand: + and: [self closure isNil + and: [(self objectClass: (self tempAt: 1)) == Message]]) ifTrue: + [aStream space. + (self tempAt: 1) selector printOn: aStream]! - mclass == class - ifFalse: - [aStream nextPut: $(. - aStream nextPutAll: mclass name. - aStream nextPut: $)]. - aStream nextPutAll: '>>'. - aStream nextPutAll: selector. - selector = #doesNotUnderstand: ifTrue: [ - aStream space. - (self tempAt: 1) selector printOn: aStream. - ]. - ! Item was changed: ----- Method: ContextPart>>pushLiteralVariable: (in category 'instruction decoding') ----- pushLiteralVariable: value "Simulate the action of bytecode that pushes the contents of the literal variable whose index is the argument, index, on the top of the stack." + self push: (self object: value instVarAt: ValueIndex)! - self push: value value! Item was changed: ----- Method: ContextPart>>pushReceiverVariable: (in category 'instruction decoding') ----- pushReceiverVariable: offset "Simulate the action of bytecode that pushes the contents of the receiver's instance variable whose index is the argument, index, on the top of the stack." + self push: (self object: self receiver instVarAt: offset + 1)! - self push: (self receiver instVarAt: offset + 1)! Item was changed: ----- Method: ContextPart>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex "Simulate the action of bytecode that pushes the value at remoteTempIndex in one of my local variables being used as a remote temp vector." + self push: (self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1)! - self push: ((self at: tempVectorIndex + 1) at: remoteTempIndex + 1)! Item was changed: ----- Method: ContextPart>>quickSend:to:with:super: (in category 'controlling') ----- quickSend: selector to: receiver with: arguments super: superFlag + "Send the given selector with arguments in an environment which closely resembles + the non-simulating environment, with an interjected unwind-protected block to catch + nonlocal returns. Attention: don't get lost!! This beautiful method is due to + Hans-Martin Mosner. Eliot Miranda merely added the mirror primitive code." + | oldSender contextToReturnTo result lookupClass | - "Send the given selector with arguments in an environment which closely resembles the non-simulating environment, with an interjected unwind-protected block to catch nonlocal returns. - Attention: don't get lost!!" - | lookupClass contextToReturnTo result | contextToReturnTo := self. lookupClass := superFlag + ifTrue: [self method methodClassAssociation value superclass] + ifFalse: [self objectClass: self receiver]. + [oldSender := thisContext sender swapSender: self. + result := self object: receiver perform: selector withArguments: arguments inClass: lookupClass. + thisContext sender swapSender: oldSender] ifCurtailed: + [contextToReturnTo := thisContext sender receiver. "The block context returning nonlocally" - ifTrue: [(self method literalAt: self method numLiterals) value superclass] - ifFalse: [receiver class]. - [ | oldSender | - oldSender := thisContext sender swapSender: self. - result := receiver perform: selector withArguments: arguments inSuperclass: lookupClass. - thisContext sender swapSender: oldSender] ifCurtailed: [ - contextToReturnTo := thisContext sender receiver. "The block context returning nonlocally" contextToReturnTo jump: -1. "skip to front of return bytecode causing this unwind" + contextToReturnTo nextByte = 16r7C ifTrue: - contextToReturnTo nextByte = 16r7C ifTrue: [ "If it was a returnTop, push the value to be returned. Otherwise the value is implicit in the bytecode" + [contextToReturnTo push: (thisContext sender tempAt: 1)]. - contextToReturnTo push: (thisContext sender tempAt: 1)]. thisContext swapSender: thisContext home sender. "Make this block return to the method's sender" contextToReturnTo]. contextToReturnTo push: result. ^contextToReturnTo! Item was added: + ----- Method: ContextPart>>send:to:with:startClass: (in category 'controlling') ----- + send: selector to: rcvr with: args startClass: startClassOrNil + "Simulate the action of sending a message with selector, selector, and + arguments, args, to receiver. The argument, startClassOrNil, tells whether + the selector should be looked up in startClassOrNil or the class of the receiver." + + | class meth val ctxt | + class := startClassOrNil ifNil: [self objectClass: rcvr]. + meth := class lookupSelector: selector. + meth == nil ifTrue: + [^self + send: #doesNotUnderstand: + to: rcvr + with: (Array with: (Message selector: selector arguments: args)) + startClass: class]. + (args isArray + and: [args size = meth numArgs]) ifFalse: + [^ContextPart primitiveFailTokenFor: nil]. + val := self tryPrimitiveFor: meth receiver: rcvr args: args. + ((self objectClass: val) == Array + and: [val size = 2 + and: [val first == PrimitiveFailToken]]) ifFalse: + [^val]. + (selector == #doesNotUnderstand: + and: [class == ProtoObject]) ifTrue: + [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood']. + ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class. + ((self objectClass: val) == Array + and: [val size = 2 + and: [val first == PrimitiveFailToken + and: [val last notNil + and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue: + [ctxt at: ctxt stackPtr put: val last]. + ^ctxt! Item was changed: ----- Method: ContextPart>>send:to:with:super: (in category 'controlling') ----- send: selector to: rcvr with: args super: superFlag + "Simulate the action of sending a message with selector, selector, and + arguments, args, to receiver. The argument, superFlag, tells whether the + receiver of the message was specified with 'super' in the source method." - "Simulate the action of sending a message with selector, selector, and - arguments, args, to receiver. The argument, superFlag, tells whether the - receiver of the message was specified with 'super' in the source method." + | class meth val ctxt | - | class meth val | class := superFlag + ifTrue: [self method methodClassAssociation value superclass] + ifFalse: [self objectClass: rcvr]. - ifTrue: [(self method literalAt: self method numLiterals) value superclass] - ifFalse: [rcvr class]. meth := class lookupSelector: selector. + meth == nil ifTrue: + [^self + send: #doesNotUnderstand: + to: rcvr + with: (Array with: (Message selector: selector arguments: args)) + super: superFlag]. + val := self tryPrimitiveFor: meth receiver: rcvr args: args. + ((self objectClass: val) == Array + and: [val size = 2 + and: [val first == PrimitiveFailToken]]) ifFalse: + [^val]. + (selector == #doesNotUnderstand: + and: [class == ProtoObject]) ifTrue: + [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood']. + ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class. + ((self objectClass: val) == Array + and: [val size = 2 + and: [val first == PrimitiveFailToken + and: [val last notNil + and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue: + [ctxt at: ctxt stackPtr put: val last]. + ^ctxt! - meth == nil - ifTrue: [^ self send: #doesNotUnderstand: - to: rcvr - with: (Array with: (Message selector: selector arguments: args)) - super: superFlag] - ifFalse: [val := self tryPrimitiveFor: meth - receiver: rcvr - args: args. - val == PrimitiveFailToken ifFalse: [^ val]. - (selector == #doesNotUnderstand: and: [class == ProtoObject]) ifTrue: - [^ self error: 'Simulated message ' , (args at: 1) selector - , ' not understood']. - ^ self activateMethod: meth - withArgs: args - receiver: rcvr - class: class]! Item was changed: ----- Method: ContextPart>>storeIntoLiteralVariable: (in category 'instruction decoding') ----- storeIntoLiteralVariable: value "Simulate the action of bytecode that stores the top of the stack into a literal variable of my method." + self object: value instVarAt: ValueIndex put: self top! - value value: self top! Item was changed: ----- Method: ContextPart>>storeIntoReceiverVariable: (in category 'instruction decoding') ----- storeIntoReceiverVariable: offset "Simulate the action of bytecode that stores the top of the stack into an instance variable of my receiver." + self object: self receiver instVarAt: offset + 1 put: self top! - self receiver instVarAt: offset + 1 put: self top! Item was changed: ----- Method: ContextPart>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex "Simulate the action of bytecode that stores the top of the stack at an offset in one of my local variables being used as a remote temp vector." + self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1 put: self top! - (self at: tempVectorIndex + 1) at: remoteTempIndex + 1 put: self top! Item was changed: ----- Method: ContextPart>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') ----- tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments + | selector theMethod spec receiverClass | + <primitive: 218 error: ec> + ec ifNotNil: + ["If ec is an integer other than -1 there was a problem with primitive 218, + not with the external primitive itself. -1 indicates a generic failure (where + ec should be nil) but ec = nil means primitive 218 is not implemented. So + interpret -1 to mean the external primitive failed with a nil error code." + ec isInteger ifTrue: + [ec = -1 + ifTrue: [ec := nil] + ifFalse: [self primitiveFailed]]. + ^{PrimitiveFailToken. ec}]. + "Assume a nil error code implies the primitive is not implemented and fall back on the old code." "Hack. Attempt to execute the named primitive from the given compiled method" + arguments size > 8 ifTrue: + [^{PrimitiveFailToken. nil}]. - | selector theMethod spec | - arguments size > 8 ifTrue:[^PrimitiveFailToken]. selector := #( tryNamedPrimitive tryNamedPrimitive: tryNamedPrimitive:with: tryNamedPrimitive:with:with: tryNamedPrimitive:with:with:with: tryNamedPrimitive:with:with:with:with: tryNamedPrimitive:with:with:with:with:with: tryNamedPrimitive:with:with:with:with:with:with: tryNamedPrimitive:with:with:with:with:with:with:with:) at: arguments size+1. + receiverClass := self objectClass: aReceiver. + theMethod := receiverClass lookupSelector: selector. + theMethod == nil ifTrue: + [^{PrimitiveFailToken. nil}]. - theMethod := aReceiver class lookupSelector: selector. - theMethod == nil ifTrue:[^PrimitiveFailToken]. spec := theMethod literalAt: 1. spec replaceFrom: 1 to: spec size with: (aCompiledMethod literalAt: 1) startingAt: 1. + Smalltalk unbindExternalPrimitives. + ^self object: aReceiver perform: selector withArguments: arguments inClass: receiverClass! - theMethod flushCache. - selector flushCache. - ^aReceiver perform: selector withArguments: arguments! Item was changed: ----- Method: ContextPart>>tryPrimitiveFor:receiver:args: (in category 'private') ----- tryPrimitiveFor: method receiver: receiver args: arguments "If this method has a primitive index, then run the primitive and return its result. Otherwise (and also if the primitive fails) return PrimitiveFailToken, as an indication that the method should be activated and run as bytecodes." | primIndex | + (primIndex := method primitive) = 0 ifTrue: [^{PrimitiveFailToken. nil}]. - (primIndex := method primitive) = 0 ifTrue: [^ PrimitiveFailToken]. ^ self doPrimitive: primIndex method: method receiver: receiver args: arguments! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive (in category 'apply primitives') ----- tryNamedPrimitive "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." + <primitive:'' module:'' error: errorCode> + ^ContextPart primitiveFailTokenFor: errorCode! - <primitive:'' module:''> - ^ ContextPart primitiveFailToken! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." + <primitive:'' module:'' error: errorCode> + ^ContextPart primitiveFailTokenFor: errorCode! - <primitive:'' module:''> - ^ ContextPart primitiveFailToken! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." + <primitive:'' module:'' error: errorCode> + ^ContextPart primitiveFailTokenFor: errorCode! - <primitive:'' module:''> - ^ ContextPart primitiveFailToken! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." + <primitive:'' module:'' error: errorCode> + ^ContextPart primitiveFailTokenFor: errorCode! - <primitive:'' module:''> - ^ ContextPart primitiveFailToken! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." + <primitive:'' module:'' error: errorCode> + ^ContextPart primitiveFailTokenFor: errorCode! - <primitive:'' module:''> - ^ ContextPart primitiveFailToken! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." + <primitive:'' module:'' error: errorCode> + ^ContextPart primitiveFailTokenFor: errorCode! - <primitive:'' module:''> - ^ ContextPart primitiveFailToken! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." + <primitive:'' module:'' error: errorCode> + ^ContextPart primitiveFailTokenFor: errorCode! - <primitive:'' module:''> - ^ ContextPart primitiveFailToken! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." + <primitive:'' module:'' error: errorCode> + ^ContextPart primitiveFailTokenFor: errorCode! - <primitive:'' module:''> - ^ ContextPart primitiveFailToken! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." + <primitive:'' module:'' error: errorCode> + ^ContextPart primitiveFailTokenFor: errorCode! - <primitive:'' module:''> - ^ ContextPart primitiveFailToken! Item was changed: ----- Method: ProtoObject>>tryPrimitive:withArgs: (in category 'apply primitives') ----- tryPrimitive: primIndex withArgs: argumentArray "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." + <primitive: 118 error: errorCode> + ^ContextPart primitiveFailTokenFor: errorCode! - <primitive: 118> - ^ ContextPart primitiveFailToken!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages November 2013