ProcessorScheduler.st
changeset 2188 3814c1d74d2b
parent 2155 0cf80e958130
child 2190 8afa4709d8a2
--- a/ProcessorScheduler.st	Fri Jan 17 15:43:20 1997 +0100
+++ b/ProcessorScheduler.st	Fri Jan 17 16:44:35 1997 +0100
@@ -21,7 +21,7 @@
 	classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
 		UserSchedulingPriority UserInterruptPriority TimingPriority
 		HighestPriority SchedulingPriority MaxNumberOfProcesses
-		InvalidProcessSignal'
+		InvalidProcessSignal TimeSliceProcess'
 	poolDictionaries:''
 	category:'Kernel-Processes'
 !
@@ -1618,6 +1618,71 @@
     "Modified: 10.1.1997 / 18:04:35 / cg"
 ! !
 
+!ProcessorScheduler methodsFor:'scheduling - preemptive'!
+
+slice
+    "Give other Processes at the current priority a chance to run."
+
+    |i "{ Class: SmallInteger }"
+     list|
+
+    i := self highestPriority - 1.                          "claus: dont slice myself"
+    [ i > 0 and: [(quiescentProcessLists at: i) size <= 1]] whileTrue: [i := i - 1].
+    i == 0 ifTrue: [^ self].
+
+    list := quiescentProcessLists at:i.
+
+    "/ shuffle that list
+    list addLast:(list removeFirst).
+
+    "Modified: 17.1.1997 / 16:38:38 / cg"
+!
+
+startTimeSlicing
+    "start preemptive scheduling"
+
+    |timeSliceProcess TimeSliceInterval|
+
+    timeSliceProcess notNil ifTrue: [^self].
+    timeSliceProcess := [
+        [
+            [true] whileTrue: [
+                Delay waitForMilliseconds:TimeSliceInterval.
+                self slice
+            ]
+        ] valueOnUnwindDo:[
+            timeSliceProcess := nil
+        ]
+    ] newProcess.
+    timeSliceProcess priority:(self highestPriority).
+    timeSliceProcess name:'time slicer'.
+    timeSliceProcess resume.
+
+    "
+     Processor startTimeSlicing
+    "
+
+    "Created: 17.1.1997 / 16:42:02 / cg"
+    "Modified: 17.1.1997 / 16:43:36 / cg"
+!
+
+stopTimeSlicing
+    "stop preemptive scheduling"
+
+    |timeSliceProcess|
+
+    timeSliceProcess notNil ifTrue: [
+        timeSliceProcess terminate.
+    ]
+
+    "
+     Processor stopTimeSlicing
+    "
+
+    "Created: 17.1.1997 / 16:43:03 / cg"
+    "Modified: 17.1.1997 / 16:43:42 / cg"
+! !
+
 !ProcessorScheduler methodsFor:'semaphore signalling'!
 
 disableSemaphore:aSemaphore
@@ -2334,6 +2399,6 @@
 !ProcessorScheduler class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.109 1997-01-11 19:32:26 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.110 1997-01-17 15:44:35 cg Exp $'
 ! !
 ProcessorScheduler initialize!