Squeak-dev February 2024

squeak-dev@lists.squeakfoundation.org

32 participants
107 discussions

The Trunk: System-cmm.1449.mcz
by commits＠source.squeak.org 27 Feb '24

27 Feb '24

Chris Muller uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-cmm.1449.mcz ==================== Summary ==================== Name: System-cmm.1449 Author: cmm Time: 26 February 2024, 9:30:48.069874 pm UUID: 36e12e44-7aca-4655-ab39-72363788d382 Ancestors: System-dtl.1448 Revert cmm.1447 because #cr is always what should be written in platform-independent Squeak code, and letting the particular FileStream handle the line-end conversion. =============== Diff against System-dtl.1448 =============== Item was changed: ----- Method: CodeLoader>>installSourceFile: (in category 'installing') ----- installSourceFile: aStream "Install the previously loaded source file" | contents trusted | aStream ifNil:[^self error:'No content to install']. trusted := SecurityManager default positionToSecureContentsOf: aStream. trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[ aStream close. ^ self error:'Insecure content encountered']]. contents := self allButShebangLine: aStream upToEnd unzipped asString. (aStream respondsTo: #close) ifTrue:[aStream close]. ^[contents readStream fileIn] on: SyntaxErrorNotification do: [ : err | Smalltalk isHeadless ifTrue: + [FileStream stdout nextPutAll: err errorCode; cr; flush. - [FileStream stdout nextPutAll: err errorCode; lf; flush. Smalltalk snapshot: false andQuit: true ] ifFalse: [err pass] ]! Item was changed: ----- Method: Exception>>printVerboseOn: (in category '*system') ----- printVerboseOn: aStream aStream nextPutAll: 'vvvvvvvvvvvvvvvvvv ' , self description , ' vvvvvvvvvvvvvvvvvv' ; + cr ; - lf ; nextPutAll: 'The time is ', DateAndTime now asString ; + cr. - lf. "Allow applications to optionally print extra details without overriding a base package." self printDetailsOn: aStream. aStream nextPutAll: self signalerContext longStack ; + cr ; - lf ; nextPutAll: '^^^^^^^^^^^^^^^^^^ ' , self description , ' ^^^^^^^^^^^^^^^^^^' ; + cr ; - lf ; flush! Item was changed: ----- Method: Preferences class>>debugLogTimestamp (in category 'standard queries') ----- debugLogTimestamp ^ self valueOfFlag: #debugLogTimestamp + ifAbsent: [ false ]! - ifAbsent: [false]! Item was changed: ----- Method: SmalltalkImage>>run: (in category 'command line') ----- run: aBlock [ [ self patchSystem. (aBlock numArgs = 1 and: [ self arguments size > 1 ]) ifTrue: [ "Allow a large, variable number of arguments to be passed as an Array to aBlock." aBlock value: self arguments ] ifFalse: [ aBlock valueWithEnoughArguments: self arguments ] ] on: SyntaxErrorNotification do: [ : err | FileStream stdout nextPutAll: err errorCode ; + cr; flush. - lf; flush. self isHeadless ifTrue: [ self snapshot: false andQuit: true ] ifFalse: [ err pass ] ] on: Error , ProvideAnswerNotification do: [ : err | err printVerboseOn: FileStream stderr. FileStream stderr flush. self isHeadless ifTrue: [ self snapshot: false andQuit: true ] ifFalse: [ err pass ] ] on: ProgressInitiationException do: [ : pie | "Don't want to log this Notification." pie defaultAction ] ] on: Notification , Warning do: [ : noti | FileStream stdout nextPutAll: DateAndTime now asString ; space ; nextPutAll: noti description ; + cr. - lf. noti resume ] !

1 0

The Trunk: Collections-cmm.1059.mcz
by commits＠source.squeak.org 27 Feb '24

27 Feb '24

Chris Muller uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-cmm.1059.mcz ==================== Summary ==================== Name: Collections-cmm.1059 Author: cmm Time: 18 February 2024, 5:19:05.159381 pm UUID: 982eb6aa-f237-4e79-a208-ae6b2f23cf1b Ancestors: Collections-mt.1058 - Let #peek: support a negative number of characters to peekBack:. - Let SharedQueue2 support #atEnd. =============== Diff against Collections-mt.1058 =============== Item was changed: ----- Method: PositionableStream>>peek: (in category 'accessing') ----- + peek: anInteger + ^ anInteger positive + ifTrue: [ self peekForward: anInteger ] + ifFalse: [ self peekBack: anInteger abs ]! - peek: anInteger - "Answer what would be returned if the message next: anInteger were sent to the receiver. If the receiver has less than anInteger more elements, only answer so many elements as available." - - | oldPosition result | - oldPosition := position. - result := self next: anInteger. - position := oldPosition. - ^ result! Item was added: + ----- Method: PositionableStream>>peekBack: (in category 'accessing') ----- + peekBack: anInteger + "Answer anInteger characters previous to the current position, or all to the beginning, whichever is fewer." + ^ anInteger negative + ifTrue: [ self peek: anInteger negated ] + ifFalse: + [ | toSkip | toSkip := anInteger min: self position. + self + skip: toSkip negated ; + next: toSkip ]! Item was added: + ----- Method: PositionableStream>>peekForward: (in category 'accessing') ----- + peekForward: anInteger + "Answer what would be returned if the message next: anInteger were sent to the receiver. If the receiver is at the end, answer an empty string." + | priorPos result | + priorPos := position. + result := self next: anInteger. + position := priorPos. + ^ result! Item was added: + ----- Method: SharedQueue2>>atEnd (in category 'testing') ----- + atEnd + ^ monitor critical: [ items isEmpty ]!

3 4

The Trunk: Tools-ct.1246.mcz
by commits＠source.squeak.org 27 Feb '24

27 Feb '24

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1246.mcz ==================== Summary ==================== Name: Tools-ct.1246 Author: ct Time: 26 February 2024, 4:00:04.757882 pm UUID: fbc966c6-6300-9846-be17-593f1a2530d6 Ancestors: Tools-ct.1245 Fixes slip from Tools-ct.1245. =============== Diff against Tools-ct.1245 =============== Item was changed: ----- Method: Debugger>>contents:notifying: (in category 'accessing') ----- contents: aText notifying: aController "Accept new method source of the selected context." | selector classOfMethod category ctxt newMethod | contextStackIndex = 0 ifTrue: [^ false]. "First, handle some edge cases" selector := self selectedClass newParser parseSelector: aText. "selector isDoIt ifTrue: [ currentCompiledMethod := self compileDoIt: aText]." self flag: #todo. "ct: Recompile doIt method *without* creating method litters!! See Compiler>>#evaluateCue:ifFail:." selector = self selectedMessageName ifFalse: [ "Different message compiled, delegating to super" ^ super contents: aText notifying: aController]. self selectedContext isExecutingBlock ifTrue: [ "If we are in a block context, we need to rewind the stack before ." | home | home := self selectedContext activeHome. home ifNil: [ (self confirm: 'Method for block not found on stack, can''t edit and continue. Update method anyway?' translated) ifFalse: [ ^ false]. ^ (super contents: aText notifying: aController) ifTrue: [ contents := nil. self contentsChanged. self inform: 'Method was updated, but cannot revert the stack to it.' translated]; yourself]. (self confirm: 'I will have to revert to the method from\which this block originated. Is that OK?' translated withCRs) ifFalse: [ ^ false]. self resetContext: home changeContents: false. "N.B. Only reset the contents if the compilation succeeds. If contents would be reset when compilation fails, both compiler error message and modifications were lost." ^ (self contents: aText notifying: aController) ifTrue: [self contentsChanged]; yourself]. classOfMethod := self selectedClass. category := self selectedMessageCategoryName. "Do the actual compilation" selector := classOfMethod compile: aText classified: category notifying: aController. selector ifNil: [^ false]. "compilation cancelled" "Update views" contents := aText. newMethod := classOfMethod compiledMethodAt: selector. newMethod isQuick ifTrue: [ self cutBackExecutionToSenderContext]. ctxt := interruptedProcess popTo: self selectedContext. ctxt == self selectedContext ifFalse: [self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' translated withCRs] ifTrue: [ newMethod isQuick ifFalse: [ + interruptedProcess restartTopWith: newMethod. - ctxt := interruptedProcess restartTopWith: newMethod. ctxt := interruptedProcess stepToSendOrReturn]. contextVariablesInspector object: nil]. self resetContext: ctxt. Project current addDeferredUIMessage: [ self changed: #contentsSelection]. ^ true!

3 3

The Trunk: KernelTests-ct.454.mcz
by commits＠source.squeak.org 26 Feb '24

26 Feb '24

Christoph Thiede uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-ct.454.mcz ==================== Summary ==================== Name: KernelTests-ct.454 Author: ct Time: 26 February 2024, 5:53:27.913882 pm UUID: 0c12327f-5f0d-454e-bffd-88918727238c Ancestors: KernelTests-ct.453 Fixes slips from KernelTests-ct.453: * Correct tear-down of temporary methods * Speed up ContextTest>>simulate: (avoid dependency on primitiveSuspendBackingUpV2) =============== Diff against KernelTests-ct.453 =============== Item was changed: ----- Method: ContextTest>>simulate: (in category 'private') ----- simulate: aBlock + | results | + [results := {aBlock value}] newProcess runUntil: [:ctxt | results notNil]. + ^ results first! - | result | - [result := aBlock value] newProcess runUntil: [:ctxt | false]. - ^ result! Item was changed: ----- Method: ContextTest>>testPrimitive83 (in category 'tests - simulation') ----- testPrimitive83 "Test simulation of primitive 83." self flag: #bug. "Known bug: Primitive 83 SPORADICALLY does NOT fail in the OSVM for missing argument!!" { [nil perform: #isNil]. "valid 0-arg message" [nil perform: #= with: true]. "valid unary message" [nil perform: #ifNil:ifNotNil: with: [2] with: [:x | x]]. "valid binary message" [nil perform: #isNil with: 'excess arg']. "too many arguments" [nil perform: #=]. "missing argument" [nil perform: Object]. "invalid selector" [[(self class addSelector: #plonk:with: withMethod: (TestObjectForMethod new xxxMethod: thisContext homeMethod); perform: #plonk:with: with: 2 with: 3) allButFirst "OaM selector is undefined behavior"] + ensure: [self class removeSelector: #plonk:with:]]. - ensure: [self class removeSelector: #plonk]]. } do: [:block | self assert: (block on: Error do: [:ex | ex description]) equals: (Context runSimulated: [block on: Error do: [:ex | ex description]])].! Item was changed: ----- Method: ContextTest>>testPrimitive84 (in category 'tests - simulation') ----- testPrimitive84 "Test simulation of primitive 84." { {#isNil. {}}. "valid 0-arg message" {#=. {true}}. "valid unary message" {#ifNil:ifNotNil:. {[2]. [:x | x]}}. "valid binary message" {#isNil. 'not an array'}. "invalid arguments" {#isNil. {'excess arg'}}. "too many arguments" {#=. {}}. "missing argument" {Object. {}}. "invalid selector" {#in:. {[:it | [(self class addSelector: #plonk:with: withMethod: (TestObjectForMethod new xxxMethod: thisContext homeMethod); perform: #plonk:with: withArguments: #(2 3)) allButFirst "OaM selector is undefined behavior"] + ensure: [self class removeSelector: #plonk:with:]]}}. - ensure: [self class removeSelector: #plonk]]}}. } do: [:args | self assert: ([nil perform: args first withArguments: args second] on: Error do: [:ex | ex description]) equals: (Context runSimulated: [[nil perform: args first withArguments: args second] on: Error do: [:ex | ex description]])].!

1 0

The Trunk: System-cmm.1447.mcz
by commits＠source.squeak.org 26 Feb '24

26 Feb '24

Chris Muller uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-cmm.1447.mcz ==================== Summary ==================== Name: System-cmm.1447 Author: cmm Time: 12 February 2024, 3:06:16.671515 pm UUID: 03b7d234-da01-4b78-94c0-f78c01d4afe0 Ancestors: System-codefrau.1446 FileStream's stdout and stderr are for Linux, so use Linux line-endings when writing to them. =============== Diff against System-codefrau.1446 =============== Item was changed: ----- Method: CodeLoader>>installSourceFile: (in category 'installing') ----- installSourceFile: aStream "Install the previously loaded source file" | contents trusted | aStream ifNil:[^self error:'No content to install']. trusted := SecurityManager default positionToSecureContentsOf: aStream. trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[ aStream close. ^ self error:'Insecure content encountered']]. contents := self allButShebangLine: aStream upToEnd unzipped asString. (aStream respondsTo: #close) ifTrue:[aStream close]. ^[contents readStream fileIn] on: SyntaxErrorNotification do: [ : err | Smalltalk isHeadless ifTrue: + [FileStream stdout nextPutAll: err errorCode; lf; flush. - [FileStream stdout nextPutAll: err errorCode; cr; flush. Smalltalk snapshot: false andQuit: true ] ifFalse: [err pass] ]! Item was changed: ----- Method: Exception>>printVerboseOn: (in category '*system') ----- printVerboseOn: aStream aStream nextPutAll: 'vvvvvvvvvvvvvvvvvv ' , self description , ' vvvvvvvvvvvvvvvvvv' ; + lf ; - cr ; nextPutAll: 'The time is ', DateAndTime now asString ; + lf. - cr. "Allow applications to optionally print extra details without overriding a base package." self printDetailsOn: aStream. aStream nextPutAll: self signalerContext longStack ; + lf ; - cr ; nextPutAll: '^^^^^^^^^^^^^^^^^^ ' , self description , ' ^^^^^^^^^^^^^^^^^^' ; + lf ; - cr ; flush! Item was changed: ----- Method: SmalltalkImage>>run: (in category 'command line') ----- run: aBlock [ [ self patchSystem. (aBlock numArgs = 1 and: [ self arguments size > 1 ]) ifTrue: [ "Allow a large, variable number of arguments to be passed as an Array to aBlock." aBlock value: self arguments ] ifFalse: [ aBlock valueWithEnoughArguments: self arguments ] ] on: SyntaxErrorNotification do: [ : err | FileStream stdout nextPutAll: err errorCode ; + lf; flush. - cr; flush. self isHeadless ifTrue: [ self snapshot: false andQuit: true ] ifFalse: [ err pass ] ] on: Error , ProvideAnswerNotification do: [ : err | err printVerboseOn: FileStream stderr. FileStream stderr flush. self isHeadless ifTrue: [ self snapshot: false andQuit: true ] ifFalse: [ err pass ] ] on: ProgressInitiationException do: [ : pie | "Don't want to log this Notification." pie defaultAction ] ] on: Notification , Warning do: [ : noti | FileStream stdout nextPutAll: DateAndTime now asString ; space ; nextPutAll: noti description ; + lf. - cr. noti resume ] !

4 4

The Trunk: Kernel-ct.1553.mcz
by commits＠source.squeak.org 26 Feb '24

26 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1553.mcz ==================== Summary ==================== Name: Kernel-ct.1553 Author: ct Time: 24 February 2024, 8:42:15.180459 pm UUID: bfcd6789-4af9-cc41-8278-5a27709723d5 Ancestors: Kernel-mt.1551, Kernel-ct.1293 Merges and revises Kernel-ct.1293: Elaborate method comment in Object >> #copyFrom: See: https://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfou… =============== Diff against Kernel-mt.1551 =============== Item was changed: ----- Method: CompiledCode>>copyFrom: (in category 'copying') ----- copyFrom: anotherObject + "Copy to myself all slots I have in common with anotherObject, i.e., all variables names which have the same index in both classes and all element indices which are available in both classes. + This is dangerous because it ignores an object's control over its own inst vars." - "Copy to myself all instance variables I have in common with anotherObject. - This is dangerous because it ignores an object's control over its own inst vars." <primitive: 168> anotherObject isCompiledCode ifTrue: [1 to: self numLiterals do: [:i| self literalAt: i put: (anotherObject literalAt: i)]] ifFalse: [1 to: self numLiterals do: [:i| self literalAt: i put: (anotherObject at: i)]]. self initialPC to: (self basicSize min: anotherObject basicSize) do: [:i| self basicAt: i put: (anotherObject basicAt: i)]! Item was changed: ----- Method: Object>>copyFrom: (in category 'copying') ----- copyFrom: anotherObject + "Copy to myself all slots I have in common with anotherObject, i.e., all variables names which have the same index in both classes and all element indices which are available in both classes. + This is dangerous because it ignores an object's control over its own inst vars." - "Copy to myself all instance variables I have in common with anotherObject. This is dangerous because it ignores an object's control over its own inst vars. " | mine his | <primitive: 168> mine := self class allInstVarNames. his := anotherObject class allInstVarNames. 1 to: (mine size min: his size) do: [:ind | (mine at: ind) = (his at: ind) ifTrue: [ self instVarAt: ind put: (anotherObject instVarAt: ind)]]. self class isVariable & anotherObject class isVariable ifTrue: [ 1 to: (self basicSize min: anotherObject basicSize) do: [:ind | self basicAt: ind put: (anotherObject basicAt: ind)]].! Item was changed: ----- Method: Object>>copySameFrom: (in category 'copying') ----- copySameFrom: otherObject "Copy to myself all instance variables named the same in otherObject. + This is dangerous because it ignores an object's control over its own inst vars." - This ignores otherObject's control over its own inst vars." | myInstVars otherInstVars | myInstVars := self class allInstVarNames. otherInstVars := otherObject class allInstVarNames. myInstVars withIndexDo: [:each :index | | match | (match := otherInstVars indexOf: each) > 0 ifTrue: [self instVarAt: index put: (otherObject instVarAt: match)]]. 1 to: (self basicSize min: otherObject basicSize) do: [:i | self basicAt: i put: (otherObject basicAt: i)]. !

2 1

The Trunk: KernelTests-ct.448.mcz
by commits＠source.squeak.org 26 Feb '24

26 Feb '24

Christoph Thiede uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-ct.448.mcz ==================== Summary ==================== Name: KernelTests-ct.448 Author: ct Time: 30 December 2023, 8:52:58.484665 pm UUID: 01009ca0-df8f-7245-9e58-56846dcbbd70 Ancestors: KernelTests-jar.447 Complements Kernel-ct.1546 (fixes stepping through #mustBeBoolean errors and restarting from primitive methods that no longer fail). =============== Diff against KernelTests-jar.447 =============== Item was added: + ----- Method: ContextTest>>testRestartCallPrimitive (in category 'tests') ----- + testRestartCallPrimitive + + | array context start | + array := Array new: 0. + context := [[array at: 1] value] asContext. + [context selector = #at:] whileFalse: [context := context step]. + start := context sender. + + array become: (Array with: 42). + context privRefresh. + context := context stepToSendOrReturn. + + self assert: start equals: context. + self assert: context willReturn. + self assert: 42 equals: context top.!

1 0

The Trunk: KernelTests-ct.421.mcz
by commits＠source.squeak.org 26 Feb '24

26 Feb '24

Christoph Thiede uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-ct.421.mcz ==================== Summary ==================== Name: KernelTests-ct.421 Author: ct Time: 12 March 2022, 1:39:59.553359 am UUID: 3916242e-4ff0-0541-9da6-e876e740d0ad Ancestors: KernelTests-ct.420 Tests handling of objects as methods (OaM) during simulation of Object>>#withArgs:executeMethod: and Object>>#with:...executeMethod:. =============== Diff against KernelTests-ct.419 =============== Item was added: + ----- Method: ContextTest>>testPrimitive188 (in category 'tests') ----- + testPrimitive188 + + self testPrimitive188: [:receiver :args :compiledMethod | + receiver withArgs: args executeMethod: compiledMethod]. + + self testPrimitive188: [:receiver :args :compiledMethod | + CompiledMethod receiver: receiver withArguments: args executeMethod: compiledMethod].! Item was added: + ----- Method: ContextTest>>testPrimitive188: (in category 'tests') ----- + testPrimitive188: primitiveBlock + + | block | + { + {2. {}. SmallInteger >> #even}. "valid 0-arg message" + {2. {1}. Integer >> #<<}. "valid unary message" + {2. {3. 4}. Integer >> #raisedTo:modulo:}. "valid binary message" + {2. 'not an array'. Integer >> #<<}. "invalid arguments" + {2. {'excess arg'}. SmallInteger >> #even}. "too many arguments" + {2. {}. Integer >> #<<}. "missing argument" + {2. {1}. 'not a method'}. "invalid method" + {block := [(primitiveBlock valueWithArguments: {2. {3. 4}. TestObjectForMethod new xxxMethod: thisContext homeMethod}) + allButFirst "OaM selector is undefined behavior"]. {}. block class lookupSelector: #value} "object as method" + } do: [:args | + self + assert: ([primitiveBlock valueWithArguments: args] on: Error do: [:ex | ex messageText]) + equals: (Context runSimulated: [[primitiveBlock valueWithArguments: args] on: Error do: [:ex | ex messageText]])].! Item was added: + ----- Method: ContextTest>>testPrimitive189 (in category 'tests') ----- + testPrimitive189 + + { + [2 executeMethod: SmallInteger >> #even]. "valid 0-arg message" + [2 with: 1 executeMethod: Integer >> #<<]. "valid unary message" + [2 with: 3 with: 4 executeMethod: Integer >> #raisedTo:modulo:]. "valid binary message" + [2 with: 1 executeMethod: Integer >> #even]. "too many arguments" + [2 executeMethod: Integer >> #<<]. "missing argument" + [2 with: 1 executeMethod: 'not a method']. "invalid method" + [(2 with: 3 with: 4 executeMethod: (TestObjectForMethod new xxxMethod: thisContext homeMethod)) + allButFirst "OaM selector is undefined behavior"] "object as method" + } do: [:block | + self + assert: (block on: Error do: [:ex | ex messageText]) + equals: (Context runSimulated: [block on: Error do: [:ex | ex messageText]])].!

1 0

The Trunk: KernelTests-ct.417.mcz
by commits＠source.squeak.org 26 Feb '24

26 Feb '24

Christoph Thiede uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-ct.417.mcz ==================== Summary ==================== Name: KernelTests-ct.417 Author: ct Time: 29 December 2021, 6:16:09.754165 pm UUID: 3f9894ac-a774-b44d-85bf-0846ac062cb2 Ancestors: KernelTests-ct.416 Acceptance tests for #runUntilErrorOrReturnFrom:. Given the complexity of the underlying method, I would like to gently request a short feedback from the author (Eliot) whether all assumptions in these tests are correct. :-) =============== Diff against KernelTests-ct.416 =============== Item was added: + ----- Method: ContextTest>>testRunUntilErrorOrReturnFromError (in category 'tests') ----- + testRunUntilErrorOrReturnFromError + + | context process result sender error | + process := [self error] newProcess. + process runUntil: [:ctxt | ctxt receiver == self]. + context := process suspendedContext. + sender := context sender. + + result := context runUntilErrorOrReturnFrom: context. + context := result first. + error := result second. + + self assert: (context hasSender: sender). + self assert: (Error handles: error).! Item was added: + ----- Method: ContextTest>>testRunUntilErrorOrReturnFromNoError (in category 'tests') ----- + testRunUntilErrorOrReturnFromNoError + + | context process result sender error | + process := [6 * 7] newProcess. + process runUntil: [:ctxt | ctxt receiver == self]. + context := process suspendedContext. + sender := context sender. + + result := context runUntilErrorOrReturnFrom: context. + context := result first. + error := result second. + + self assert: sender equals: context. + self assert: nil equals: error. + self assert: 42 equals: context top.!

1 0

The Trunk: Kernel-ct.1556.mcz
by commits＠source.squeak.org 26 Feb '24

26 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1556.mcz ==================== Summary ==================== Name: Kernel-ct.1556 Author: ct Time: 25 February 2024, 8:26:48.901593 pm UUID: 929047e6-a708-3540-97c5-aec212d87203 Ancestors: Kernel-ct.1555, Kernel-ct.1420, Kernel-ct.1451, Kernel-ct.1449, Kernel-ct.1490, Kernel-ct.1546, Kernel-ct.1547, Kernel-ct.1548 Merges several simulation fixes from the inbox. As always, please refer to the original versions to read their full messages. Kernel-ct.1420: Aligns the error code for primitive 118 (primitiveDoPrimitiveWithArgs) during simulation with what the VM returns. Kernel-ct.1451: Revises fallback code for primitive 188 (primitiveExecuteMethodArgsArray) in Object>>#withArgs:executeMethod: to eliminate any side effects to the method dictionary and add support for Objects as Methods. Kernel-ct.1449: Fixes arity checks for objects as methods in simulation of primitive 83 (primitivePerform) and primitive 84 (primitivePerformWithArgs). Kernel-ct.1490: In code simulation of perform primitives (primitive 83 (primitivePerform) and primitive 84 (primitivePerformWithArgs)), do not check numArgs of the selector or method to align behavior with VM. Revision: Remove the same check from simulation of primitive 100 (primitivePerformInSuperclass) as well. Kernel-ct.1546: In the debugger/simulator, fixes stepping through #mustBeBoolean errors and restarting from primitive methods that no longer fail. Kernel-ct.1547: When simulating #mustBeBoolean errors, send #mustBeBoolean instead of #mustBeBooleanIn: just like the VM. Kernel-ct.1548: Resolves #mustBeBoolean errors for copies or proxies of true and false. Revision: Improve documentation. =============== Diff against Kernel-ct.1555 =============== 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']. - (selector isSymbol and: [arguments size - 1 ~= selector numArgs]) ifTrue: - [^ 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']. - (selector isSymbol and: [args size ~= selector numArgs]) ifTrue: - [^ 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 number of arguments']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. - (selector isSymbol and: [args size ~= selector numArgs]) ifTrue: - [^ 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 or: [primitiveIndex = 189]) ifTrue: - - primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: - CompiledMethod class>>receiver:withArguments:executeMethod: - VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | + primitiveIndex caseOf: + {[188 "primitiveExecuteMethodArgsArray"] -> + ["Object>>withArgs:executeMethod: + CompiledMethod class>>receiver:withArguments:executeMethod: + VMMirror>>ifFail:object:with:executeMethod: et al" + ((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']. + thisReceiver := arguments at: n - 2 ifAbsent: [receiver]]. + [189 "primitiveExecuteMethod"] -> + ["Object>>executeMethod: + Object>>with:...executeMethod:" + (arguments size > 0) ifFalse: + [^self class primitiveFailTokenFor: #'bad argument']. + ((self objectClass: (methodArg := arguments atLast: 1)) includesBehavior: CompiledMethod) ifFalse: + [^self class primitiveFailTokenFor: #'bad argument']. + args := arguments allButLast. + thisReceiver := receiver]}. - ((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: methodArg receiver: thisReceiver args: args]. ^self activateMethod: methodArg withArgs: args receiver: thisReceiver]. 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: -3]. - [^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 added: + ----- Method: Context>>executeMethod:forSelector:withArgs:receiver: (in category 'controlling') ----- + executeMethod: meth forSelector: selector withArgs: arguments receiver: rcvr + + | primIndex val ctxt | + (self objectClass: meth) isCompiledCodeClass 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 class primitiveFailTokenFor: #'bad number of arguments']. + (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. + (primIndex isInteger and: [primIndex > 0]) ifTrue: + [ctxt failPrimitiveWith: val]. + + ^ctxt! Item was changed: ----- Method: Context>>jump:if: (in category 'instruction decoding') ----- jump: distance if: condition "Simulate the action of a 'conditional jump' bytecode whose offset is the argument, distance, and whose condition is the argument, condition." | bool | bool := self pop. condition == bool ifTrue: [self jump: distance] ifFalse: [(true == bool or: [false == bool]) ifFalse: + [^self send: #mustBeBoolean to: bool with: #()]]! - [^self send: #mustBeBooleanIn: to: bool with: {self}]]! 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 | - | 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]. + ^ self + executeMethod: meth + forSelector: selector + withArgs: arguments + receiver: rcvr! - (self objectClass: meth) isCompiledCodeClass 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. - (primIndex isInteger and: [primIndex > 0]) ifTrue: - [ctxt failPrimitiveWith: val]. - - ^ctxt! Item was changed: ----- Method: Context>>stepToSendOrReturn (in category 'system simulation') ----- stepToSendOrReturn "Simulate the execution of bytecodes until either sending a message or returning a value to the receiver (that is, until switching contexts)." | ctxt | [self willReallySend or: [self willReturn or: [self willReallyStore]]] whileFalse: [ctxt := self step. ctxt == self ifFalse: + ["Caused by mustBeBoolean handling or callPrimitive:" + ^ctxt stepToSendOrReturn]]! - [self halt. - "Caused by mustBeBoolean handling" - ^ctxt]]! Item was added: + ----- Method: False>>mustBeBooleanIn: (in category 'converting') ----- + mustBeBooleanIn: aContext + "Overwritten to support conditional jumps (ifTrue:/ifFalse:) based on a proxy to true/false. The jump will first fail, send #mustBeBoolean to the proxy, which will forward hither. Here, we correct the context by replacing the proxy on the stack through the canonical instance of ourselves and reattempting the jump. See ObjectTracer>>mustBeBoolean for an example." + + aContext skipBackBeforeJump. + ^ false! Item was changed: ----- Method: Object>>withArgs:executeMethod: (in category 'message handling') ----- withArgs: argArray executeMethod: compiledMethod "Execute compiledMethod against the receiver and args in argArray" + | context | - | selector | <primitive: 188> + context := thisContext + executeMethod: compiledMethod + forSelector: Symbol new + withArgs: argArray + receiver: self. + ^ context == thisContext + ifTrue: ["quick return" thisContext top] + ifFalse: [context jump]! - selector := Symbol new. - self class addSelectorSilently: selector withMethod: compiledMethod. - ^ [self perform: selector withArguments: argArray] - ensure: [self class basicRemoveSelector: selector]! Item was added: + ----- Method: ObjectTracer>>mustBeBoolean (in category 'very few messages') ----- + mustBeBoolean + "Overwritten to preserve original sender context. + + This is required to support conditional jumps (ifTrue:/ifFalse:) based on traced booleans, e.g.: + (ObjectTracer on: false) ifTrue: [1] ifFalse: [2]." + + ^ self mustBeBooleanIn: thisContext sender! Item was added: + ----- Method: True>>mustBeBooleanIn: (in category 'converting') ----- + mustBeBooleanIn: aContext + "Overwritten to support conditional jumps (ifTrue:/ifFalse:) based on a proxy to true/false. The jump will first fail, send #mustBeBoolean to the proxy, which will forward hither. Here, we correct the context by replacing the proxy on the stack through the canonical instance of ourselves and reattempting the jump. See ObjectTracer>>mustBeBoolean for an example." + + aContext skipBackBeforeJump. + ^ true!

2 1