home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Developer / macgambit-20-compiler-src-p2 / Runtime (.scm & .s) / _multi.scm < prev    next >
Encoding:
Text File  |  1994-07-26  |  3.6 KB  |  119 lines  |  [TEXT/gamI]
  1. (##include "header.scm")
  2.  
  3. (##declare (not intr-checks))
  4.  
  5. ;------------------------------------------------------------------------------
  6.  
  7. ; Procedures to support multitasking
  8.  
  9. ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  10.  
  11. ; (##read-not-ready ind) is called when there is an attempt to read from a
  12. ; port that does not yet contain chars (i.e. the read would normally block).
  13. ; ##read-not-ready should always return -1.
  14.  
  15. (define ##read-not-ready #f)
  16. (set! ##read-not-ready
  17.   (lambda (ind)
  18.     (if (not (##switch-task)) ; block only if no other tasks to run
  19.       (##os-file-block-read ind))
  20.     -1))
  21.  
  22. ; (##write-not-ready ind) is called when there is an attempt to write to a
  23. ; port that is not ready to accept characters (i.e. the write would normally
  24. ; block).  ##write-not-ready should always return -1.
  25.  
  26. (define ##write-not-ready #f)
  27. (set! ##write-not-ready
  28.   (lambda (ind)
  29.     (if (not (##switch-task)) ; block only if no other tasks to run
  30.       (##os-file-block-write ind))
  31.     -1))
  32.  
  33. ; (##switch-task) is called when control is to be passed to another task
  34. ; (usually at the end of the quantum, but possibly before).
  35.  
  36. (define ##quantum 0)
  37.  
  38. (define (##set-quantum x)
  39.   (set! ##quantum x)
  40.   (##os-set-timer-interval x))
  41.  
  42. (define (##switch-task)
  43.   (###_kernel.switch-task))
  44.  
  45. ; (##add-timer-interrupt-job thunk) can be called to add another
  46. ; job to do on timer interrupts.  (##clear-timer-interrupt-jobs) clears
  47. ; the jobs.
  48.  
  49. (define ##timer-interrupt-jobs #f)
  50.  
  51. (define (##add-timer-interrupt-job thunk)
  52.   (##add-job ##timer-interrupt-jobs thunk))
  53.  
  54. (define (##clear-timer-interrupt-jobs)
  55.   (set! ##timer-interrupt-jobs (##make-jobs))
  56.   (##add-timer-interrupt-job
  57.     (lambda ()
  58.       (let loop ()
  59.         (let ((proc ##handle-os-event))
  60.           (if (and (##procedure? proc)
  61.                    (##eq? ##handle-os-event-enable #t))
  62.             (let ((event (##os-get-next-event))) ; get event from OS
  63.               (and event (proc event) (loop)))))))))
  64.  
  65. (##clear-timer-interrupt-jobs)
  66.  
  67. ; (##timer-interrupt) is called periodically, based on VIRTUAL (cpu) time.
  68. ; The interval is set by a call to (##os-set-timer-interval x), where 'x'
  69. ; is the time expressed in milliseconds.
  70.  
  71. (define ##timer-interrupt-enable #f)
  72. (set! ##timer-interrupt-enable #t)
  73.  
  74. (define ##handle-os-event-enable #f)
  75. (set! ##handle-os-event-enable #t)
  76.  
  77. (define ##timer-interrupt #f)
  78. (set! ##timer-interrupt
  79.   (lambda ()
  80.     (if (##eq? ##timer-interrupt-enable #t)
  81.       (begin
  82.         (##invoke-jobs ##timer-interrupt-jobs)
  83.         (##switch-task)))))
  84.  
  85. (##set-quantum 100) ; 10 task switches per second
  86.  
  87. ; (##handle-os-event event) is called when the OS has generated an
  88. ; event and ##handle-os-event-enable is #t.  The meaning of 'event' is
  89. ; OS dependent.  Events that can't be handled by the application
  90. ; should be passed back to the OS by a call to ##os-handle-event for
  91. ; further processing.  ##handle-os-event should return #t to go on to
  92. ; the next event immediately or #f to wait until the next timer
  93. ; interrupt.
  94.  
  95. (define ##handle-os-event #f)
  96. (set! ##handle-os-event
  97.   (lambda (event)
  98.     (##os-handle-event event)))
  99.  
  100. ; (##add-gc-finalize-job thunk) can be called to add another job to do
  101. ; after a GC.  (##clear-gc-finalize-jobs) clears the jobs.
  102.  
  103. (define ##gc-finalize-jobs #f)
  104.  
  105. (define (##add-gc-finalize-job thunk)
  106.   (##add-job ##gc-finalize-jobs thunk))
  107.  
  108. (define (##clear-gc-finalize-jobs)
  109.   (set! ##gc-finalize-jobs (##make-jobs)))
  110.  
  111. (##clear-gc-finalize-jobs)
  112.  
  113. (define ##gc-finalize #f)
  114. (set! ##gc-finalize
  115.   (lambda ()
  116.     (##invoke-jobs ##gc-finalize-jobs)))
  117.  
  118. ;------------------------------------------------------------------------------
  119.