home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 116.lha / SmallTalk / Sources / MULT.ST < prev    next >
Encoding:
Text File  |  1986-11-20  |  2.5 KB  |  130 lines

  1. *
  2. * Little Smalltalk, version 2
  3. * Written by Tim Budd, Oregon State University, July 1987
  4. *
  5. * multiprocess scheduler - this is optional
  6. *
  7. Declare Interpreter Object context prev creating stack stackTop byteCodePointer
  8. Declare Process Object interpreter yield
  9. Declare Scheduler Object processList atomic currentProcess
  10. Declare Semaphore Object count processList
  11. Instance Scheduler scheduler
  12. Class Block
  13.     newProcess
  14.         ^ (context newInterpreter: bytecodeCounter) newProcess
  15. |
  16.     fork
  17.         self newProcess resume
  18. ]
  19. Class Context
  20.     newInterpreter: start
  21.         ^ Interpreter new;
  22.             context: self;
  23.             byteCounter: start;
  24.             stack: (Array new: 20)
  25. ]
  26. Class Interpreter
  27.     new
  28.         stackTop <- 0.
  29.         byteCodePointer <- 0
  30. |
  31.     execute
  32.         ^ <19 self>
  33. |
  34.     byteCounter: start
  35.         byteCodePointer <- start
  36. |
  37.     context: value
  38.         context <- value
  39. |
  40.     stack: value
  41.         stack <- value.
  42. |
  43.     newProcess
  44.         ^ Process new; interpreter: self
  45. ]
  46. Class Method
  47.     executeWith: arguments
  48.         ( ( Context new ; method: self ; 
  49.             temporaries: ( Array new: temporarySize) ;
  50.             arguments: arguments ) newInterpreter: 0 )
  51.                 newProcess resume
  52. ]
  53. Class Process
  54.     execute     | i |
  55.         yield <- true.
  56.         i <- 0.
  57.         [ interpreter notNil and: [ yield ]]
  58.             whileTrue: [ interpreter <- interpreter execute.
  59.                     i <- i + 1.
  60.                     (i > 200) ifTrue: [yield <- false ]].
  61.         (interpreter isNil)
  62.             ifTrue: [ self terminate ]
  63. |
  64.     interpreter: value
  65.         interpreter <- value
  66. |
  67.     resume
  68.         scheduler addProcess: self
  69. |
  70.     terminate
  71.         scheduler removeProcess: self
  72. |
  73.     yield
  74.         yield <- false
  75. ]
  76. Class Scheduler
  77.     new
  78.         processList <- Set new.
  79.         atomic <- false
  80. |
  81.     addProcess: aProcess
  82.         processList add: aProcess
  83. |
  84.     critical: aBlock
  85.         atomic <- true.
  86.         aBlock value.
  87.         atomic <- false
  88. |
  89.     currentProcess
  90.         ^ currentProcess
  91. |
  92.     removeProcess: aProcess
  93.         processList remove: aProcess
  94. |
  95.     run
  96.         [ processList size ~= 0 ] whileTrue:
  97.             [ processList do: 
  98.                 [ :x | currentProcess <- x. 
  99.                     [ x execute. atomic ] whileTrue ] ]
  100. ]
  101. Class Semaphore
  102.     new
  103.         count <- 0.
  104.         processList <- List new
  105. |
  106.     critical: aBlock
  107.         self wait.
  108.         aBlock value.
  109.         self signal
  110. |
  111.     set: aNumber
  112.         count <- aNumber
  113. |
  114.     signal
  115.         (processList size = 0)
  116.             ifTrue: [ count <- count + 1]
  117.             ifFalse: [ scheduler critical:
  118.                 [ processList first resume.
  119.                     processList removeFirst ]]
  120. |
  121.     wait        | process |
  122.         (count = 0)
  123.             ifTrue: [ scheduler critical:
  124.                     [ process <- scheduler currentProcess.
  125.                       processList add: process.
  126.                       scheduler removeProcess: process].
  127.                   scheduler currentProcess yield ]
  128.             ifFalse: [ count <- count - 1]
  129. ]
  130.