home *** CD-ROM | disk | FTP | other *** search
- *
- * Little Smalltalk, version 2
- * Written by Tim Budd, Oregon State University, July 1987
- *
- * multiprocess scheduler - this is optional
- *
- Declare Interpreter Object context prev creating stack stackTop byteCodePointer
- Declare Process Object interpreter yield
- Declare Scheduler Object processList atomic currentProcess
- Declare Semaphore Object count processList
- Instance Scheduler scheduler
- Class Block
- newProcess
- ^ (context newInterpreter: bytecodeCounter) newProcess
- |
- fork
- self newProcess resume
- ]
- Class Context
- newInterpreter: start
- ^ Interpreter new;
- context: self;
- byteCounter: start;
- stack: (Array new: 20)
- ]
- Class Interpreter
- new
- stackTop <- 0.
- byteCodePointer <- 0
- |
- execute
- ^ <19 self>
- |
- byteCounter: start
- byteCodePointer <- start
- |
- context: value
- context <- value
- |
- stack: value
- stack <- value.
- |
- newProcess
- ^ Process new; interpreter: self
- ]
- Class Method
- executeWith: arguments
- ( ( Context new ; method: self ;
- temporaries: ( Array new: temporarySize) ;
- arguments: arguments ) newInterpreter: 0 )
- newProcess resume
- ]
- Class Process
- execute | i |
- yield <- true.
- i <- 0.
- [ interpreter notNil and: [ yield ]]
- whileTrue: [ interpreter <- interpreter execute.
- i <- i + 1.
- (i > 200) ifTrue: [yield <- false ]].
- (interpreter isNil)
- ifTrue: [ self terminate ]
- |
- interpreter: value
- interpreter <- value
- |
- resume
- scheduler addProcess: self
- |
- terminate
- scheduler removeProcess: self
- |
- yield
- yield <- false
- ]
- Class Scheduler
- new
- processList <- Set new.
- atomic <- false
- |
- addProcess: aProcess
- processList add: aProcess
- |
- critical: aBlock
- atomic <- true.
- aBlock value.
- atomic <- false
- |
- currentProcess
- ^ currentProcess
- |
- removeProcess: aProcess
- processList remove: aProcess
- |
- run
- [ processList size ~= 0 ] whileTrue:
- [ processList do:
- [ :x | currentProcess <- x.
- [ x execute. atomic ] whileTrue ] ]
- ]
- Class Semaphore
- new
- count <- 0.
- processList <- List new
- |
- critical: aBlock
- self wait.
- aBlock value.
- self signal
- |
- set: aNumber
- count <- aNumber
- |
- signal
- (processList size = 0)
- ifTrue: [ count <- count + 1]
- ifFalse: [ scheduler critical:
- [ processList first resume.
- processList removeFirst ]]
- |
- wait | process |
- (count = 0)
- ifTrue: [ scheduler critical:
- [ process <- scheduler currentProcess.
- processList add: process.
- scheduler removeProcess: process].
- scheduler currentProcess yield ]
- ifFalse: [ count <- count - 1]
- ]
-