Subject: [feature] enhance library loader to make it possible to load by SONAME - msg#00011

Previous Message by Date: click to view message preview

[PATCH] Race in Process>>suspend

Process>>#suspend manipulates process lists in a non-atomic way. It is a big big problem if the VM interrupts Process>>#suspend and decides to manipulate the same list (in response to an external event). Fixed by making Process>>#suspend atomic, which simplifies many things (but changes the scheduling order in a way such that processes.st needs to be adjusted a little). The bug was reported on the Squeak list; the fix, while conceptually similar, has a completely different shape. Paolo 2007-12-06 Paolo Bonzini <bonzini@xxxxxxx> * kernel/BlkClosure.st: Don't modify the stack top in #asContext:. * kernel/ProcSched.st: Remove #changePriorityListOf:to:suspend:. * kernel/Process.st: Implement #suspend with a primitive. Use #resume to restart the process in the right priority list when the priority is changed and the process was not/is not to be suspended. Remove #setPriorityFrom:to:suspend:. * tests/processes.st: Be more robust in running processes to a sync point. Avoid busy waiting which may or may not work depending on the execution order of the process. * libgst/interp.c: Extract part of suspend_process into remove_process_from_list. Use it in resume_process if the process is active. Yield the active process. * libgst/prims.def: Add VMpr_Process_suspend. * looking for bonzini@xxxxxxxxxxxxxx/smalltalk--devo--2.2--patch-657 to compare with * comparing to bonzini@xxxxxxxxxxxxxx/smalltalk--devo--2.2--patch-657 M kernel/BlkClosure.st M kernel/ProcSched.st M kernel/Process.st M libgst/interp.c M tests/processes.st M libgst/prims.def * modified files --- orig/kernel/BlkClosure.st +++ mod/kernel/BlkClosure.st @@ -165,15 +165,17 @@ creation of Processes from blocks.'> Note that the block has no home, so it cannot contain returns." <category: 'private'> - | top block | - block := BlockContext fromClosure: self parent: parent. - parent isNil - ifFalse: - [top := parent sp == 0 + ^BlockContext + fromClosure: [ + | top | + top := parent isNil + ifTrue: [nil] + ifFalse: [ + parent sp == 0 ifTrue: [parent receiver] - ifFalse: [parent at: parent sp]. - parent sp: parent sp - 1]. - ^block + ifFalse: [parent at: parent sp]]. + self value. top] + parent: parent. ] on: anException do: aBlock [ --- orig/kernel/ProcSched.st +++ mod/kernel/ProcSched.st @@ -66,20 +66,6 @@ Object subclass: ProcessorScheduler [ ^self activeProcess priority ] - changePriorityListOf: aProcess to: aPriority suspend: aBoolean [ - "Private - Move aProcess to the execution list for aPriority, - answer the new execution list" - - <category: 'basic'> - (processLists at: aProcess priority) remove: aProcess ifAbsent: []. - ^aBoolean - ifTrue: [nil] - ifFalse: - [(processLists at: aPriority) - addLast: aProcess; - yourself] - ] - processesAt: aPriority [ "Answer a linked list of processes at the given priority" --- orig/kernel/Process.st +++ mod/kernel/Process.st @@ -114,13 +114,8 @@ can suspend themselves and resume themse another process. Suspending is nothing more than taking ourselves out of every scheduling list and THEN yielding control to another process" - <category: 'basic'> - self isSuspended ifTrue: [^nil]. - myList := Processor - changePriorityListOf: self - to: priority - suspend: true. - self yield + <category: 'builtins'> + <primitive: VMpr_Process_suspend> ] finalize [ @@ -237,45 +232,20 @@ can suspend themselves and resume themse "Change the receiver's priority to anInteger" <category: 'accessing'> - | old | - anInteger < Processor lowestPriority - | (anInteger > Processor highestPriority) - ifTrue: + (anInteger between: Processor lowestPriority + and: Processor highestPriority) + ifFalse: [SystemExceptions.ArgumentOutOfRange signalOn: anInteger mustBeBetween: Processor lowestPriority and: Processor highestPriority]. - self - setPriorityFrom: Processor activePriority - to: anInteger - suspend: false - ] - - setPriorityFrom: activePriority to: anInteger suspend: aBoolean [ - "Change the priority to anInteger. If aBoolean is true, - suspend the process after having done so; if it is false, - check if it is nicer to relinquish control from the running - process (based on the priority of the active process, that - is passed in activePriority) and if this is the case, preempt it." - <category: 'accessing'> - | state | - - [state := #wait. - self isReady ifTrue: [state := #ready]. - self isActive ifTrue: [state := #active]. - state = #wait - ifFalse: - [myList := Processor - changePriorityListOf: self - to: anInteger - suspend: aBoolean]. - priority := anInteger. - (aBoolean or: - [(state = #ready and: [activePriority < priority]) - or: [state = #active and: [activePriority > priority]]]) - ifTrue: [Processor yield]] - valueWithoutPreemption + [ + | waiting | + waiting := self isActive not and: [ self isReady not ]. + priority := anInteger. + waiting ifFalse: [self resume] + ] valueWithoutPreemption ] valueWithoutInterrupts: aBlock [ @@ -304,7 +274,7 @@ can suspend themselves and resume themse ifTrue: [^SystemExceptions.ProcessTerminated signalOn: self]. semaphore := myList. suspended := self isReady not. - block := suspended + block := suspended ifFalse: [self suspend. aBlock] @@ -372,14 +342,12 @@ can suspend themselves and resume themse | closure activePriority | activePriority := Processor activePriority. - closure := - [ - [ - [self - setPriorityFrom: activePriority - to: aPriority - suspend: aBoolean. - aBlockClosure value] + closure := + [[[ + "Inlined #priority: to be able to suspend the process." + priority := aPriority. + aBoolean ifTrue: [self suspend] ifFalse: [self resume]. + aBlockClosure value] on: SystemExceptions.ProcessBeingTerminated do: [:sig | --- orig/libgst/interp.c +++ mod/libgst/interp.c @@ -1462,8 +1462,8 @@ add_first_link (OOP semaphoreOOP, sem->lastLink = processOOP; } -void -suspend_process (OOP processOOP) +static void +remove_process_from_list (OOP processOOP) { gst_semaphore sem; gst_process process, lastProcess; @@ -1504,6 +1504,12 @@ suspend_process (OOP processOOP) } process->nextLink = _gst_nil_oop; +} + +void +suspend_process (OOP processOOP) +{ + remove_process_from_list (processOOP); if (get_scheduled_process() == processOOP) ACTIVE_PROCESS_YIELD (); } @@ -1685,11 +1691,25 @@ resume_process (OOP processOOP, /* 2002-19-12: tried get_active_process instead of get_scheduled_process. */ activeOOP = get_active_process (); - if (processOOP == activeOOP) - return (true); - active = (gst_process) OOP_TO_OBJ (activeOOP); process = (gst_process) OOP_TO_OBJ (processOOP); + priority = TO_INT (process->priority); + + /* As a special exception, don't preempt a process that has disabled + interrupts. ### this behavior is currently disabled. */ + ints_enabled = IS_NIL (active->interrupts) + || TO_INT(active->interrupts) <= 0; + + /* resume_process is also used when changing the priority of a ready/active + process. In this case, first remove the process from its current list. */ + if (processOOP == activeOOP) + { + gcc_assert (!alwaysPreempt); + remove_process_from_list (processOOP); + } + else if (priority >= TO_INT (active->priority) /* && ints_enabled */ ) + alwaysPreempt = true; + if (IS_NIL (processOOP) || is_process_terminating (processOOP)) /* The process was terminated - nothing to resume, fail */ return (false); @@ -1701,17 +1721,10 @@ resume_process (OOP processOOP, return (true); } - /* As a special exception, don't preempt a process that has disabled - interrupts. ### this behavior is currently disabled. */ - ints_enabled = IS_NIL (active->interrupts) - || TO_INT(active->interrupts) <= 0; - - priority = TO_INT (process->priority); processLists = GET_PROCESS_LISTS (); processList = ARRAY_AT (processLists, priority); - if ((priority >= TO_INT (active->priority) /* && ints_enabled */ ) - || alwaysPreempt) + if (alwaysPreempt) { /* We're resuming a process with a *equal or higher* priority, so sleep the current one and activate the new one */ @@ -1719,11 +1732,14 @@ resume_process (OOP processOOP, activate_process (processOOP); } else - /* this process has a lower priority than the active one, so the - policy is that it doesn't preempt the currently running one. - Anyway, it must be the first in its priority queue - so don't - put it to sleep. */ - add_first_link (processList, processOOP); + { + /* this process has a lower priority than the active one, so the + policy is that it doesn't preempt the currently running one. + Anyway, it must be the first in its priority queue - so don't + put it to sleep. */ + add_first_link (processList, processOOP); + ACTIVE_PROCESS_YIELD (); + } return (true); } --- orig/libgst/prims.def +++ mod/libgst/prims.def @@ -2809,6 +2809,17 @@ primitive VMpr_Semaphore_waitAfterSignal PRIM_SUCCEEDED; } +/* Process suspend */ +primitive VMpr_Process_suspend [succeed] +{ + OOP oop1; + _gst_primitives_executed++; + + oop1 = STACKTOP (); + suspend_process (oop1); + PRIM_SUCCEEDED; +} + /* Process resume */ primitive VMpr_Process_resume [succeed,fail,check_interrupt] { --- orig/tests/processes.st +++ mod/tests/processes.st @@ -51,12 +51,15 @@ Eval [ "Test Process suspend/resume" Eval [ + goOn := false. p := [ 'inside p' printNl. + goOn := true. p suspend. 'suspension finished' printNl ] newProcess name: 'test 2'; yourself. p printNl. p resume. + [ goOn ] whileFalse: [ Processor yield ]. p printNl. p executeUntilTermination. p printNl @@ -65,12 +68,15 @@ Eval [ "Test processes yielding control to each other without suspending themselves" Eval [ + goOn := false. p := [ 'inside p' printNl. + goOn := true. Processor yield. 'yielded back to p' printNl ] newProcess name: 'test 3'; yourself. p printNl. p resume. + [ goOn ] whileFalse: [ Processor yield ]. p printNl. p executeUntilTermination. p printNl @@ -85,6 +91,7 @@ Eval [ 'wait finished' printNl ] newProcess name: 'test 4'; yourself. p printNl. p resume. + [ s size = 0 ] whileTrue: [ Processor yield ]. p printNl. s signal. p printNl @@ -94,7 +101,7 @@ Eval [ "Now test process interrupts" Eval [ s := Semaphore new. - ([ [ false ] whileFalse: [ ] ] + ([ [ false ] whileFalse: [ Processor yield ] ] forkAt: Processor userBackgroundPriority) name: 'background'; queueInterrupt: [ (p := Processor activeProcess) printNl. s signal ]. @@ -123,11 +130,14 @@ Eval [ "Resume a process and check that it is removed from the semaphore" Eval [ + | p1 p2 s p1ok p2ok | s := Semaphore new. p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork. p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork. + [ s size = 2 ] whileFalse: [ Processor yield ]. p2 resume. s signal. + p1 ensureTermination. ^p1ok & p2ok & s size = 0 ] @@ -136,8 +146,10 @@ Eval [ s := Semaphore new. p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork. p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork. + [ s size = 2 ] whileFalse: [ Processor yield ]. p1 resume. s signal. + p2 ensureTermination. ^p1ok & p2ok & s size = 0 ] _______________________________________________ help-smalltalk mailing list help-smalltalk@xxxxxxx http://lists.gnu.org/mailman/listinfo/help-smalltalk

Next Message by Date: click to view message preview

[PATCH] Fix (3 perform: #~= with: 3.0)

This stupid (almost embarrassing...) bug happens because, in the more common idiom "3 ~= 3.0", the VM optimizes out the method calls. In the case of the JIT however this does not happen, and this causes the simpler idiom to fail as well (and the Complex package to fail the test suite). While not perfect, the testsuite results are good enough. Paolo _______________________________________________ help-smalltalk mailing list help-smalltalk@xxxxxxx http://lists.gnu.org/mailman/listinfo/help-smalltalk

Previous Message by Thread: click to view message preview

[PATCH] Race in Process>>suspend

Process>>#suspend manipulates process lists in a non-atomic way. It is a big big problem if the VM interrupts Process>>#suspend and decides to manipulate the same list (in response to an external event). Fixed by making Process>>#suspend atomic, which simplifies many things (but changes the scheduling order in a way such that processes.st needs to be adjusted a little). The bug was reported on the Squeak list; the fix, while conceptually similar, has a completely different shape. Paolo 2007-12-06 Paolo Bonzini <bonzini@xxxxxxx> * kernel/BlkClosure.st: Don't modify the stack top in #asContext:. * kernel/ProcSched.st: Remove #changePriorityListOf:to:suspend:. * kernel/Process.st: Implement #suspend with a primitive. Use #resume to restart the process in the right priority list when the priority is changed and the process was not/is not to be suspended. Remove #setPriorityFrom:to:suspend:. * tests/processes.st: Be more robust in running processes to a sync point. Avoid busy waiting which may or may not work depending on the execution order of the process. * libgst/interp.c: Extract part of suspend_process into remove_process_from_list. Use it in resume_process if the process is active. Yield the active process. * libgst/prims.def: Add VMpr_Process_suspend. * looking for bonzini@xxxxxxxxxxxxxx/smalltalk--devo--2.2--patch-657 to compare with * comparing to bonzini@xxxxxxxxxxxxxx/smalltalk--devo--2.2--patch-657 M kernel/BlkClosure.st M kernel/ProcSched.st M kernel/Process.st M libgst/interp.c M tests/processes.st M libgst/prims.def * modified files --- orig/kernel/BlkClosure.st +++ mod/kernel/BlkClosure.st @@ -165,15 +165,17 @@ creation of Processes from blocks.'> Note that the block has no home, so it cannot contain returns." <category: 'private'> - | top block | - block := BlockContext fromClosure: self parent: parent. - parent isNil - ifFalse: - [top := parent sp == 0 + ^BlockContext + fromClosure: [ + | top | + top := parent isNil + ifTrue: [nil] + ifFalse: [ + parent sp == 0 ifTrue: [parent receiver] - ifFalse: [parent at: parent sp]. - parent sp: parent sp - 1]. - ^block + ifFalse: [parent at: parent sp]]. + self value. top] + parent: parent. ] on: anException do: aBlock [ --- orig/kernel/ProcSched.st +++ mod/kernel/ProcSched.st @@ -66,20 +66,6 @@ Object subclass: ProcessorScheduler [ ^self activeProcess priority ] - changePriorityListOf: aProcess to: aPriority suspend: aBoolean [ - "Private - Move aProcess to the execution list for aPriority, - answer the new execution list" - - <category: 'basic'> - (processLists at: aProcess priority) remove: aProcess ifAbsent: []. - ^aBoolean - ifTrue: [nil] - ifFalse: - [(processLists at: aPriority) - addLast: aProcess; - yourself] - ] - processesAt: aPriority [ "Answer a linked list of processes at the given priority" --- orig/kernel/Process.st +++ mod/kernel/Process.st @@ -114,13 +114,8 @@ can suspend themselves and resume themse another process. Suspending is nothing more than taking ourselves out of every scheduling list and THEN yielding control to another process" - <category: 'basic'> - self isSuspended ifTrue: [^nil]. - myList := Processor - changePriorityListOf: self - to: priority - suspend: true. - self yield + <category: 'builtins'> + <primitive: VMpr_Process_suspend> ] finalize [ @@ -237,45 +232,20 @@ can suspend themselves and resume themse "Change the receiver's priority to anInteger" <category: 'accessing'> - | old | - anInteger < Processor lowestPriority - | (anInteger > Processor highestPriority) - ifTrue: + (anInteger between: Processor lowestPriority + and: Processor highestPriority) + ifFalse: [SystemExceptions.ArgumentOutOfRange signalOn: anInteger mustBeBetween: Processor lowestPriority and: Processor highestPriority]. - self - setPriorityFrom: Processor activePriority - to: anInteger - suspend: false - ] - - setPriorityFrom: activePriority to: anInteger suspend: aBoolean [ - "Change the priority to anInteger. If aBoolean is true, - suspend the process after having done so; if it is false, - check if it is nicer to relinquish control from the running - process (based on the priority of the active process, that - is passed in activePriority) and if this is the case, preempt it." - <category: 'accessing'> - | state | - - [state := #wait. - self isReady ifTrue: [state := #ready]. - self isActive ifTrue: [state := #active]. - state = #wait - ifFalse: - [myList := Processor - changePriorityListOf: self - to: anInteger - suspend: aBoolean]. - priority := anInteger. - (aBoolean or: - [(state = #ready and: [activePriority < priority]) - or: [state = #active and: [activePriority > priority]]]) - ifTrue: [Processor yield]] - valueWithoutPreemption + [ + | waiting | + waiting := self isActive not and: [ self isReady not ]. + priority := anInteger. + waiting ifFalse: [self resume] + ] valueWithoutPreemption ] valueWithoutInterrupts: aBlock [ @@ -304,7 +274,7 @@ can suspend themselves and resume themse ifTrue: [^SystemExceptions.ProcessTerminated signalOn: self]. semaphore := myList. suspended := self isReady not. - block := suspended + block := suspended ifFalse: [self suspend. aBlock] @@ -372,14 +342,12 @@ can suspend themselves and resume themse | closure activePriority | activePriority := Processor activePriority. - closure := - [ - [ - [self - setPriorityFrom: activePriority - to: aPriority - suspend: aBoolean. - aBlockClosure value] + closure := + [[[ + "Inlined #priority: to be able to suspend the process." + priority := aPriority. + aBoolean ifTrue: [self suspend] ifFalse: [self resume]. + aBlockClosure value] on: SystemExceptions.ProcessBeingTerminated do: [:sig | --- orig/libgst/interp.c +++ mod/libgst/interp.c @@ -1462,8 +1462,8 @@ add_first_link (OOP semaphoreOOP, sem->lastLink = processOOP; } -void -suspend_process (OOP processOOP) +static void +remove_process_from_list (OOP processOOP) { gst_semaphore sem; gst_process process, lastProcess; @@ -1504,6 +1504,12 @@ suspend_process (OOP processOOP) } process->nextLink = _gst_nil_oop; +} + +void +suspend_process (OOP processOOP) +{ + remove_process_from_list (processOOP); if (get_scheduled_process() == processOOP) ACTIVE_PROCESS_YIELD (); } @@ -1685,11 +1691,25 @@ resume_process (OOP processOOP, /* 2002-19-12: tried get_active_process instead of get_scheduled_process. */ activeOOP = get_active_process (); - if (processOOP == activeOOP) - return (true); - active = (gst_process) OOP_TO_OBJ (activeOOP); process = (gst_process) OOP_TO_OBJ (processOOP); + priority = TO_INT (process->priority); + + /* As a special exception, don't preempt a process that has disabled + interrupts. ### this behavior is currently disabled. */ + ints_enabled = IS_NIL (active->interrupts) + || TO_INT(active->interrupts) <= 0; + + /* resume_process is also used when changing the priority of a ready/active + process. In this case, first remove the process from its current list. */ + if (processOOP == activeOOP) + { + gcc_assert (!alwaysPreempt); + remove_process_from_list (processOOP); + } + else if (priority >= TO_INT (active->priority) /* && ints_enabled */ ) + alwaysPreempt = true; + if (IS_NIL (processOOP) || is_process_terminating (processOOP)) /* The process was terminated - nothing to resume, fail */ return (false); @@ -1701,17 +1721,10 @@ resume_process (OOP processOOP, return (true); } - /* As a special exception, don't preempt a process that has disabled - interrupts. ### this behavior is currently disabled. */ - ints_enabled = IS_NIL (active->interrupts) - || TO_INT(active->interrupts) <= 0; - - priority = TO_INT (process->priority); processLists = GET_PROCESS_LISTS (); processList = ARRAY_AT (processLists, priority); - if ((priority >= TO_INT (active->priority) /* && ints_enabled */ ) - || alwaysPreempt) + if (alwaysPreempt) { /* We're resuming a process with a *equal or higher* priority, so sleep the current one and activate the new one */ @@ -1719,11 +1732,14 @@ resume_process (OOP processOOP, activate_process (processOOP); } else - /* this process has a lower priority than the active one, so the - policy is that it doesn't preempt the currently running one. - Anyway, it must be the first in its priority queue - so don't - put it to sleep. */ - add_first_link (processList, processOOP); + { + /* this process has a lower priority than the active one, so the + policy is that it doesn't preempt the currently running one. + Anyway, it must be the first in its priority queue - so don't + put it to sleep. */ + add_first_link (processList, processOOP); + ACTIVE_PROCESS_YIELD (); + } return (true); } --- orig/libgst/prims.def +++ mod/libgst/prims.def @@ -2809,6 +2809,17 @@ primitive VMpr_Semaphore_waitAfterSignal PRIM_SUCCEEDED; } +/* Process suspend */ +primitive VMpr_Process_suspend [succeed] +{ + OOP oop1; + _gst_primitives_executed++; + + oop1 = STACKTOP (); + suspend_process (oop1); + PRIM_SUCCEEDED; +} + /* Process resume */ primitive VMpr_Process_resume [succeed,fail,check_interrupt] { --- orig/tests/processes.st +++ mod/tests/processes.st @@ -51,12 +51,15 @@ Eval [ "Test Process suspend/resume" Eval [ + goOn := false. p := [ 'inside p' printNl. + goOn := true. p suspend. 'suspension finished' printNl ] newProcess name: 'test 2'; yourself. p printNl. p resume. + [ goOn ] whileFalse: [ Processor yield ]. p printNl. p executeUntilTermination. p printNl @@ -65,12 +68,15 @@ Eval [ "Test processes yielding control to each other without suspending themselves" Eval [ + goOn := false. p := [ 'inside p' printNl. + goOn := true. Processor yield. 'yielded back to p' printNl ] newProcess name: 'test 3'; yourself. p printNl. p resume. + [ goOn ] whileFalse: [ Processor yield ]. p printNl. p executeUntilTermination. p printNl @@ -85,6 +91,7 @@ Eval [ 'wait finished' printNl ] newProcess name: 'test 4'; yourself. p printNl. p resume. + [ s size = 0 ] whileTrue: [ Processor yield ]. p printNl. s signal. p printNl @@ -94,7 +101,7 @@ Eval [ "Now test process interrupts" Eval [ s := Semaphore new. - ([ [ false ] whileFalse: [ ] ] + ([ [ false ] whileFalse: [ Processor yield ] ] forkAt: Processor userBackgroundPriority) name: 'background'; queueInterrupt: [ (p := Processor activeProcess) printNl. s signal ]. @@ -123,11 +130,14 @@ Eval [ "Resume a process and check that it is removed from the semaphore" Eval [ + | p1 p2 s p1ok p2ok | s := Semaphore new. p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork. p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork. + [ s size = 2 ] whileFalse: [ Processor yield ]. p2 resume. s signal. + p1 ensureTermination. ^p1ok & p2ok & s size = 0 ] @@ -136,8 +146,10 @@ Eval [ s := Semaphore new. p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork. p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork. + [ s size = 2 ] whileFalse: [ Processor yield ]. p1 resume. s signal. + p2 ensureTermination. ^p1ok & p2ok & s size = 0 ] _______________________________________________ help-smalltalk mailing list help-smalltalk@xxxxxxx http://lists.gnu.org/mailman/listinfo/help-smalltalk

Next Message by Thread: click to view message preview

Re: [feature] enhance library loader to make it possible to load by SONAME

Issue status update for http://smalltalk.gnu.org/project/issue/136 Post a follow up: http://smalltalk.gnu.org/project/comments/add/136 Project: GNU Smalltalk Version: <none> Component: VM Category: feature requests Priority: normal Assigned to: Unassigned Reported by: tgg Updated by: bonzinip -Status: active +Status: invalid On the libtool mailing list people suggested that the installation script for your program create a symlink from the module directory to the libncurses that the program should open. I will do the change as soon as possible, as soon as I figure out a way to do it portably; in the meanwhile, however, this should be worked around in the Debian package, since lack of libncurses.so is a Debian peculiarity. Thanks!