1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
;==============================================================================
; file: "_multi.scm"
; Copyright (C) 1994-1998 by Marc Feeley, All Rights Reserved.
(##include "header.scm")
(##declare (not interrupts-enabled))
;------------------------------------------------------------------------------
; Procedures to support multitasking
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; (##add-gc-interrupt-job thunk) can be called to add another job to do
; after a GC. (##clear-gc-interrupt-jobs) clears the jobs.
(define ##gc-interrupt-jobs #f)
(define (##add-gc-interrupt-job thunk)
(##add-job ##gc-interrupt-jobs thunk))
(define (##clear-gc-interrupt-jobs)
(set! ##gc-interrupt-jobs (##make-jobs)))
(##clear-gc-interrupt-jobs)
(define ##gc-interrupt #f)
(set! ##gc-interrupt
(lambda ()
(##gc-finalization)
(##invoke-jobs ##gc-interrupt-jobs)))
; (##current-os-event-handler event) is called when the OS has
; generated an event. The meaning and representation of 'event' is OS
; dependent. Events that can't be handled by the application should
; be passed back to the OS by a call to ##os-event-handler for further
; processing. ##current-os-event-handler should return #t to go on to
; the next event immediately or #f to wait until the next timer
; interrupt.
(define ##os-event-processing-enable #f)
(set! ##os-event-processing-enable #t)
(define ##current-os-event-handler #f)
(set! ##current-os-event-handler ##os-event-handler)
(define (##os-event-process)
(and ##os-event-processing-enable
(let ((handler ##current-os-event-handler))
(and (##procedure? handler)
(let ((event (##os-event-get))) ; get next event from OS
(and event
(handler event)
(##os-event-process)))))))
; (##add-timer-interrupt-job thunk) can be called to add another
; job to do on timer interrupts. (##clear-timer-interrupt-jobs) clears
; the jobs.
(define ##timer-interrupt-jobs #f)
(define (##add-timer-interrupt-job thunk)
(##add-job ##timer-interrupt-jobs thunk))
(define (##clear-timer-interrupt-jobs)
(set! ##timer-interrupt-jobs (##make-jobs))
(##add-timer-interrupt-job ##os-event-process))
(##clear-timer-interrupt-jobs)
; (##timer-interrupt) is called periodically, based on VIRTUAL (cpu) time.
(define ##timer-interrupt-enable #f)
(set! ##timer-interrupt-enable #t)
(define ##timer-interrupt #f)
(set! ##timer-interrupt
(lambda ()
(if (##eq? ##timer-interrupt-enable #t)
(##invoke-jobs ##timer-interrupt-jobs))))
; (##user-interrupt) is called on each user interrupt.
(define ##user-interrupt #f)
(set! ##user-interrupt ##handle-user-interrupt)
; (##interrupt-handler code) is called on each interrupt.
(define (##interrupt-handler code)
(case code
((0) (let ((proc ##user-interrupt)) (if (##procedure? proc) (proc))))
((1) (let ((proc ##timer-interrupt)) (if (##procedure? proc) (proc))))
((2) (let ((proc ##gc-interrupt)) (if (##procedure? proc) (proc))))))
;------------------------------------------------------------------------------
|
