Packages July 2018

packages@lists.squeakfoundation.org

1 participants
49 discussions

The Trunk: MorphicExtras-kfr.244.mcz
by commits＠source.squeak.org 30 Jul '18

30 Jul '18

Karl Ramberg uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-kfr.244.mcz ==================== Summary ==================== Name: MorphicExtras-kfr.244 Author: kfr Time: 30 July 2018, 2:10:56.401513 pm UUID: 21ecf44a-b9fa-c741-85ea-948612c0e4df Ancestors: MorphicExtras-pre.243 Fix a MouseEvent>>cursorPoint: DNU =============== Diff against MorphicExtras-pre.243 =============== Item was changed: ----- Method: PianoRollNoteMorph>>mouseMove: (in category 'event handling') ----- mouseMove: evt | delta offsetEvt | editMode isNil ifTrue: ["First movement determines edit mode" ((delta := evt cursorPoint - hitLoc) dist: 0 @ 0) <= 2 ifTrue: [^self "No significant movement yet."]. delta x abs > delta y abs ifTrue: [delta x > 0 ifTrue: ["Horizontal drag" editMode := #selectNotes] ifFalse: [self playSound: nil. + offsetEvt := evt copy translateBy:(20 @ 0). - offsetEvt := evt copy cursorPoint: evt cursorPoint + (20 @ 0). self invokeNoteMenu: offsetEvt]] ifFalse: [editMode := #editPitch "Vertical drag"]]. editMode == #editPitch ifTrue: [self editPitch: evt]. editMode == #selectNotes ifTrue: [self selectNotes: evt]!

1 0

The Trunk: TraitsTests-ul.18.mcz
by commits＠source.squeak.org 28 Jul '18

28 Jul '18

Levente Uzonyi uploaded a new version of TraitsTests to project The Trunk: http://source.squeak.org/trunk/TraitsTests-ul.18.mcz ==================== Summary ==================== Name: TraitsTests-ul.18 Author: ul Time: 28 July 2018, 10:28:35.332678 pm UUID: ed0b1a90-e8a4-4c2c-98a0-1af69fed6d74 Ancestors: TraitsTests-ul.17 - do not ask the user about author initials =============== Diff against TraitsTests-ul.17 =============== Item was changed: ----- Method: TraitFileOutTest>>setUp (in category 'running') ----- setUp + super setUp. + Utilities + useAuthorInitials: self className + during: [ + SystemOrganization addCategory: self categoryName. - SystemOrganization addCategory: self categoryName. + td := self createTraitNamed: #TD uses: {}. + td compile: 'd' classified: #cat1. + tc := self createTraitNamed: #TC uses: td. + tc compile: 'c' classified: #cat1. + tb := self createTraitNamed: #TB uses: td. + tb compile: 'b' classified: #cat1. + ta := self createTraitNamed: #TA uses: tb + ((tc @ {#cc->#c}) - {#c}). + ta compile: 'a' classified: #cat1. - td := self createTraitNamed: #TD uses: {}. - td compile: 'd' classified: #cat1. - tc := self createTraitNamed: #TC uses: td. - tc compile: 'c' classified: #cat1. - tb := self createTraitNamed: #TB uses: td. - tb compile: 'b' classified: #cat1. - ta := self createTraitNamed: #TA uses: tb + ((tc @ {#cc->#c}) - {#c}). - ta compile: 'a' classified: #cat1. + ca := self createClassNamed: #CA superclass: Object uses: {}. + ca compile: 'ca' classified: #cat1. + cb := self createClassNamed: #CB superclass: ca uses: ta. + cb compile: 'cb' classified: #cat1. - ca := self createClassNamed: #CA superclass: Object uses: {}. - ca compile: 'ca' classified: #cat1. - cb := self createClassNamed: #CB superclass: ca uses: ta. - cb compile: 'cb' classified: #cat1. + "make the class of cb also use tc:" + cb class uses: ta classTrait + tc instanceVariableNames: '' ]! - "make the class of cb also use tc:" - cb class uses: ta classTrait + tc instanceVariableNames: ''.! Item was changed: + ----- Method: TraitsResource>>setUp (in category 'running') ----- - ----- Method: TraitsResource>>setUp (in category 'as yet unclassified') ----- setUp "Please note, that most tests rely on this setup of traits and classes - and that especially the order of the definitions matters." "SetUpCount := SetUpCount + 1." dirty := false. + Utilities + useAuthorInitials: self className + during: [ + SystemChangeNotifier uniqueInstance doSilently: [ + self t1: (self createTraitNamed: #T1 uses: { }). + self t1 comment: 'I am the trait T1'. + self t2: (self createTraitNamed: #T2 uses: { }). + self t2 compile: 'm21 ^21' classified: #cat1. + self t2 compile: 'm22 ^22' classified: #cat2. + self t2 classSide compile: 'm2ClassSide: a ^a'. + self t3: (self createTraitNamed: #T3 uses: { }). + self t3 compile: 'm31 ^31' classified: #cat1. + self t3 compile: 'm32 ^32' classified: #cat2. + self t3 compile: 'm33 ^33' classified: #cat3. + self t4: (self createTraitNamed: #T4 uses: { (self t1). (self t2) }). + self t4 compile: 'm11 ^41' classified: #catX. "overrides T1>>m11" + self t4 compile: 'm42 ^42' classified: #cat2. + self t5: (self createTraitNamed: #T5 uses: self t1 + self t2). + self t5 compile: 'm51 ^super foo' classified: #cat1. + self t5 compile: 'm52 ^ self class bar' classified: #cat1. + self t5 compile: 'm53 ^ self class bar' classified: #cat1. + self t6: (self + createTraitNamed: #T6 + uses: (self t1 + (self t2 @ { (#m22Alias -> #m22) }))). + self c1: ( + self - SystemChangeNotifier uniqueInstance doSilently: - [self t1: (self createTraitNamed: #T1 - uses: { }). - self t1 comment: 'I am the trait T1'. - self t2: (self createTraitNamed: #T2 - uses: { }). - self t2 compile: 'm21 ^21' classified: #cat1. - self t2 compile: 'm22 ^22' classified: #cat2. - self t2 classSide compile: 'm2ClassSide: a ^a'. - self t3: (self createTraitNamed: #T3 - uses: { }). - self t3 compile: 'm31 ^31' classified: #cat1. - self t3 compile: 'm32 ^32' classified: #cat2. - self t3 compile: 'm33 ^33' classified: #cat3. - self t4: (self createTraitNamed: #T4 - uses: { (self t1). (self t2) }). - self t4 compile: 'm11 ^41' classified: #catX. "overrides T1>>m11" - self t4 compile: 'm42 ^42' classified: #cat2. - self t5: (self createTraitNamed: #T5 uses: self t1 + self t2). - self t5 compile: 'm51 ^super foo' classified: #cat1. - self t5 compile: 'm52 ^ self class bar' classified: #cat1. - self t5 compile: 'm53 ^ self class bar' classified: #cat1. - self t6: (self createTraitNamed: #T6 - uses: (self t1 + (self t2 @ { (#m22Alias -> #m22) }))). - self c1: (self createClassNamed: #C1 superclass: Object uses: { }). + self c1 compile: 'foo ^true' classified: #accessing. + self t1 compile: 'm11 ^11' classified: #cat1. + self t1 compile: 'm12 ^12' classified: #cat2. + self t1 compile: 'm13 ^self m12' classified: #cat3. + self c2: (self + createClassNamed: #C2 + superclass: self c1 + uses: self t5 - { #m11 }). + self c2 compile: 'foo ^false' classified: #private. + self c2 compile: 'bar ^self foo' classified: #private. + self setUpTrivialRequiresFixture. + self setUpTwoLevelRequiresFixture. + self setUpTranslatingRequiresFixture ] ]. - self c1 compile: 'foo ^true' classified: #accessing. - self t1 compile: 'm11 ^11' classified: #cat1. - self t1 compile: 'm12 ^12' classified: #cat2. - self t1 compile: 'm13 ^self m12' classified: #cat3. - self c2: (self - createClassNamed: #C2 - superclass: self c1 - uses: self t5 - { #m11 }). - self c2 compile: 'foo ^false' classified: #private. - self c2 compile: 'bar ^self foo' classified: #private. - self setUpTrivialRequiresFixture. - self setUpTwoLevelRequiresFixture. - self setUpTranslatingRequiresFixture]. SystemChangeNotifier uniqueInstance notify: self ofAllSystemChangesUsing: #codeChangedEvent:! Item was changed: + ----- Method: TraitsResource>>tearDown (in category 'running') ----- - ----- Method: TraitsResource>>tearDown (in category 'as yet unclassified') ----- tearDown SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self. self createdClassesAndTraits do: [:aClassOrTrait | | behaviorName | behaviorName := aClassOrTrait name. Smalltalk at: behaviorName ifPresent: [:classOrTrait | classOrTrait removeFromSystem]. ChangeSet current removeClassChanges: behaviorName]. createdClassesAndTraits := self t1: (self t2: (self t3: (self t4: (self t5: (self t6: (self c1: (self c2: (self c3: (self c4: (self c5: (self c6: (self c7: (self c8: nil)))))))))))))! Item was added: + ----- Method: TraitsTestCase>>performTest (in category 'private') ----- + performTest + + Utilities + useAuthorInitials: self className + during: [ super performTest ]!

1 0

The Trunk: Kernel-eem.1187.mcz
by commits＠source.squeak.org 28 Jul '18

28 Jul '18

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1187.mcz ==================== Summary ==================== Name: Kernel-eem.1187 Author: eem Time: 28 July 2018, 12:42:56.673965 pm UUID: 8b9949bc-5fd3-464e-a175-c37ecd43e14a Ancestors: Kernel-eem.1186 Bring Process's class comment up to date. =============== Diff against Kernel-eem.1186 =============== Item was changed: Link subclass: #Process instanceVariableNames: 'suspendedContext priority myList threadId effectiveProcess name island env' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! + !Process commentStamp: 'eem 7/28/2018 12:42' prior: 0! + I represent an independent path of control in the system. This path of control may be stopped (by sending the message suspend) in such a way that it can later be restarted (by sending the message resume). When any one of several paths of control can be advanced, the single instance of ProcessorScheduler named Processor determines which one will actually be advanced, partly using the value of priority. - !Process commentStamp: 'ul 3/22/2011 05:18' prior: 0! - I represent an independent path of control in the system. This path of control may be stopped (by sending the message suspend) in such a way that it can later be restarted (by sending the message resume). When any one of several paths of control can be advanced, the single instance of ProcessorScheduler named Processor determines which one will actually be advanced partly using the value of priority. + Instance Variables: N.B. The first four are used by the virtual machine. They must be defined, and defined in this order, + suspendedContext: <Context|nil> + priority: <Integer> + myList: <LinkedList|nil> + threadId: <Integer|nil> + effectiveProcess: <Process|nil> + name: <String|nil> + island: <Island|nil> + env: <Dictionary|nil> - (If anyone ever makes a subclass of Process, be sure to use allSubInstances in anyProcessesAbove:.) + effectiveProcess + - if not nil effectiveProcess is the process the receiver is running on behalf of. Used by the execution smulation machinery (used by the debugger) to ensure that Processor activeProcess et al answer the expected result when simulating execution (e.g. when debugging). See evaluate:onBehalfOf: and senders. - The threadId variable is used by multi-threaded CogVMs to control process-to-thread binding. It's required to be the fourth instance variable. See SmalltalkImage >> #processHasThreadIdInstVar: for further information. + env + - if not nil this is a Dictionary providing process-specific variables. See e.g. environmentAt:*, DynamicVariable and ProcessSpecificVariable. + + island + - used by Tweak and Croquet to partition the image into multiple address spaces + + myList + - if nil, the receiver is either suspended or the active process. If not nil it is either some condition variable (Semaphore, Mutex) that the receiver is blocked waiting on, or it is the LinkedList in ProcessorScheduler quiescentProcesses that holds the processes for the receiver's priority that are not the current active process but are still runnable. + + name + - if not nil this is the name of the process, used for information, see e.g. the names of processes displayed in the ProcessBrowser + + priority + - the priority of the process, which corresponds to the index in ProcessorScheduler quiescentProcesses that holds the LinkedList of processes at this priority. If running but quiescent, changing priority involves changing priority and myList. + + suspendedContext + - if nil, then the receiver is either the active process or has been terminated. If not nil it is the Context at the hot end of the receiver's stack + + threadId + - if not nil then the receiver is bound to some native thread and the VM will ensure that when executing the receiver, the VM will be running on that native thread. Set by the VM. Not to be set manually. Meaningful only on threaded VMs (which do not mean VMs with a threaded heartbeat). It is required to be the fourth instance variable. See SmalltalkImage >> #processHasThreadIdInstVar: for further information.! - The island and env instance variables are not used by core squeak, but are used by external packages and included here because Monticello cannot handle external instance variables: - island: used by Tweak and Croquet to partition the image into multiple address spaces - env: used by ProcessSpecific to implement per-process variables!

1 0

The Trunk: Kernel-eem.1186.mcz
by commits＠source.squeak.org 28 Jul '18

28 Jul '18

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1186.mcz ==================== Summary ==================== Name: Kernel-eem.1186 Author: eem Time: 27 July 2018, 3:00:17.345945 pm UUID: d3be6129-85ff-4018-913c-630454ce7f5c Ancestors: Kernel-eem.1185 Fix Pragma printing so it is easier for the tests to filter out the added comment that identifies the method the pragma is in, added to Pragma>>printOn:. =============== Diff against Kernel-eem.1185 =============== Item was changed: ----- Method: Pragma>>printOn: (in category 'printing') ----- printOn: aStream aStream nextPut: $<; + print: self message; + nextPut: $>. - print: self message. method ifNotNil: [:m| aStream nextPutAll: ' "in '. m printReferenceOn: aStream. + aStream nextPut: $"]! - aStream nextPut: $"]. - aStream nextPut: $>!

1 0

The Trunk: Kernel-eem.1185.mcz
by commits＠source.squeak.org 28 Jul '18

28 Jul '18

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1185.mcz ==================== Summary ==================== Name: Kernel-eem.1185 Author: eem Time: 27 July 2018, 11:08:12.641836 am UUID: 7296ad00-708d-4cef-b6bc-ceb24d897a70 Ancestors: Kernel-eem.1184 In releaseCriticalSection: use isUnwindContext instead of the more fragile context selector == #ensure:. Now it will handle ifCurtailed: too. Thanks Tobias! Reformat Process>>#terminate. It was baaad. =============== Diff against Kernel-eem.1184 =============== Item was changed: ----- Method: Process>>releaseCriticalSection: (in category 'private') ----- releaseCriticalSection: runnable "Figure out if we are terminating a process that is in the ensure: block of a critical section. In this case, if the block has made progress, pop the suspendedContext so that we leave the ensure: block inside the critical: without signaling the semaphore/exiting the primitive section, since presumably this has already happened. But if it hasn't made progress but is beyond the + wait (which we can tell by the oldList being one of the runnable lists, i.e. a LinkedList, not a - wait (which we can tell my the oldList being one of the runnable lists, i.e. a LinkedList, not a Semaphore or Mutex, et al), then the ensure: block needs to be run." | selectorJustSent | (suspendedContext method pragmaAt: #criticalSection) ifNil: [^self]. selectorJustSent := suspendedContext selectorJustSentOrSelf. "Receiver and/or argument blocks of ensure: in Semaphore>>critical: or Mutex>>#critical:" suspendedContext isClosureContext ifTrue: + [suspendedContext sender isUnwindContext ifTrue: - [suspendedContext sender selector == #ensure: ifTrue: [| notWaitingButMadeNoProgress | "Avoid running the ensure: block twice, popping it if it has already been run. If runnable but at the wait, leave it in place. N.B. No need to check if the block receiver of ensure: has not started to run (via suspendedContext pc = suspendedContext startpc) because ensure: uses valueNoContextSwitch, and so there is no suspension point before the wait." notWaitingButMadeNoProgress := runnable and: [selectorJustSent == #wait and: [suspendedContext sender selectorJustSentOrSelf == #valueNoContextSwitch]]. notWaitingButMadeNoProgress ifFalse: [suspendedContext := suspendedContext home]]. ^self]. "Either Semaphore>>critical: or Mutex>>#critical:. Is the process still blocked? If so, nothing further to do." runnable ifFalse: [^self]. "If still at the wait the ensure: block has not been activated, so signal to restore." selectorJustSent == #wait ifTrue: [suspendedContext receiver signal]. "If still at the lock primitive and the lock primitive just acquired ownership (indicated by it answering false) then the ensure block has not been activated, so explicitly primitiveExitCriticalSection to unlock." (selectorJustSent == #primitiveEnterCriticalSection or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue: [(suspendedContext stackPtr > 0 and: [suspendedContext top == false]) ifTrue: [suspendedContext receiver primitiveExitCriticalSection]]! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." | ctxt unwindBlock oldList | + self isActiveProcess ifTrue: + [ctxt := thisContext. + [ctxt := ctxt findNextUnwindContextUpTo: nil. + ctxt ~~ nil] whileTrue: + [(ctxt tempAt: 2) ifNil: + ["N.B. Unlike Context>>unwindTo: we do not set complete (tempAt: 2) to true." + unwindBlock := ctxt tempAt: 1. + thisContext terminateTo: ctxt. + unwindBlock value]]. - self isActiveProcess ifTrue: [ - ctxt := thisContext. - [ ctxt := ctxt findNextUnwindContextUpTo: nil. - ctxt isNil - ] whileFalse: [ - (ctxt tempAt: 2) ifNil:[ - ctxt tempAt: 2 put: nil. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ]. thisContext terminateTo: nil. self suspend. + "If the process is resumed this will provoke a cannotReturn: error. + Would self debug: thisContext title: 'Resuming a terminated process' be better?" + ^self]. - ] ifFalse:[ - "Always suspend the process first so it doesn't accidentally get woken up. - N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al - then the process is blocked, and if it is nil then the process is already suspended." - oldList := self suspend. - suspendedContext ifNotNil: - ["Release any method marked with the <criticalSection> pragma. - The argument is whether the process is runnable." - self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). + "Always suspend the process first so it doesn't accidentally get woken up. + N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al + then the process is blocked, and if it is nil then the process is already suspended." + oldList := self suspend. + suspendedContext ifNotNil: + ["Release any method marked with the <criticalSection> pragma. + The argument is whether the process is runnable." + self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). - "If terminating a process halfways through an unwind, try to complete that unwind block first." - (suspendedContext findNextUnwindContextUpTo: nil) ifNotNil: - [:outer| - (suspendedContext findContextSuchThat:[:c| c closure == (outer tempAt: 1)]) ifNotNil: - [:inner| "This is an unwind block currently under evaluation" - suspendedContext runUntilErrorOrReturnFrom: inner]]. + "If terminating a process halfways through an unwind, try to complete that unwind block first." + (suspendedContext findNextUnwindContextUpTo: nil) ifNotNil: + [:outer| + (suspendedContext findContextSuchThat:[:c| c closure == (outer tempAt: 1)]) ifNotNil: + [:inner| "This is an unwind block currently under evaluation" + suspendedContext runUntilErrorOrReturnFrom: inner]]. + + ctxt := self popTo: suspendedContext bottomContext. + ctxt == suspendedContext bottomContext ifFalse: + [self debug: ctxt title: 'Unwind error during termination']. + "Set the context to its endPC for the benefit of isTerminated." + ctxt pc: ctxt endPC]! - ctxt := self popTo: suspendedContext bottomContext. - ctxt == suspendedContext bottomContext ifFalse: - [self debug: ctxt title: 'Unwind error during termination']. - "Set the context to its endPC for the benefit of isTerminated." - ctxt pc: ctxt endPC]]!

1 0

The Trunk: Kernel-eem.1184.mcz
by commits＠source.squeak.org 28 Jul '18

28 Jul '18

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1184.mcz ==================== Summary ==================== Name: Kernel-eem.1184 Author: eem Time: 26 July 2018, 9:02:17.653687 pm UUID: 37221c94-8415-41a5-8535-b047f59150b9 Ancestors: Kernel-eem.1183 Now that Kernel-eem.1183 has fixed the process termination in critical: in the face of higher priority processes issue, we can go back to a simpler implementation of Semaphore>>critical:, albeit one marked with ther <criticalSection> pragma for visibility in Process>>#terminate. =============== Diff against Kernel-eem.1183 =============== Item was changed: ----- Method: Semaphore>>critical: (in category 'mutual exclusion') ----- critical: mutuallyExcludedBlock "Evaluate mutuallyExcludedBlock only if the receiver is not currently in the process of running the critical: message. If the receiver is, evaluate mutuallyExcludedBlock after the other critical: message is finished." <criticalSection> + self wait. + ^mutuallyExcludedBlock ensure: [self signal] - | caught | - "We need to catch eventual interruptions very carefully. - The naive approach of just doing, e.g.,: - self wait. - aBlock ensure:[self signal]. - will fail if the active process gets terminated while in the wait. - However, the equally naive: - [self wait. - aBlock value] ensure:[self signal]. - will fail too, since the active process may get interrupted while - entering the ensured block and leave the semaphore signaled twice. - To avoid both problems we make use of the fact that interrupts only - occur on sends (or backward jumps) and use an assignment (bytecode) - right before we go into the wait primitive (which cannot be preempted)." - - caught := false. - ^[ - caught := true. - self wait. - mutuallyExcludedBlock value - ] ensure: [ caught ifTrue: [self signal] ] !

1 0

The Trunk: Kernel-eem.1183.mcz
by commits＠source.squeak.org 28 Jul '18

28 Jul '18

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1183.mcz ==================== Summary ==================== Name: Kernel-eem.1183 Author: eem Time: 26 July 2018, 8:57:05.046828 pm UUID: a55317a4-d742-41af-b3a3-b3198281c2d9 Ancestors: Kernel-eem.1182 Fix the broken SemaphoreTest and MutexTest tests (test[Mutex|Semaphore][After|In]CriticalWait) by having Process>>terminate correctly release <criticalSection> marked methods. This is done by terminate's helper releaseCriticalSection: distinguishing between a context blocked on a blocking primitive (wait, primitiveEnterCriticalSection & primitiveTestAndSetOwnershipOfCriticalSection) and a runnable process that has been unblocked but has not advanced beyond the blocking send, presumably because it has been shut out by currently running higher priority processes. Add InstructionStream>>selectorJustSentOrSelf (c.f. selectorToSendOrSelf) to support releaseCriticalSection:. =============== Diff against Kernel-eem.1182 =============== Item was added: + ----- Method: InstructionStream>>selectorJustSentOrSelf (in category 'scanning') ----- + selectorJustSentOrSelf + "If this instruction follows a send, answer the send's selector, otherwise answer self." + + | method | + method := self method. + ^method encoderClass selectorToSendOrItselfFor: self in: method at: self previousPc! Item was added: + ----- Method: Process>>releaseCriticalSection: (in category 'private') ----- + releaseCriticalSection: runnable + "Figure out if we are terminating a process that is in the ensure: block of a critical section. + In this case, if the block has made progress, pop the suspendedContext so that we leave the + ensure: block inside the critical: without signaling the semaphore/exiting the primitive section, + since presumably this has already happened. But if it hasn't made progress but is beyond the + wait (which we can tell my the oldList being one of the runnable lists, i.e. a LinkedList, not a + Semaphore or Mutex, et al), then the ensure: block needs to be run." + | selectorJustSent | + (suspendedContext method pragmaAt: #criticalSection) ifNil: [^self]. + selectorJustSent := suspendedContext selectorJustSentOrSelf. + + "Receiver and/or argument blocks of ensure: in Semaphore>>critical: or Mutex>>#critical:" + suspendedContext isClosureContext ifTrue: + [suspendedContext sender selector == #ensure: ifTrue: + [| notWaitingButMadeNoProgress | + "Avoid running the ensure: block twice, popping it if it has already been run. If runnable + but at the wait, leave it in place. N.B. No need to check if the block receiver of ensure: has + not started to run (via suspendedContext pc = suspendedContext startpc) because ensure: + uses valueNoContextSwitch, and so there is no suspension point before the wait." + notWaitingButMadeNoProgress := + runnable + and: [selectorJustSent == #wait + and: [suspendedContext sender selectorJustSentOrSelf == #valueNoContextSwitch]]. + notWaitingButMadeNoProgress ifFalse: + [suspendedContext := suspendedContext home]]. + ^self]. + + "Either Semaphore>>critical: or Mutex>>#critical:. Is the process still blocked? If so, nothing further to do." + runnable ifFalse: [^self]. + + "If still at the wait the ensure: block has not been activated, so signal to restore." + selectorJustSent == #wait ifTrue: + [suspendedContext receiver signal]. + + "If still at the lock primitive and the lock primitive just acquired ownership (indicated by it answering false) + then the ensure block has not been activated, so explicitly primitiveExitCriticalSection to unlock." + (selectorJustSent == #primitiveEnterCriticalSection + or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue: + [(suspendedContext stackPtr > 0 + and: [suspendedContext top == false]) ifTrue: + [suspendedContext receiver primitiveExitCriticalSection]]! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate + "Stop the process that the receiver represents forever. + Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. + If the process is in the middle of a critical: critical section, release it properly." - "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating." | ctxt unwindBlock oldList | self isActiveProcess ifTrue: [ ctxt := thisContext. [ ctxt := ctxt findNextUnwindContextUpTo: nil. ctxt isNil ] whileFalse: [ (ctxt tempAt: 2) ifNil:[ ctxt tempAt: 2 put: nil. unwindBlock := ctxt tempAt: 1. thisContext terminateTo: ctxt. unwindBlock value]. ]. thisContext terminateTo: nil. self suspend. ] ifFalse:[ + "Always suspend the process first so it doesn't accidentally get woken up. + N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al + then the process is blocked, and if it is nil then the process is already suspended." - "Always suspend the process first so it doesn't accidentally get woken up" oldList := self suspend. + suspendedContext ifNotNil: + ["Release any method marked with the <criticalSection> pragma. + The argument is whether the process is runnable." + self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). - suspendedContext ifNotNil:[ - "Figure out if we are terminating a process that is in the ensure: block of a critical section. - In this case, if the block has made progress, pop the suspendedContext so that we leave the - ensure: block inside the critical: without signaling the semaphore/exiting the primitive section, - since presumably this has already happened." - (suspendedContext isClosureContext - and: [(suspendedContext method pragmaAt: #criticalSection) notNil - and: [suspendedContext startpc > suspendedContext closure startpc]]) ifTrue: - [suspendedContext := suspendedContext home]. + "If terminating a process halfways through an unwind, try to complete that unwind block first." - "If we are terminating a process halfways through an unwind, try - to complete that unwind block first." (suspendedContext findNextUnwindContextUpTo: nil) ifNotNil: [:outer| (suspendedContext findContextSuchThat:[:c| c closure == (outer tempAt: 1)]) ifNotNil: [:inner| "This is an unwind block currently under evaluation" suspendedContext runUntilErrorOrReturnFrom: inner]]. ctxt := self popTo: suspendedContext bottomContext. ctxt == suspendedContext bottomContext ifFalse: [self debug: ctxt title: 'Unwind error during termination']. "Set the context to its endPC for the benefit of isTerminated." ctxt pc: ctxt endPC]]!

1 0

The Trunk: KernelTests-eem.346.mcz
by commits＠source.squeak.org 27 Jul '18

27 Jul '18

Eliot Miranda uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-eem.346.mcz ==================== Summary ==================== Name: KernelTests-eem.346 Author: eem Time: 27 July 2018, 2:53:08.035755 pm UUID: 76014505-197e-4f48-93de-5f33856bcd6f Ancestors: KernelTests-eem.345 Make the pragma tests survive a trailing comment being included in Pragma>>printOn:. =============== Diff against KernelTests-eem.345 =============== Item was changed: ----- Method: MethodPragmaTest>>assertPragma:givesKeyword:arguments: (in category 'utilities') ----- assertPragma: aString givesKeyword: aSymbol arguments: anArray + | pragma decompiled pragmaString index | - | pragma decompiled | pragma := self pragma: aString selector: #zork. + self assert: aSymbol equals: pragma keyword. + self assert: anArray equals: pragma arguments. - self assert: pragma keyword = aSymbol. - self assert: pragma arguments = anArray. decompiled := (self class>>#zork) decompile. + self assert: (decompiled properties pragmas includes: pragma). + pragmaString := pragma printString. + "Pragma printString may contain a comment; if so, delete it" + (index := pragmaString indexOfSubCollection: '> "in ') > 0 ifTrue: + [pragmaString := pragmaString copyFrom: 1 to: index]. + self assert: (decompiled printString includesSubstring: pragmaString)! - self assert: (decompiled properties pragmas includes: pragma). - self assert: (decompiled asString includesSubstring: pragma asString).!

1 0

The Trunk: KernelTests-eem.345.mcz
by commits＠source.squeak.org 27 Jul '18

27 Jul '18

Eliot Miranda uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-eem.345.mcz ==================== Summary ==================== Name: KernelTests-eem.345 Author: eem Time: 26 July 2018, 10:36:36.042879 pm UUID: 8331a012-d142-483a-85c3-18ef3059a66a Ancestors: KernelTests-eem.344 Add tests for critical: being in ensure: but not having evaluated ensure:'s receiver yet. =============== Diff against KernelTests-eem.344 =============== Item was added: + ----- Method: MutexTest>>testMutexCriticalBlockedInEnsure (in category 'testing') ----- + testMutexCriticalBlockedInEnsure "self run: #testMutexCriticalBlockedInEnsure" + "This tests whether a mutex that is in the ensure: in critical: but has yet to evaluate the valueNoContextSwitch + leaves it with the mutex unlocked." + | lock proc | + lock := Mutex new. + proc := [lock critical: []] newProcess. + proc priority: Processor activePriority - 1. + "step until in critical:" + [proc suspendedContext selector == #critical:] whileFalse: [proc step]. + "step until in ensure: (can't do this until in critical: cuz ensure: may be in newProcess etc...)" + [proc suspendedContext selector == #ensure:] whileFalse: [proc step]. + "Now check that the lock is owned." + self assert: lock isOwned. + "Now that proc is at the right point, resume the process and immediately terminate it." + proc resume; terminate. + self deny: lock isOwned. + self assert: lock isEmpty! Item was added: + ----- Method: SemaphoreTest>>testSemaCriticalBlockedInEnsure (in category 'testing') ----- + testSemaCriticalBlockedInEnsure "self run: #testSemaCriticalBlockedInEnsure" + "This tests whether a semaphore that is in ensure: but has yet to evaluate the valueNoContextSwitch + leaves it with signaling the associated semaphore." + | decompilation needSignalToEnterEnsure s p | + "Distinguish between e.g. + critical: t1 <criticalSection> ^[self wait. t1 value] ensure: [self signal] + and + critical: t1 <criticalSection> self wait. ^t1 ensure: [self signal]" + decompilation := (Semaphore>>#critical:) decompileString. + needSignalToEnterEnsure := (decompilation indexOfSubCollection: #wait) < (decompilation indexOf: $[). + s := Semaphore new. + needSignalToEnterEnsure ifTrue: [s signal]. + p := [s critical: []] newProcess. + p priority: Processor activePriority - 1. + "step until in critical:" + [p suspendedContext selector == #critical:] whileFalse: [p step]. + "step until in ensure: (can't do this until in critical: cuz ensure: may be in newProcess etc...)" + [p suspendedContext selector == #ensure:] whileFalse: [p step]. + "Now check that if we needed a signal to enter ensure: it has been consumed." + self assert: 0 equals: s excessSignals. + "Now that p is at the right point, resume the process and immediately terminate it." + p resume; terminate. + self assert: (needSignalToEnterEnsure ifTrue: [1] ifFalse: [0]) equals: s excessSignals!

1 0

The Trunk: Compiler-eem.389.mcz
by commits＠source.squeak.org 27 Jul '18

27 Jul '18

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-eem.389.mcz ==================== Summary ==================== Name: Compiler-eem.389 Author: eem Time: 26 July 2018, 9:45:02.726136 pm UUID: 44f545d6-d04a-4c28-9559-12ce4a9e39da Ancestors: Compiler-eem.388 Fix a regression in decompilation introduced by Kernel-eem.1174 adding information to pragma>>printOn:. =============== Diff against Compiler-eem.388 =============== Item was changed: ----- Method: MethodNode>>printPragmasOn: (in category 'printing') ----- printPragmasOn: aStream properties ifNil: [^self]. properties pragmas do: [:pragma| "Primitives are printed in printPrimitiveOn:; skip these" (Parser primitivePragmaSelectors includes: pragma keyword) ifFalse: + [aStream crtab: 1; nextPut: $<; print: pragma message; nextPut: $>]]! - [aStream crtab: 1. - pragma printOn: aStream]]!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages July 2018