Squeak-dev December 2021

squeak-dev@lists.squeakfoundation.org

30 participants
390 discussions

The Trunk: Kernel-ct.1422.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1422.mcz ==================== Summary ==================== Name: Kernel-ct.1422 Author: ct Time: 13 November 2021, 2:24:19.131577 am UUID: 8007a459-5796-df4d-9f2d-5137bc856bea Ancestors: Kernel-eem.1420 Context: Make sure to actually use #activateMethod:withArgs:... which had zero senders in the past. This is a helpful hook to be overridden in subclasses, cf. SimulationStudio. Deprecate the unused #class: argument. =============== Diff against Kernel-eem.1420 =============== Item was added: + ----- Method: Context>>activateMethod:withArgs:receiver: (in category 'controlling') ----- + activateMethod: newMethod withArgs: args receiver: rcvr + "Answer a Context initialized with the arguments." + + ^Context + sender: self + receiver: rcvr + method: newMethod + arguments: args! Item was changed: ----- Method: Context>>activateMethod:withArgs:receiver:class: (in category 'controlling') ----- + activateMethod: newMethod withArgs: args receiver: rcvr class: class - activateMethod: newMethod withArgs: args receiver: rcvr class: class - "Answer a Context initialized with the arguments." + self deprecated. + ^ self activateMethod: newMethod withArgs: args receiver: rcvr! - ^Context - sender: self - receiver: rcvr - method: newMethod - arguments: args! Item was changed: ----- Method: Context>>contextForLocalVariables (in category 'accessing') ----- contextForLocalVariables "Answer the context in which local variables (temporaries) are stored." + self flag: #ct. "Deprecate?" self subclassResponsibility! Item was changed: ----- Method: Context>>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 ^ {errCode, 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 primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. + ^self + activateMethod: methodArg + withArgs: args + receiver: thisReceiver]. - ^Context - sender: self - receiver: thisReceiver - method: methodArg - arguments: args]. primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class 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: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]! Item was changed: ----- Method: Context>>send:to:with:lookupIn: (in category 'controlling') ----- send: selector to: rcvr with: arguments lookupIn: lookupClass "Simulate the action of sending a message with selector and arguments to rcvr. The argument, lookupClass, is the class in which to lookup the message. This is the receiver's class for normal messages, but for super messages it will be some specific class related to the source method." | meth primIndex val ctxt | (meth := lookupClass lookupSelector: selector) ifNil: [selector == #doesNotUnderstand: ifTrue: [self error: 'Recursive message not understood!!' translated]. ^self send: #doesNotUnderstand: to: rcvr with: {(Message selector: selector arguments: arguments) lookupClass: lookupClass} lookupIn: lookupClass]. meth isCompiledMethod ifFalse: ["Object as Methods (OaM) protocol: 'The contract is that, when the VM encounters an ordinary object (rather than a compiled method) in the method dictionary during lookup, it sends it the special selector #run:with:in: providing the original selector, arguments, and receiver.'. DOI: 10.1145/2991041.2991062." ^self send: #run:with:in: to: meth with: {selector. arguments. rcvr}]. meth numArgs = arguments size ifFalse: [^ self error: ('Wrong number of arguments in simulated message {1}' translated format: {selector})]. (primIndex := meth primitive) > 0 ifTrue: [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments. (self isPrimFailToken: val) ifFalse: [^val]]. (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue: [^self error: ('Simulated message {1} not understood' translated format: {arguments first selector})]. + ctxt := self activateMethod: meth withArgs: arguments receiver: rcvr. - ctxt := Context sender: self receiver: rcvr method: meth arguments: arguments. (primIndex isInteger and: [primIndex > 0]) ifTrue: [ctxt failPrimitiveWith: val]. ^ctxt!

1 0

The Trunk: Kernel-ct.1421.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1421.mcz ==================== Summary ==================== Name: Kernel-ct.1421 Author: ct Time: 13 November 2021, 2:21:21.656577 am UUID: 439a87c2-4cbd-bb43-8daa-ee529a7e1080 Ancestors: Kernel-eem.1420 Implements missing #adaptToScaledDecimal:andSend: on Object (#adaptToScaledDecimal:andCompare: already exists). Now it is possible to evaluate the following to get a collection of scaled decimals: 2.04s * (1 to: 3) "#(2.04s2 4.08s2 6.12s2)" =============== Diff against Kernel-eem.1420 =============== Item was added: + ----- Method: Object>>adaptToScaledDecimal:andSend: (in category 'converting') ----- + adaptToScaledDecimal: rcvr andSend: selector + "If no method has been provided for adapting an object to a ScaledDecimal, + then it may be adequate to simply adapt it to a number." + ^ self adaptToNumber: rcvr andSend: selector!

1 0

The Trunk: Kernel-ct.1415.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1415.mcz ==================== Summary ==================== Name: Kernel-ct.1415 Author: ct Time: 18 October 2021, 7:30:07.101559 pm UUID: 46e5ecc6-d349-ce49-983d-3a437a1fd620 Ancestors: Kernel-eem.1414 Fixes CompiledMethod >> #(reads|writes)Ref: to honor nested code literals (i.e. CompiledBlocks) correctly. The literal index needs to be determined for every literal individually. With this patch, also the "stores into"/"assignments..." button in tools works again. For example, browsing assignments to the variable NextMinorVersion in the class ReleaseBuilder does not report "no stores into" any longer. For reference, the first attempt of refactoring these methods was made in Kernel-mt.1244. =============== Diff against Kernel-eem.1414 =============== Item was added: + ----- Method: CompiledCode>>indexOfLiteral: (in category 'literals') ----- + indexOfLiteral: literal + "Answer the literal index of the argument, literal, or zero if none." + 2 to: self numLiterals - 1 "exclude selector/properties + methodClass" + do: + [:index | + literal == (self objectAt: index) ifTrue: [^index - 1]]. + ^0! Item was removed: - ----- Method: CompiledMethod>>indexOfLiteral: (in category 'literals') ----- - indexOfLiteral: literal - "Answer the literal index of the argument, literal, or zero if none." - 2 to: self numLiterals - 1 "exclude selector/properties + methodClass" - do: - [:index | - literal == (self objectAt: index) ifTrue: [^index - 1]]. - ^0! Item was changed: ----- Method: CompiledMethod>>readsRef: (in category 'scanning') ----- readsRef: variableBinding "Answer whether the receiver reads the value of the argument." + + self codeLiteralsDo: [:compiledCode | + | litIndex scanner | + (litIndex := compiledCode indexOfLiteral: variableBinding) = 0 + ifFalse: + [scanner := InstructionStream on: compiledCode. + (scanner scanFor: (compiledCode encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner)) + ifTrue: [^ true]]]. - "eem 5/24/2008 Rewritten to no longer assume the compler uses the - most compact encoding available (for EncoderForLongFormV3 support)." - | litIndex scanner | - (litIndex := self indexOfLiteral: variableBinding) = 0 - ifTrue: [^false]. - - self codeLiteralsDo: [:compiledCode | - scanner := InstructionStream on: compiledCode. - (scanner scanFor: (self encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner)) - ifTrue: [^ true]]. - ^ false! Item was changed: ----- Method: CompiledMethod>>writesRef: (in category 'scanning') ----- writesRef: variableBinding "Answer whether the receiver writes the value of the argument." - "eem 5/24/2008 Rewritten to no longer assume the compler uses the - most compact encoding available (for EncoderForLongFormV3 support)." - - | litIndex scanner | - (litIndex := self indexOfLiteral: variableBinding) = 0 - ifTrue: [^ false]. - - self codeLiteralsDo: [:compiledCode | - scanner := InstructionStream on: compiledCode. - (scanner scanFor: (self encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner)) - ifTrue: [^ true]]. + self codeLiteralsDo: [:compiledCode | + | litIndex scanner | + (litIndex := compiledCode indexOfLiteral: variableBinding) = 0 + ifFalse: + [scanner := InstructionStream on: compiledCode. + (scanner scanFor: (compiledCode encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner)) + ifTrue: [^ true]]]. + ^ false!

1 0

The Trunk: 60Deprecated-mt.99.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-mt.99.mcz ==================== Summary ==================== Name: 60Deprecated-mt.99 Author: mt Time: 1 December 2021, 4:32:51.993194 pm UUID: 29455b36-eada-ca44-97eb-83541b222aaf Ancestors: 60Deprecated-mt.98, 60Deprecated-ct.96 Complements Kernel-mt.1432 =============== Diff against 60Deprecated-mt.98 =============== Item was added: + ----- Method: CompiledCode>>messagesDo: (in category '*60Deprecated-scanning') ----- + messagesDo: workBlock + + self deprecated: 'ct: Use #selectorsDo:.'. + ^ self selectorsDo: workBlock! Item was added: + ----- Method: CompiledCode>>sendsMessage: (in category '*60Deprecated-testing') ----- + sendsMessage: selector + + self deprecated: 'ct: Use #sendsSelector:.'. + ^ self sendsSelector: selector!

1 0

The Trunk: Kernel-ct.1411.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1411.mcz ==================== Summary ==================== Name: Kernel-ct.1411 Author: ct Time: 7 September 2021, 11:48:46.77951 pm UUID: eb498fd3-2dec-524a-8512-d79b816970d7 Ancestors: Kernel-eem.1408 Deprecates CompiledCode >> #messagesDo: and #sendsMessage: in favor of their 'selectors' equivalent, as requested per Kernel-eem.1321. Cleans up contents from Object releaseNotes which are on their way into the official release notes in the squeak-app repo. =============== Diff against Kernel-eem.1408 =============== Item was removed: - ----- Method: CompiledCode>>messagesDo: (in category 'scanning') ----- - messagesDo: workBlock - "Evaluate aBlock with all the message selectors sent by me. Duplicate seletors are possible." - - "If anything should be deprecated it is messagesDo:; it can be an extension in AST/Refactoring. - This method enumerates over selectors, not messages. c.f. Behavior>>selectorsDo: etc" - ^self selectorsDo: workBlock! Item was removed: - ----- Method: CompiledCode>>sendsMessage: (in category 'testing') ----- - sendsMessage: aSelector - "eem: this should be deprecated. This method does not check if a method sends a message; - it checks if a method sends a message with a particular selector." - self flag: #todo. - self messagesDo: [:selector | - selector = aSelector ifTrue: [^ true]]. - ^ false! Item was changed: ----- Method: Object class>>releaseNotes (in category 'documentation') ----- releaseNotes + "This is a scratch pad of release notes for the 6.0 release this version is building towards. - "This is a scratch pad of release3 notes for the 6.0 release this version is building towards. Feel free to add to this comment mention of things that should appear in the release notes. + <tbd>" - Read-only object support and read-only literals. - the current VM supports a per-object read-only bit and will fail to modify objects marked with this flag bit. - This affects assignments to inst vars, to indexed fields in at:put: primitives, attempts to become read-only - objects into non-read-only objects, and attempts to change the class of read-only objects. All such attempts - raise a ModificationForbidden error. The error may retry the modification once the object has been made - writable. The compiler has been modified to make all literals read-only." self error: 'comment only'!

1 0

The Trunk: KernelTests-mt.412.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-mt.412.mcz ==================== Summary ==================== Name: KernelTests-mt.412 Author: mt Time: 1 December 2021, 4:29:17.264194 pm UUID: a0b2cfc2-83af-e740-bd69-4c39d802eb39 Ancestors: KernelTests-pre.411, KernelTests-ct.408 Complements Kernel-mt.1432 =============== Diff against KernelTests-pre.411 =============== Item was added: + ----- Method: SqNumberParserTest>>testBases (in category 'tests - fail') ----- + testBases + + self assert: (SqNumberParser parse: '16r20') equals: 32. + self assert: (SqNumberParser parse: '2r10') equals: 2. + self assert: ((SqNumberParser on: '10') + nextIntegerBase: 2) equals: 2. + self assert: ((SqNumberParser on: '10') + defaultBase: 2; + nextNumber) equals: 2. + self assert: ((SqNumberParser on: '1000r10') + defaultBase: 2; + nextNumber) equals: 8.!

1 0

The Trunk: Kernel-mt.1432.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1432.mcz ==================== Summary ==================== Name: Kernel-mt.1432 Author: mt Time: 1 December 2021, 4:28:24.973194 pm UUID: a3702ef9-5930-2841-a989-9af4699594e7 Ancestors: Kernel-mt.1431, Kernel-ct.1411, Kernel-ct.1415, Kernel-ct.1419, Kernel-ct.1421, Kernel-ct.1422 Merge. Merge. Merge. Kernel-ct.1411: Deprecates CompiledCode >> #messagesDo: and #sendsMessage: in favor of their 'selectors' equivalent, as requested per Kernel-eem.1321. Cleans up contents from Object releaseNotes which are on their way into the official release notes in the squeak-app repo. Kernel-ct.1415: Fixes CompiledMethod >> #(reads|writes)Ref: to honor nested code literals (i.e. CompiledBlocks) correctly. The literal index needs to be determined for every literal individually. With this patch, also the "stores into"/"assignments..." button in tools works again. For example, browsing assignments to the variable NextMinorVersion in the class ReleaseBuilder does not report "no stores into" any longer. For reference, the first attempt of refactoring these methods was made in Kernel-mt.1244. Kernel-ct.1419: Makes it possible to specify a different default base in number parsers. There is no need to hard-code the 10 and I am actually building something with a different default number system. Clients can still change the base via the radix notation. (ExtendedNumberParser on: '10') defaultBase: 16; nextNumber. "16" (ExtendedNumberParser on: '2r10') defaultBase: 16; nextNumber. "2" (ExtendedNumberParser on: 'ar10') defaultBase: 16; nextNumber. "10". Also adds Integer class >> #readFrom:base:ifFail: for convenience. Removes redundant class-side overrides on SqNumberParser. Kernel-ct.1421: Implements missing #adaptToScaledDecimal:andSend: on Object (#adaptToScaledDecimal:andCompare: already exists). Now it is possible to evaluate the following to get a collection of scaled decimals: 2.04s * (1 to: 3) "#(2.04s2 4.08s2 6.12s2)" Kernel-ct.1422: Context: Make sure to actually use #activateMethod:withArgs:... which had zero senders in the past. This is a helpful hook to be overridden in subclasses, cf. SimulationStudio. Deprecate the unused #class: argument. =============== Diff against Kernel-mt.1431 =============== Item was added: + ----- Method: CompiledCode>>indexOfLiteral: (in category 'literals') ----- + indexOfLiteral: literal + "Answer the literal index of the argument, literal, or zero if none." + 2 to: self numLiterals - 1 "exclude selector/properties + methodClass" + do: + [:index | + literal == (self objectAt: index) ifTrue: [^index - 1]]. + ^0! Item was removed: - ----- Method: CompiledCode>>messagesDo: (in category 'scanning') ----- - messagesDo: workBlock - "Evaluate aBlock with all the message selectors sent by me. Duplicate seletors are possible." - - "If anything should be deprecated it is messagesDo:; it can be an extension in AST/Refactoring. - This method enumerates over selectors, not messages. c.f. Behavior>>selectorsDo: etc" - ^self selectorsDo: workBlock! Item was removed: - ----- Method: CompiledCode>>sendsMessage: (in category 'testing') ----- - sendsMessage: aSelector - "eem: this should be deprecated. This method does not check if a method sends a message; - it checks if a method sends a message with a particular selector." - self flag: #todo. - self messagesDo: [:selector | - selector = aSelector ifTrue: [^ true]]. - ^ false! Item was removed: - ----- Method: CompiledMethod>>indexOfLiteral: (in category 'literals') ----- - indexOfLiteral: literal - "Answer the literal index of the argument, literal, or zero if none." - 2 to: self numLiterals - 1 "exclude selector/properties + methodClass" - do: - [:index | - literal == (self objectAt: index) ifTrue: [^index - 1]]. - ^0! Item was changed: ----- Method: CompiledMethod>>readsRef: (in category 'scanning') ----- readsRef: variableBinding "Answer whether the receiver reads the value of the argument." + + self codeLiteralsDo: [:compiledCode | + | litIndex scanner | + (litIndex := compiledCode indexOfLiteral: variableBinding) = 0 + ifFalse: + [scanner := InstructionStream on: compiledCode. + (scanner scanFor: (compiledCode encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner)) + ifTrue: [^ true]]]. - "eem 5/24/2008 Rewritten to no longer assume the compler uses the - most compact encoding available (for EncoderForLongFormV3 support)." - | litIndex scanner | - (litIndex := self indexOfLiteral: variableBinding) = 0 - ifTrue: [^false]. - - self codeLiteralsDo: [:compiledCode | - scanner := InstructionStream on: compiledCode. - (scanner scanFor: (self encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner)) - ifTrue: [^ true]]. - ^ false! Item was changed: ----- Method: CompiledMethod>>writesRef: (in category 'scanning') ----- writesRef: variableBinding "Answer whether the receiver writes the value of the argument." - "eem 5/24/2008 Rewritten to no longer assume the compler uses the - most compact encoding available (for EncoderForLongFormV3 support)." - - | litIndex scanner | - (litIndex := self indexOfLiteral: variableBinding) = 0 - ifTrue: [^ false]. - - self codeLiteralsDo: [:compiledCode | - scanner := InstructionStream on: compiledCode. - (scanner scanFor: (self encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner)) - ifTrue: [^ true]]. + self codeLiteralsDo: [:compiledCode | + | litIndex scanner | + (litIndex := compiledCode indexOfLiteral: variableBinding) = 0 + ifFalse: + [scanner := InstructionStream on: compiledCode. + (scanner scanFor: (compiledCode encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner)) + ifTrue: [^ true]]]. + ^ false! Item was added: + ----- Method: Context>>activateMethod:withArgs:receiver: (in category 'controlling') ----- + activateMethod: newMethod withArgs: args receiver: rcvr + "Answer a Context initialized with the arguments." + + ^Context + sender: self + receiver: rcvr + method: newMethod + arguments: args! Item was changed: ----- Method: Context>>activateMethod:withArgs:receiver:class: (in category 'controlling') ----- + activateMethod: newMethod withArgs: args receiver: rcvr class: class - activateMethod: newMethod withArgs: args receiver: rcvr class: class - "Answer a Context initialized with the arguments." + self deprecated. + ^ self activateMethod: newMethod withArgs: args receiver: rcvr! - ^Context - sender: self - receiver: rcvr - method: newMethod - arguments: args! Item was changed: ----- Method: Context>>contextForLocalVariables (in category 'accessing') ----- contextForLocalVariables "Answer the context in which local variables (temporaries) are stored." + self flag: #ct. "Deprecate?" self subclassResponsibility! Item was changed: ----- Method: Context>>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 ^ {errCode, 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 primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. + ^self + activateMethod: methodArg + withArgs: args + receiver: thisReceiver]. - ^Context - sender: self - receiver: thisReceiver - method: methodArg - arguments: args]. primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class 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: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]! Item was changed: ----- Method: Context>>send:to:with:lookupIn: (in category 'controlling') ----- send: selector to: rcvr with: arguments lookupIn: lookupClass "Simulate the action of sending a message with selector and arguments to rcvr. The argument, lookupClass, is the class in which to lookup the message. This is the receiver's class for normal messages, but for super messages it will be some specific class related to the source method." | meth primIndex val ctxt | (meth := lookupClass lookupSelector: selector) ifNil: [selector == #doesNotUnderstand: ifTrue: [self error: 'Recursive message not understood!!' translated]. ^self send: #doesNotUnderstand: to: rcvr with: {(Message selector: selector arguments: arguments) lookupClass: lookupClass} lookupIn: lookupClass]. meth isCompiledMethod ifFalse: ["Object as Methods (OaM) protocol: 'The contract is that, when the VM encounters an ordinary object (rather than a compiled method) in the method dictionary during lookup, it sends it the special selector #run:with:in: providing the original selector, arguments, and receiver.'. DOI: 10.1145/2991041.2991062." ^self send: #run:with:in: to: meth with: {selector. arguments. rcvr}]. meth numArgs = arguments size ifFalse: [^ self error: ('Wrong number of arguments in simulated message {1}' translated format: {selector})]. (primIndex := meth primitive) > 0 ifTrue: [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments. (self isPrimFailToken: val) ifFalse: [^val]]. + ctxt := self activateMethod: meth withArgs: arguments receiver: rcvr. - ctxt := Context sender: self receiver: rcvr method: meth arguments: arguments. (primIndex isInteger and: [primIndex > 0]) ifTrue: [ctxt failPrimitiveWith: val]. ^ctxt! Item was changed: ----- Method: ExtendedNumberParser>>nextFraction (in category 'parsing-public') ----- nextFraction | numerator denominator numberOfTrailingZeroInIntegerPart | + base := self defaultBase. - base := 10. neg := self peekSignIsMinus. (integerPart := self nextUnsignedIntegerOrNilBase: base) ifNil: [numberOfTrailingZeroInIntegerPart := 0] ifNotNil: [ numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $r) ifTrue: ["<base>r<integer>" (base := integerPart) < 2 ifTrue: [ sourceStream skip: -1. ^ self expected: 'an integer greater than 1 as valid radix']. self peekSignIsMinus ifTrue: [neg := neg not]. integerPart := self nextUnsignedIntegerBase: base. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero]]. (sourceStream peekFor: $.) ifTrue: [^self readFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart]. integerPart ifNil: ["No integerPart, raise an error" ^ self expected: 'a digit']. numerator := neg ifTrue: [integerPart negated] ifFalse: [integerPart]. self readExponent ifTrue: [numerator := numerator * (base raisedToInteger: exponent)]. (sourceStream peekFor: $/) ifFalse: [^numerator]. base := 10. + base := self defaultBase. (denominator := self nextUnsignedIntegerOrNilBase: base) ifNil: [sourceStream skip: -1. "Not a valid denominator, ungobble / and return numerator" ^numerator]. (sourceStream peekFor: $r) ifTrue: ["<base>r<integer>" (base := denominator) < 2 ifTrue: [ sourceStream skip: -1. ^ self expected: 'an integer greater than 1 as valid radix']. denominator := self nextUnsignedIntegerBase: base]. self readExponent ifTrue: [denominator := denominator * (base raisedToInteger: exponent)]. ^numerator / denominator! Item was changed: ----- Method: ExtendedNumberParser>>nextNumber (in category 'parsing-public') ----- nextNumber "main method for reading a number. This one can read Float Integer and ScaledDecimal" | numberOfTrailingZeroInIntegerPart | + base := self defaultBase. - base := 10. neg := self peekSignIsMinus. integerPart := self nextUnsignedIntegerOrNilBase: base. integerPart ifNil: [(sourceStream peekFor: $.) ifTrue: [ "Try .1 syntax" ^self readNumberWithoutIntegerPart] ifFalse: [ "This is not a regular number beginning with a digit It is time to check for exceptional condition NaN and Infinity" ^self readNamedFloatOrFail]]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $r) ifTrue: ["<base>r<integer>" | oldNeg pos | pos := sourceStream position - 1. (base := integerPart) < 2 ifTrue: ["A radix currently need to be greater than 1, ungobble the r and return the integer part" sourceStream skip: -1. ^neg ifTrue: [base negated] ifFalse: [base]]. oldNeg := neg. self peekSignIsMinus ifTrue: [neg := neg not]. integerPart := self nextUnsignedIntegerOrNilBase: base. integerPart ifNil: [ (sourceStream peekFor: $.) ifTrue: [self readNumberWithoutIntegerPartOrNil ifNotNil: [:aNumber | ^aNumber]]. sourceStream position: pos. ^oldNeg ifTrue: [base negated] ifFalse: [base]]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero]. ^ (sourceStream peekFor: $.) ifTrue: [self readNumberWithFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart] ifFalse: [self makeIntegerOrScaledInteger]! Item was changed: ----- Method: FORTRANNumberParser>>nextNumber (in category 'parsing-public') ----- nextNumber "main method for reading a number with FORTRAN syntax. This one can read Real and Integer (not complex)" | numberOfTrailingZeroInIntegerPart numberOfNonZeroFractionDigits mantissa value numberOfTrailingZeroInFractionPart noInt | + base := self defaultBase.. - base := 10. (self nextMatchAll: 'NaN') ifTrue: [^Float nan]. neg := self peekSignIsMinus. (self nextMatchAll: 'Infinity') ifTrue: [^neg ifTrue: [Float negativeInfinity] ifFalse: [Float infinity]]. (noInt := sourceStream peekFor: $.) ifTrue: [integerPart := 0. numberOfTrailingZeroInIntegerPart := 0] ifFalse: [integerPart := self nextUnsignedIntegerBase: base. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero]. (noInt or: [sourceStream peekFor: $.]) ifTrue: [fractionPart := self nextUnsignedIntegerBase: base ifFail: [nil]. fractionPart isNil ifTrue: [noInt ifTrue: ["no interger part, no fraction part..." self expected: 'a digit 0 to 9'. ^nil]. fractionPart := 0] ifFalse: [numberOfNonZeroFractionDigits := lastNonZero. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero]. self readExponent] ifFalse: [self readExponent ifFalse: [^neg ifTrue: [integerPart negated] ifFalse: [integerPart]]. fractionPart := 0]. fractionPart isZero ifTrue: [mantissa := integerPart // (base raisedTo: numberOfTrailingZeroInIntegerPart). exponent := exponent + numberOfTrailingZeroInIntegerPart] ifFalse: [mantissa := integerPart * (base raisedTo: numberOfNonZeroFractionDigits) + (fractionPart // (base raisedTo: numberOfTrailingZeroInFractionPart)). exponent := exponent - numberOfNonZeroFractionDigits]. value := self makeFloatFromMantissa: mantissa exponent: exponent base: base. ^neg ifTrue: [value isZero ifTrue: [Float negativeZero] ifFalse: [value negated]] ifFalse: [value]! Item was added: + ----- Method: Integer class>>readFrom:base:ifFail: (in category 'instance creation') ----- + readFrom: aStringOrStream base: base ifFail: aBlock + "Answer an instance of one of the concrete subclasses if Integer. + Initial plus or minus sign accepted, and bases > 10 use letters A-Z. + Imbedded radix specifiers not allowed; use Number class readFrom: for that. + Execute aBlock if there are no digits." + + ^(ExtendedNumberParser on: aStringOrStream) nextIntegerBase: base ifFail: aBlock! Item was changed: Object subclass: #NumberParser + instanceVariableNames: 'sourceStream base neg integerPart fractionPart exponent scale nDigits lastNonZero requestor failBlock defaultBase' - instanceVariableNames: 'sourceStream base neg integerPart fractionPart exponent scale nDigits lastNonZero requestor failBlock' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Numbers'! + !NumberParser commentStamp: 'ct 10/27/2021 22:04' prior: 0! - !NumberParser commentStamp: 'nice 3/15/2010 00:16' prior: 0! NumberParser is an abstract class for parsing and building numbers from string/stream. It offers a framework with utility methods and exception handling. Number syntax is not defined and should be subclassResponsibility. Instance variables: sourceStream <Stream> the stream of characters from which the number is read base <Integer> the radix in which to interpret digits neg <Boolean> true in case of minus sign integerPart <Integer> the integer part of the number fractionPart <Integer> the fraction part of the number if any exponent <Integer> the exponent used in scientific notation if any scale <Integer> the scale used in case of ScaledDecimal number if any nDigits <Integer> number of digits read to form an Integer lasNonZero <Integer> position of last non zero digit, starting at 1 from left, 0 if all digits are zero requestor <TextEditor | nil> can be used to insert an error message in the requestor failBlock <BlockClosure> Block to execute whenever an error occurs. The fail block can have 0, 1 or 2 arguments (errorString and source position) + defaultBase <Integer> the default radix in which to interpret digits, unless specified differently via radix notation! - ! Item was added: + ----- Method: NumberParser>>defaultBase (in category 'accessing') ----- + defaultBase + + ^ defaultBase! Item was added: + ----- Method: NumberParser>>defaultBase: (in category 'accessing') ----- + defaultBase: anInteger + + self assert: anInteger < 28 description: 'Default base must be lower than 28 to keep radix r distinguishable from digits. For higher bases, pass the base manually to #nextNumberBase: autc.'. + defaultBase := anInteger! Item was added: + ----- Method: NumberParser>>defaultRadixBase (in category 'accessing') ----- + defaultRadixBase + + ^ 10! Item was added: + ----- Method: NumberParser>>initialize (in category 'initialize-release') ----- + initialize + + defaultBase := 10! Item was changed: ----- Method: NumberParser>>nextInteger (in category 'parsing-public') ----- nextInteger "Read an Integer from sourceStream, asnwser that Integer. This is a generic version dealing with an optional sign and a simple sequence of decimal digits. Subclass might define extended syntax." + base := self defaultBase. - base := 10. ^self nextIntegerBase: base ifFail: [^self expected: ('a digit between 0 and ' copyWith: (Character digitValue: base - 1))]! Item was changed: ----- Method: NumberParser>>nextUnsignedInteger (in category 'parsing-public') ----- nextUnsignedInteger "Read an Integer from sourceStream, asnwser that Integer. This is a generic version dealing with a simple sequence of decimal digits. Subclass might define extended syntax." + + base := self defaultBase. - - base := 10. ^self nextUnsignedIntegerBase: base ifFail: [^self expected: ('a digit between 0 and ' copyWith: (Character digitValue: base - 1))]! Item was changed: ----- Method: NumberParser>>on: (in category 'initialize-release') ----- on: aStringOrStream sourceStream := aStringOrStream isString ifTrue: [ aStringOrStream readStream ] ifFalse: [ aStringOrStream ]. + base := self defaultBase. - base := 10. neg := false. integerPart := fractionPart := exponent := scale := 0. requestor := failBlock := nil! Item was changed: ----- Method: NumberParser>>readExponent (in category 'parsing-private') ----- readExponent "read the exponent if any (stored in instVar). Answer true if found, answer false if none. If exponent letter is not followed by a digit, this is not considered as an error. Exponent are always read in base 10." | eneg epos | exponent := 0. (self isExponentLetter: sourceStream peek) ifFalse: [^ false]. sourceStream next. eneg := sourceStream peekFor: $-. epos := eneg not and: [self allowPlusSignInExponent and: [sourceStream peekFor: $+]]. + exponent := self nextUnsignedIntegerOrNilBase: self defaultBase. - exponent := self nextUnsignedIntegerOrNilBase: 10. exponent ifNil: ["Oops, there was no digit after the exponent letter.Ungobble the letter" exponent := 0. sourceStream skip: ((eneg or: [epos]) ifTrue: [-2] ifFalse: [-1]). ^ false]. eneg ifTrue: [exponent := exponent negated]. ^true! Item was changed: ----- Method: Object class>>releaseNotes (in category 'documentation') ----- releaseNotes + "This is a scratch pad of release notes for the 6.0 release this version is building towards. - "This is a scratch pad of release3 notes for the 6.0 release this version is building towards. Feel free to add to this comment mention of things that should appear in the release notes. + <tbd>" - Read-only object support and read-only literals. - the current VM supports a per-object read-only bit and will fail to modify objects marked with this flag bit. - This affects assignments to inst vars, to indexed fields in at:put: primitives, attempts to become read-only - objects into non-read-only objects, and attempts to change the class of read-only objects. All such attempts - raise a ModificationForbidden error. The error may retry the modification once the object has been made - writable. The compiler has been modified to make all literals read-only." self error: 'comment only'! Item was added: + ----- Method: Object>>adaptToScaledDecimal:andSend: (in category 'converting') ----- + adaptToScaledDecimal: rcvr andSend: selector + "If no method has been provided for adapting an object to a ScaledDecimal, + then it may be adequate to simply adapt it to a number." + ^ self adaptToNumber: rcvr andSend: selector! Item was removed: - ----- Method: SqNumberParser class>>on: (in category 'instance creation') ----- - on: aStringOrStream - ^self new on: aStringOrStream! Item was removed: - ----- Method: SqNumberParser class>>parse: (in category 'instance creation') ----- - parse: aStringOrStream - ^(self new) - on: aStringOrStream; - nextNumber! Item was removed: - ----- Method: SqNumberParser class>>parse:onError: (in category 'instance creation') ----- - parse: aStringOrStream onError: failBlock - ^(self new) - on: aStringOrStream; - failBlock: failBlock; - nextNumber! Item was changed: ----- Method: SqNumberParser>>nextFraction (in category 'parsing-public') ----- nextFraction | numerator denominator numberOfTrailingZeroInIntegerPart | + base := self defaultBase. - base := 10. neg := self peekSignIsMinus. (integerPart := self nextUnsignedIntegerOrNilBase: base) ifNil: ["No integerPart, raise an error" ^ self expected: 'a digit']. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $r) ifTrue: ["<base>r<integer>" (base := integerPart) < 2 ifTrue: [ sourceStream skip: -1. ^ self expected: 'an integer greater than 1 as valid radix']. self peekSignIsMinus ifTrue: [neg := neg not]. integerPart := self nextUnsignedIntegerBase: base. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero]. (sourceStream peekFor: $.) ifTrue: [^self readFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart]. numerator := neg ifTrue: [integerPart negated] ifFalse: [integerPart]. self readExponent ifTrue: [numerator := numerator * (base raisedToInteger: exponent)]. (sourceStream peekFor: $/) ifFalse: [^numerator]. + base := self defaultBase. - base := 10. (denominator := self nextUnsignedIntegerOrNilBase: base) ifNil: [sourceStream skip: -1. "Not a valid denominator, ungobble / and return numerator" ^numerator]. (sourceStream peekFor: $r) ifTrue: ["<base>r<integer>" (base := denominator) < 2 ifTrue: [ sourceStream skip: -1. ^ self expected: 'an integer greater than 1 as valid radix']. denominator := self nextUnsignedIntegerBase: base]. self readExponent ifTrue: [denominator := denominator * (base raisedToInteger: exponent)]. ^numerator / denominator! Item was changed: ----- Method: SqNumberParser>>nextInteger (in category 'parsing-public') ----- nextInteger "Read an Integer from sourceStream, asnwser that Integer. In Smalltalk syntax, a radix can be specified, and an exponent too." | numberOfTrailingZeroInIntegerPart | + base := self defaultBase. - base := 10. neg := self peekSignIsMinus. integerPart := self nextUnsignedIntegerOrNilBase: base. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $r) ifTrue: ["<base>r<integer>" (base := integerPart) < 2 ifTrue: [ sourceStream skip: -1. ^ self expected: 'an integer greater than 1 as valid radix']. self peekSignIsMinus ifTrue: [neg := neg not]. integerPart := self nextUnsignedIntegerBase: base. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero]. ^ self makeIntegerOrScaledInteger! Item was changed: ----- Method: SqNumberParser>>nextNumber (in category 'parsing-public') ----- nextNumber "main method for reading a number. This one can read Float Integer and ScaledDecimal" | numberOfTrailingZeroInIntegerPart | + base := self defaultBase. - base := 10. neg := self peekSignIsMinus. integerPart := self nextUnsignedIntegerOrNilBase: base. integerPart ifNil: [ "This is not a regular number beginning with a digit It is time to check for exceptional condition NaN and Infinity" ^self readNamedFloatOrFail]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $r) ifTrue: ["<base>r<integer>" (base := integerPart) < 2 ifTrue: [ sourceStream skip: -1. ^ self expected: 'an integer greater than 1 as valid radix']. self peekSignIsMinus ifTrue: [neg := neg not]. integerPart := self nextUnsignedIntegerBase: base. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero]. ^ (sourceStream peekFor: $.) ifTrue: [self readNumberWithFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart] ifFalse: [self makeIntegerOrScaledInteger]! Item was changed: ----- Method: SqNumberParser>>nextScaledDecimal (in category 'parsing-public') ----- nextScaledDecimal "Main method for reading a (scaled) decimal number. Good Gracious, do not accept a decimal in another base than 10!! In other words, do not accept radix notation like 2r1.1, even not 10r5.3 Do not accept exponent notation neither, like 1.0e-3" | numberOfNonZeroFractionDigits numberOfTrailingZeroInFractionPart | + base := self defaultBase. - base := 10. neg := sourceStream peekFor: $-. integerPart := self nextUnsignedIntegerBase: base. (sourceStream peekFor: $.) ifTrue: [fractionPart := self nextUnsignedIntegerOrNilBase: base. fractionPart ifNil: ["Oops, the decimal point seems not part of this number" sourceStream skip: -1. ^ neg ifTrue: [integerPart negated asScaledDecimal: 0] ifFalse: [integerPart asScaledDecimal: 0]]. numberOfNonZeroFractionDigits := lastNonZero. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. (self readScaleWithDefaultNumberOfDigits: nDigits) ifFalse: ["No scale were provided. use number of digits after decimal point as scale" scale := nDigits]. ^self makeScaledDecimalWithNumberOfNonZeroFractionDigits: numberOfNonZeroFractionDigits andNumberOfTrailingZeroInFractionPart: numberOfTrailingZeroInFractionPart]. self readScaleWithDefaultNumberOfDigits: 0. neg ifTrue: [integerPart := integerPart negated]. ^integerPart asScaledDecimal: scale! Item was changed: ----- Method: SqNumberParser>>nextUnsignedInteger (in category 'parsing-public') ----- nextUnsignedInteger "Read an unsigned Integer from sourceStream, asnwser that Integer. In Smalltalk syntax, a radix can be specified, and an exponent too." + base := self defaultBase. - base := 10. neg := false. integerPart := self nextUnsignedIntegerOrNilBase: base. (sourceStream peekFor: $r) ifTrue: ["<base>r<integer>" (base := integerPart) < 2 ifTrue: [ sourceStream skip: -1. ^ self expected: 'an integer greater than 1 as valid radix']. integerPart := self nextUnsignedIntegerBase: base]. ^ self makeIntegerOrScaledInteger! Item was changed: ----- Method: SqNumberParser>>readScaleWithDefaultNumberOfDigits: (in category 'parsing-private') ----- readScaleWithDefaultNumberOfDigits: anInteger "Read the scale if any and store it into scale instance Variable. Answer true if found, answer false if none. The scale is specified by letter s, optionnally followed by a positive integer in base 10. If no integer is specified, that means using as many digits as provided after the fraction separator, as provided by parameter anInteger. A letter s followed by another letter is not considered as a scale specification, because it could be part of a message." scale := 0. sourceStream atEnd ifTrue: [ ^ false ]. (sourceStream peekFor: $s) ifFalse: [ ^ false ]. + scale := self nextUnsignedIntegerOrNilBase: self defaultBase. - scale := self nextUnsignedIntegerOrNilBase: 10. scale ifNil: [ scale := anInteger. (sourceStream peek ifNil: [ false ] ifNotNil: [ :nextChar | nextChar isLetter ]) ifTrue: [ sourceStream skip: -1. "ungobble the s" ^ false ] ifFalse: [ ^ true ] ]. ^ true!

1 0

Merge Request: hostWindowFocus.2.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 01 Dec '21

01 Dec '21

=============== Summary =============== Change Set: hostWindowFocus Date: 7 November 2021 Author: Christoph Thiede Proposal: When the host window loses the keyboard focus of the host system, remove the focus from the current focus holder morph in Squeak as well. This is done by initializing a temporary windowHostFocusMorph in the world which takes the keyboard focus while the host window is inactive and restores it afterward. Some more explanation of this feature: When you activate a different window than Squeak in your operating system, Squeak did not know as of today and still might indicate a keyboard focus for any text morph or similar in the image. I have experienced a lot of confusion by this incorrect display when I was assuming a particular Squeak window would still be focused, started to type something, but actually was typing into a different window! With this patch, this situation cannot occur any longer. This change won't become effective before opensmalltalk-vm#593 is merged which provides the #windowActivated and #windowDeactivated events to the image [1]; however, loading the patch into an older VM does not do any harm. On the event type #windowChangedScreen: This has already been implemented in the VM last year [2] but was forgotten to mention on the image side until now. [1] https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/593 [2] https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/0361fc33d5f72b153b… =============== Diff =============== HandMorph>>generateWindowEvent: {private events} · ct 9/7/2021 18:44 (changed) generateWindowEvent: evtBuf "Generate the appropriate window event for the given raw event buffer" | evt | evt := WindowEvent new. + evt setHand: self. evt setTimeStamp: evtBuf second. evt timeStamp = 0 ifTrue: [evt setTimeStamp: Sensor eventTimeNow]. evt action: evtBuf third. evt rectangle: (Rectangle origin: evtBuf fourth @ evtBuf fifth corner: evtBuf sixth @ evtBuf seventh ). ^evt PasteUpMorph>>windowEvent: {event handling} · ct 9/7/2021 19:20 (changed) windowEvent: anEvent self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent]. - anEvent type == #windowClose - ifTrue: [ - ^Preferences eToyFriendly - ifTrue: [ProjectNavigationMorph basicNew quitSqueak] - ifFalse: [TheWorldMenu basicNew quitSession]]. + anEvent type + caseOf: { + [#windowClose] -> [ + Preferences eToyFriendly + ifTrue: [ProjectNavigationMorph basicNew quitSqueak] + ifFalse: [TheWorldMenu basicNew quitSession]]. + + [#windowDeactivated] -> [ + "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus. If enabled, disable #mouseOverForKeyboardFocus temporarily because when inactive, we *can't* set the keyboard focus." + (self valueOfProperty: #windowHostFocusMorph ifAbsentPut: [ + Morph new + name: #windowHostFocusMorph; + yourself]) in: [:hostFocus | + hostFocus setProperty: #previousFocus toValue: anEvent hand keyboardFocus. + anEvent hand newKeyboardFocus: hostFocus. + Preferences mouseOverForKeyboardFocus ifTrue: [ + hostFocus setProperty: #previousMouseOverForKeyboardFocus toValue: true. + Preferences setPreference: #mouseOverForKeyboardFocus toValue: false]]]. + [#windowActivated] -> [ + "Alright, the spook is over! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder and the #mouseOverForKeyboardFocus preference." + self valueOfProperty: #windowHostFocusMorph ifPresentDo: [:hostFocus | + hostFocus abandon. + (hostFocus valueOfProperty: #previousFocus) ifNotNil: [:previousFocus | + anEvent hand newKeyboardFocus: previousFocus]. + (hostFocus valueOfProperty: #previousMouseOverForKeyboardFocus) ifNotNil: [:value | + Preferences setPreference: #mouseOverForKeyboardFocus toValue: value]. + self removeProperty: #windowHostFocusMorph]]. } + otherwise: [] WindowEvent>>type {accessing} · ct 9/7/2021 18:38 (changed) type "This should match the definitions in sq.h" ^#( windowMetricChange windowClose windowIconise windowActivated windowPaint + windowChangedScreen + windowDeactivated ) at: action ifAbsent: [#windowEventUnknown] --- Sent from Squeak Inbox Talk

2 1

The Trunk: Morphic-mt.1805.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1805.mcz ==================== Summary ==================== Name: Morphic-mt.1805 Author: mt Time: 1 December 2021, 3:54:09.720361 pm UUID: 6f406a88-dc84-ad41-ad2a-a27839816f28 Ancestors: Morphic-mt.1804 Adds support for #windowDeactivated event delivered by newer VMs. Thanks to Christoph (ct) for the idea and also implementation on the VM side! See: http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-November/216931… =============== Diff against Morphic-mt.1804 =============== Item was changed: ----- Method: HandMorph>>generateWindowEvent: (in category 'private events') ----- generateWindowEvent: evtBuf "Generate the appropriate window event for the given raw event buffer" | evt | evt := WindowEvent new. + evt setHand: self. evt setTimeStamp: evtBuf second. evt timeStamp = 0 ifTrue: [evt setTimeStamp: Sensor eventTimeNow]. evt action: evtBuf third. evt rectangle: (Rectangle origin: evtBuf fourth @ evtBuf fifth corner: evtBuf sixth @ evtBuf seventh ). ^evt! Item was changed: ----- Method: PasteUpMorph>>windowEvent: (in category 'event handling') ----- windowEvent: anEvent self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent]. + anEvent type + caseOf: { + [#windowClose] -> [ + Preferences eToyFriendly + ifTrue: [ProjectNavigationMorph basicNew quitSqueak] + ifFalse: [TheWorldMenu basicNew quitSession]]. + + [#windowDeactivated] -> [ + "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus. If enabled, disable #mouseOverForKeyboardFocus temporarily because when inactive, we *can't* set the keyboard focus." + (self valueOfProperty: #windowHostFocusMorph ifAbsentPut: [ + Morph new + name: #windowHostFocusMorph; + yourself]) in: [:hostFocus | + hostFocus setProperty: #previousFocus toValue: anEvent hand keyboardFocus. + anEvent hand newKeyboardFocus: hostFocus. + Preferences mouseOverForKeyboardFocus ifTrue: [ + hostFocus setProperty: #previousMouseOverForKeyboardFocus toValue: true. + Preferences setPreference: #mouseOverForKeyboardFocus toValue: false]]]. + [#windowActivated] -> [ + "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder and the #mouseOverForKeyboardFocus preference." + self valueOfProperty: #windowHostFocusMorph ifPresentDo: [:hostFocus | + hostFocus abandon. + (hostFocus valueOfProperty: #previousFocus) ifNotNil: [:previousFocus | + anEvent hand newKeyboardFocus: previousFocus]. + (hostFocus valueOfProperty: #previousMouseOverForKeyboardFocus) ifNotNil: [:value | + Preferences setPreference: #mouseOverForKeyboardFocus toValue: value]. + self removeProperty: #windowHostFocusMorph]]. } + otherwise: []! - anEvent type == #windowClose - ifTrue: [ - ^Preferences eToyFriendly - ifTrue: [ProjectNavigationMorph basicNew quitSqueak] - ifFalse: [TheWorldMenu basicNew quitSession]]. - ! Item was changed: ----- Method: WindowEvent>>type (in category 'accessing') ----- type "This should match the definitions in sq.h" ^#( windowMetricChange windowClose windowIconise windowActivated windowPaint + windowChangedScreen + windowDeactivated ) at: action ifAbsent: [#windowEventUnknown]!

1 0

The Trunk: Kernel-mt.1431.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1431.mcz ==================== Summary ==================== Name: Kernel-mt.1431 Author: mt Time: 1 December 2021, 3:03:26.688361 pm UUID: 8d2aa79a-524c-374e-92ca-e7a9b8e7988e Ancestors: Kernel-pre.1430 Complements 60Deprecated-mt.98 =============== Diff against Kernel-pre.1430 =============== Item was removed: - Notification subclass: #ExceptionAboutToReturn - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Kernel-Exceptions-Kernel'! - - !ExceptionAboutToReturn commentStamp: '<historical>' prior: 0! - This class is private to the EHS implementation. Its use allows for ensured execution to survive code such as: - - [self doThis. - ^nil] - ensure: [self doThat] - - Signaling or handling this exception is not recommended. Not even slightly.! Item was removed: - ArithmeticError subclass: #NaNError - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Kernel-Numbers-Exceptions'! - - !NaNError commentStamp: 'ar 12/14/2010 00:03' prior: 0! - NaNError is signaled by various operations that would either result in or operate on an NaN input.! Item was removed: - ----- Method: NaNError>>isResumable (in category 'testing') ----- - isResumable - "NaNError is always resumable" - ^true! Item was removed: - ----- Method: NaNError>>messageText (in category 'accessing') ----- - messageText - "Return an exception's message text." - - ^messageText ifNil:['This operation would result in NaN ']! Item was changed: + (PackageInfo named: 'Kernel') postscript: 'Smalltalk removeClassNamed: #ExceptionAboutToReturn.'! - (PackageInfo named: 'Kernel') postscript: 'DebuggerMethodMap voidMapCache. - Smalltalk garbageCollect. - HashedCollection rehashAll'!

2 1

Jump to page: