scsh-checkins
[Top] [All Lists]

[Scsh-checkins] CVS: scsh-0.6/scsh event.scm,1.6,1.7 low-interrupt.scm,1

To: scsh-checkins@sourceforge.net
Subject: [Scsh-checkins] CVS: scsh-0.6/scsh event.scm,1.6,1.7 low-interrupt.scm,1.4,1.5 procobj.scm,1.8,1.9 scsh-interfaces.scm,1.13,1.14 scsh-package.scm,1.14,1.15 sighandlers.scm,1.12,1.13 startup.scm,1.9,1.10 top.scm,1.11,1.12
From: Martin Gasbichler <mainzelm@users.sourceforge.net>
Date: Tue, 09 Jan 2001 07:52:55 -0800
List-id: <scsh-checkins.lists.sourceforge.net>
Sender: scsh-checkins-admin@lists.sourceforge.net
Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv1696

Modified Files:
        event.scm low-interrupt.scm procobj.scm scsh-interfaces.scm 
        scsh-package.scm sighandlers.scm startup.scm top.scm 
Log Message:
Built the event system directly into the RTS. Built sighandlers above
it. Removed machinery in low-interrupt.


Index: event.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/event.scm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -r1.6 -r1.7
*** event.scm   2000/08/28 13:30:56     1.6
--- event.scm   2001/01/09 15:52:52     1.7
***************
*** 1,78 ****
! ;;; Functional event system.
! ;;; System by Olin Shivers, implementation by David Fisher
  
! (define-record event
!   type
!   (next (make-placeholder))
!   ((disclose e) (list "event" (event:type e))))
  
! ;Not exported!
! (define *most-recent-event* (make-event interrupt/cont))
! 
! (define event-lock (make-lock))
! 
! (define (most-recent-event) *most-recent-event*)
! 
! (define (next-event event) (placeholder-value (event:next event)))
! 
! (define (event-type event) (event:type event))
  
! ;Called when the interrupt actually happened.
! (define (register-interrupt type)
!   (obtain-lock event-lock)
!   (let ((new-event (make-event type)))
!     (placeholder-set! (event:next *most-recent-event*) new-event)
!     (set! *most-recent-event* new-event))
!   (release-lock event-lock))
  
! ;Wait for an event of a certain type.
! (define (wait-interrupt type pre-event)
!   (let ((event (next-event pre-event)))
!     (if (eq? (event-type event) type)
!       event
!       (wait-interrupt type event))))
! 
! ;Initialize the system.
! (define (install-event-handlers!)
!   (set! *most-recent-event* (make-event interrupt/cont))
!   (let loop ((count 0))
!     (if (< count number-of-interrupts)  
!       (begin 
!       ;we're not interested in the setter-function here:
!         (low-interrupt-register  
!          count  
!          (lambda (enabled-interrupts) 
!            (register-interrupt count)))
!         (loop (+ count 1))))))
  
! ;;; extensions by JMG
  
- ;;; takes list of interrupt/xxx's
- ;;; blocks until one of the interrupts in the set occurs
- (define (wait-interrupt-set set pre-event)
-   (let ((event (next-event pre-event)))
-     (if (memq (event-type event) set)
-       event
-       (wait-interrupt-set set event))))
- 
- 
- ; would need placeholder-queue exported..
- ;(define (placeholder-value-set? placeholder)
- ;  (not (placeholder-queue placeholder)))
- 
- (define (most-recent-event? event)
-   (eq? event (most-recent-event)))
- 
- (define (nonblockwait-interrupt type event )
-   (general-nonblockwait-interrupt type event eq?))
- 
- (define (nonblockwait-interrupt-set set event )
-   (general-nonblockwait-interrupt set event memq))
- 
- (define (general-nonblockwait-interrupt waiting-for pre-event compare?)
-   (if (most-recent-event? pre-event)
-       #f
-       (let ((event (next-event pre-event)))
-       (if (compare? (event-type event) waiting-for)
-           event
-           (general-nonblockwait-interrupt waiting-for event compare?)))))
--- 1,16 ----
! ; Copyright (c) 1999-2001 by Martin Gasbichler. See file COPYING.
  
! ;;; Extend the functions of the RTS
  
! (define (wait-interrupt type pre-event)
!   (rts-wait-interrupt type pre-event eq?))
  
! (define (wait-interrupt-set set pre-event)
!   (rts-wait-interrupt set pre-event interrupt-in-set?))
  
! (define (maybe-wait-interrupt type pre-event)
!   (rts-maybe-wait-interrupt type pre-event eq?))
  
! (define (maybe-wait-interrupt-set set pre-event)
!   (rts-maybe-wait-interrupt set pre-event interrupt-in-set?))
  

Index: low-interrupt.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/low-interrupt.scm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** low-interrupt.scm   2000/07/27 13:33:51     1.4
--- low-interrupt.scm   2001/01/09 15:52:52     1.5
***************
*** 1,7 ****
  (define-enumeration low-interrupt
!   (i/o-completion
!    post-gc
!    keyboard
     alarm
     chld 
     cont
--- 1,12 ----
+ ; Copyright (c) 1999-2001 by Martin Gasbichler. See file COPYING.
+ 
  (define-enumeration low-interrupt
!   (
! ;;; just like the VM:
     alarm
+    keyboard
+    post-gc
+    i/o-completion
+ ;;;; os-signal is multiplexed:
     chld 
     cont
***************
*** 28,127 ****
    low-interrupt-count)
  
- (define low-interrupt-handlers-vector 
-   (make-vector number-of-interrupts '()))
- 
- 
- (define (low-interrupt-handler-ref interrupt)
-   (if (or (< interrupt 0) (>= interrupt number-of-interrupts))
-       (error "ill signum in low-interrupt-handler-ref" interrupt)
-       (vector-ref low-interrupt-handlers-vector interrupt)))
- 
- 
- (define (set-low-interrupt-handler! int handler)
-   (if (or (< int 0) (>= int number-of-interrupts))
-       (error "ill signum in set-low-interrupt-handler!" int)
-       (vector-set! low-interrupt-handlers-vector int handler)))
- 
- ;;; register a handler for interrupt
- ;;; the handler is called whenever interrupt occurs among all others,
- ;;; which registered for this interrupt
- ;;; return value is a function which allows to change the handler
- 
- (define (low-interrupt-register interrupt handler)
-    (let* ((old (low-interrupt-handler-ref interrupt))
-         (the-lock (make-lock))
-        (new-cell (cons handler the-lock)))  
-      (set-low-interrupt-handler! interrupt (cons new-cell old))
-      (lambda (new-handler)
-        (obtain-lock the-lock)
-        (set-car! new-cell new-handler)
-        (release-lock the-lock))))
- 
-   
- 
- 
- (define (init-low-interrupt)
-   (spawn 
-    (lambda ()
-      (let ((I (current-thread)))
-        (set-interrupt-handler! 
-       (enum interrupt os-signal)
-       (lambda (type arg enabled-interrupts)
-         (schedule-event I
-                         (enum event-type interrupt)
-                         (enum interrupt os-signal)
-                         type
-                         enabled-interrupts)))
-        (set-interrupt-handler! 
-       (enum interrupt keyboard)
-       (lambda (enabled-interrupts)
-         (schedule-event I
-                         (enum event-type interrupt)
-                         (enum interrupt keyboard)
-                         enabled-interrupts)))
-        (let loop ()
-        (wait)
-        (call-with-values 
-         get-next-event!
-         (lambda (event . data)
-           (if (eq? event (enum event-type interrupt))
-               (let ((i-nr (car data)))
-                 (if (eq? i-nr (enum interrupt os-signal))
-                     (call-handlers (cadr data) (caddr data))
-                     (if (eq? i-nr (enum interrupt keyboard))
-                         (call-handlers (enum low-interrupt keyboard) 
-                                        (cadr data))))))))
-        (loop))))
-    'low-interrupt-deliver-thread)
-   
-   (call-after-gc!
-    (lambda ()
-      (let ((enabled-interrupts  "JMG: enabled interrupts not yet impl"))
-        (call-handlers (enum low-interrupt post-gc) enabled-interrupts))))
- 
-  #t)
- 
- ;;; the vm-interrupts should be called with interrupts disabled, but 
- ;;; the self generated are not and a lock provides the same functionality
- 
- (define interrupt-deliver-lock (make-lock))
- 
- (define (call-handlers low-interrupt enabled-interrupts)
-   (for-each (lambda (handler-lock-pair)
-             ((car handler-lock-pair) enabled-interrupts))
-           (low-interrupt-handler-ref low-interrupt)))
- 
- 
- ;;; the vm uses the timer for the scheduler
- (define (itimer sec)
-   (spawn (lambda ()
-          (sleep (* sec 1000))
-          (let ((enabled-interrupts  "JMG: enabled interrupts not yet impl"))
-            (call-handlers (enum low-interrupt alarm) enabled-interrupts)))))
- 
- 
  (define interrupt/alarm         (enum low-interrupt alarm))
  (define interrupt/keyboard    (enum low-interrupt keyboard))
- ;(define interrupt/memory-shortage    (enum low-interrupt memory-shortage))
  (define interrupt/post-gc       (enum low-interrupt post-gc))
  (define interrupt/i/o-completion        (enum low-interrupt i/o-completion))
--- 33,38 ----
***************
*** 147,148 ****
--- 58,83 ----
  (define interrupt/int interrupt/keyboard)
  (define interrupt/alrm        interrupt/alarm)
+ 
+ (define (interrupt-set . interrupts)
+   (let lp ((ints interrupts) (ans 0))
+     (if (pair? ints)
+       (lp (cdr ints) (bitwise-ior ans (arithmetic-shift 1 (car ints) )))
+       ans)))
+ 
+ 
+ (define (interrupt-in-set? int set)
+   (not (zero? (bitwise-and (arithmetic-shift 1 int) set))))
+ 
+ (define (insert-interrupt int set)
+   (bitwise-ior (arithmetic-shift 1 int) set))
+ 
+ (define (remove-interrupt int set)
+   (if (interrupt-in-set? int set)
+       (bitwise-xor (arithmetic-shift 1 int) set)
+       set))
+ 
+ (define full-interrupt-set
+   (let lp ((ans 0) (count (- number-of-interrupts 1)))
+     (if (< count 0)
+       ans
+       (lp (insert-interrupt count ans) (- count 1)))))

Index: procobj.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/procobj.scm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -r1.8 -r1.9
*** procobj.scm 2000/12/21 21:57:37     1.8
--- procobj.scm 2001/01/09 15:52:52     1.9
***************
*** 113,118 ****
  ;;; this is here until someone (Olin !!!) cleans up the scsh modules
  
! (define wait-interrupt (structure-ref events wait-interrupt))
! (define most-recent-event (structure-ref events most-recent-event))
  
  
--- 113,118 ----
  ;;; this is here until someone (Olin !!!) cleans up the scsh modules
  
! (define wait-interrupt (structure-ref scsh-events wait-interrupt))
! (define most-recent-event (structure-ref scsh-events most-recent-event))
  
  

Index: scsh-interfaces.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-interfaces.scm,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -r1.13 -r1.14
*** scsh-interfaces.scm 2001/01/02 14:43:27     1.13
--- scsh-interfaces.scm 2001/01/09 15:52:52     1.14
***************
*** 1111,1118 ****
          interrupt/xfsz))
  
! (define-interface event-interface
    (export most-recent-event
!         most-recent-event?
! 
          next-event
          event-type
--- 1111,1118 ----
          interrupt/xfsz))
  
! (define-interface scsh-events-interface
    (export most-recent-event
!                 
!         event?
          next-event
          event-type
***************
*** 1120,1136 ****
          wait-interrupt
          wait-interrupt-set
!         nonblockwait-interrupt
!         nonblockwait-interrupt-set
!         
!         install-event-handlers!))
  
  (define-interface low-interrupt-interface
!   (export low-interrupt-register
!         init-low-interrupt
!         number-of-interrupts
!         itimer
!           interrupt/alrm interrupt/alarm
          interrupt/int  interrupt/keyboard
- ;       interrupt/memory-shortage
          interrupt/post-gc
          interrupt/i/o-completion
--- 1120,1130 ----
          wait-interrupt
          wait-interrupt-set
!         maybe-wait-interrupt
!         maybe-wait-interrupt-set))
  
  (define-interface low-interrupt-interface
!   (export number-of-interrupts
!         interrupt/alrm interrupt/alarm
          interrupt/int  interrupt/keyboard
          interrupt/post-gc
          interrupt/i/o-completion
***************
*** 1152,1156 ****
          interrupt/winch
          interrupt/xcpu        
!         interrupt/xfsz))
  
  (define-interface locks-interface
--- 1146,1155 ----
          interrupt/winch
          interrupt/xcpu        
!         interrupt/xfsz
!         interrupt-set
!         interrupt-in-set?
!         insert-interrupt
!         remove-interrupt
!         full-interrupt-set))
  
  (define-interface locks-interface

Index: scsh-package.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-package.scm,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -r1.14 -r1.15
*** scsh-package.scm    2001/01/02 14:43:27     1.14
--- scsh-package.scm    2001/01/09 15:52:52     1.15
***************
*** 143,147 ****
  )
    (for-syntax (open scsh-syntax-helpers scheme))
!   (access events)
    (open enumerated
        defenum-package
--- 143,147 ----
  )
    (for-syntax (open scsh-syntax-helpers scheme))
!   (access events scsh-events)
    (open enumerated
        defenum-package
***************
*** 282,286 ****
        interrupts
        low-interrupt
!       events
        primitives
        scheme)
--- 282,286 ----
        interrupts
        low-interrupt
!       scsh-events
        primitives
        scheme)
***************
*** 298,302 ****
        extended-ports
        interfaces
!       events                     
        low-interrupt
        fluids-internal            ; JMG: get-dynamic-env 
--- 298,302 ----
        extended-ports
        interfaces
!       scsh-events                     
        low-interrupt
        fluids-internal            ; JMG: get-dynamic-env 
***************
*** 403,414 ****
    (files here))
  
! (define-structure events event-interface
    (open scsh-level-0
-       defrec-package
-       locks
-       placeholders
-       architecture
        scheme
!       low-interrupt)
    (files event))
  
--- 403,412 ----
    (files here))
  
! (define-structure scsh-events scsh-events-interface
    (open scsh-level-0
        scheme
!       structure-refs
!       low-interrupt
!       events)
    (files event))
  
***************
*** 422,433 ****
  
  (define-structure low-interrupt low-interrupt-interface
!   (open enumerated
!       locks
!       error-package
!       i/o             ;current-error-port
!       interrupts      ; signal handler code
!       scheme
!       threads-internal
!       threads)
    (files low-interrupt))
  
--- 420,427 ----
  
  (define-structure low-interrupt low-interrupt-interface
!   (open scheme
!       enumerated
!       bigbit
!       bitwise)
    (files low-interrupt))
  

Index: sighandlers.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/sighandlers.scm,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -r1.12 -r1.13
*** sighandlers.scm     2001/01/01 17:49:08     1.12
--- sighandlers.scm     2001/01/09 15:52:52     1.13
***************
*** 50,64 ****
  
  
- (define (interrupt-set . interrupts)
-   (let lp ((ints interrupts) (ans 0))
-     (if (pair? ints)
-       (lp (cdr ints) (bitwise-ior ans (arithmetic-shift 1 (car ints) )))
-       ans)))
- 
  (define (interrupt-enabled? int mask)
!   (not (zero? (bitwise-and (arithmetic-shift 1 int) mask))))
  
  (define (interrupt-enable int mask)
!   (bitwise-ior (arithmetic-shift 1 int) mask))
  
  (define *enabled-interrupts* 
--- 50,58 ----
  
  
  (define (interrupt-enabled? int mask)
!   (interrupt-in-set? int mask))
  
  (define (interrupt-enable int mask)
!   (insert-interrupt int mask))
  
  (define *enabled-interrupts* 
***************
*** 70,74 ****
--- 64,78 ----
  (define (enabled-interrupts) *enabled-interrupts*)
  
+ (define *pending-interrupts* 0)
+ 
+ (define (interrupt-pending? int)
+   (interrupt-in-set? int *pending-interrupts*))
+ 
+ (define (make-interrupt-pending int)
+   (insert-interrupt int *pending-interrupts*))
  
+ (define (remove-pending-interrupt int)
+   (remove-interrupt int *pending-interrupts*))
+ 
  ;;; I'm trying to be consistent about the ! suffix -- I don't use it
  ;;; when frobbing process state. This is not a great rule; perhaps I
***************
*** 81,159 ****
      (let ((old-state (interrupt-enabled? int *enabled-interrupts*))
          (new-state (interrupt-enabled? int new-enabled-interrupts)))
!       (cond ((and old-state (not new-state))
!              (vector-set! blockade-vector int (block-interrupt int)))
!             ((and (not old-state) new-state)
!              (let ((blockade (vector-ref blockade-vector int)))
!                (if (not blockade)
!                    (error "there was no blockade" int))
!                (unblock-interrupt blockade)
!                (vector-set! blockade-vector int #f)))
!             (else  'unchanged))))
    (set! *enabled-interrupts* new-enabled-interrupts))
  
- ;;; Enableing/Disableing = Unblocking/Blocking 
- ;;;
- ;;; issues: 
- ;;; + prevent delivery of the interrupt => install fake handler in 
- ;;;      low-interrupt
- ;;; + support setting of handler during blocking => install fake 
- ;;;      set-proc in interrupt-handler-vector
- ;;; + record if an interrupt occures while interupt blocked => pending?
- ;;; + restore everything after interrupt unublocked => reinstall handler
- ;;;      in low-interrupt, set-proc in interrupt-handler-vector
- ;;; + if pending? interrupt: call handler
-    
- ;(define-record-type blockade :blockade
- ;  (really-make-blockade interrupt-vector-cell pending? low-int-set!)
- ;  blockade?
- ;  (interrupt-vector-cell blockade:interrupt-vector-cell)
- ;  (pending? blockade:pending? set-blockade:pending?)
- ;  (low-int-set! blockade:low-int-set!))
- 
- (define-record blockade 
-   interrupt-vector-cell
-   low-int-set!    ; proc to set interrupt in low-interrupt
-   (pending? #f))
- 
- 
- (define blockade-vector (make-vector number-of-interrupts #f))
- 
- ;;; do nothing in low-interrupt, the new handler will be recorded in the
- ;;; interrupt-handler-vector however
- (define (fake-set-interrupt blockade)
-   (lambda (new-handler)
-     #f))
- 
- ;;; to be installed in low-interrupt
- (define (fake-handler blockade)
-   (lambda a
-     (if (not (blockade:pending? blockade))
-       (set-blockade:pending? blockade a))))
- 
- ;;; generate blockade and install fake handler and set-proc  
- (define (block-interrupt int)
-   (let* ((handler-setter-cell (vector-ref *interrupt-handlers-vector* int))
-        (low-int-set! (cdr handler-setter-cell))
-        (blockade (make-blockade handler-setter-cell 
-                                 low-int-set!)))
-     ; fade out the low-interupt-set
-     (set-cdr! handler-setter-cell (fake-set-interrupt blockade))
-       ; set the fake handler in low-interupt:
-     ((blockade:low-int-set! blockade) (fake-handler blockade))
-     blockade))
- 
-    
- (define (unblock-interrupt blockade)
-   (let ((handler (car (blockade:interrupt-vector-cell blockade))))
-       ; install the handler that resides in the vector
-     (let ((low-int-set! (blockade:low-int-set! blockade)))
-       (low-int-set!  handler)
-       ; reinstall the low-interrupt-setter
-       (set-cdr! (blockade:interrupt-vector-cell blockade) 
-               low-int-set!)
-       (if (blockade:pending? blockade)
-         (apply handler (blockade:pending? blockade))))))
-        
- 
  (define-simple-syntax (with-enabled-interrupts interrupt-set body ...)
     (begin 
--- 85,92 ----
      (let ((old-state (interrupt-enabled? int *enabled-interrupts*))
          (new-state (interrupt-enabled? int new-enabled-interrupts)))
!       (if (and (not old-state) new-state (interrupt-pending? int))
!         (call-interrupt-handler int))))
    (set! *enabled-interrupts* new-enabled-interrupts))
  
  (define-simple-syntax (with-enabled-interrupts interrupt-set body ...)
     (begin 
***************
*** 168,177 ****
  
  
- ; Fakes vm vector
- ;;; car is the actual handler, cdr is a proc to set handler in 
- ;;; low-interrupt system
- 
  (define *interrupt-handlers-vector* 
!   (make-vector number-of-interrupts (cons #f #f)))
  
  (define (interrupt-handlers-vector)
--- 101,106 ----
  
  
  (define *interrupt-handlers-vector* 
!   (make-vector number-of-interrupts #t))
  
  (define (interrupt-handlers-vector)
***************
*** 181,208 ****
    (if (or (< int 0) (>= int number-of-interrupts))
        (error "ill signum in interrupt-handler-ref" int)
!       (car (vector-ref *interrupt-handlers-vector* int))))
! 
! ;;; the handler is not interested in the enabled interupts of the vm
! ;;; but in those managed here
! (define (make-handler handler)
!   (lambda (enabled-low)
!     (handler (enabled-interrupts))))
  
! (define (set-interrupt-handler! int handler)
!   (if (or (< int 0) (>= int number-of-interrupts))
!       (error "ill signum in set-interrupt-handler!" int)
!       (let ((handler-setter (vector-ref *interrupt-handlers-vector* int))
!           (handler-enabled-here (make-handler handler)))
!       (if (not (cdr handler-setter))  ; not yet registered?
!           (let ((setter (low-interrupt-register
!                          int handler-enabled-here)))
!             (vector-set! *interrupt-handlers-vector* 
!                          int 
!                          (cons handler setter)))
!           (begin           
!             ((cdr handler-setter) handler-enabled-here) ; set it with setter
!             (set-car! (vector-ref *interrupt-handlers-vector* int)
!                       handler))))))
!       
  
  ;;; Get/Set signal handlers
--- 110,122 ----
    (if (or (< int 0) (>= int number-of-interrupts))
        (error "ill signum in interrupt-handler-ref" int)
!       (vector-ref *interrupt-handlers-vector* int)))
  
! (define (call-interrupt-handler int)
!   (let ((handler (interrupt-handler-ref int)))
!     (case handler
!       ((#t) ((vector-ref default-int-handler-vec int) (enabled-interrupts)))
!       ((#f) (if #f #f))
!       (else (handler (enabled-interrupts))))))
!     
  
  ;;; Get/Set signal handlers
***************
*** 243,278 ****
  ;;; register will be restored to its previous value.
  
- ;;; This handler does nothing -- used when the handler is #f.
- (define (noop-sig-handler enabled-interrupts) #f)
- 
  (define (set-interrupt-handler int handler)
!   (let ((ohandler (interrupt-handler int)))
!     (set-interrupt-handler! 
!      int
!      (case handler
!        ((#t) (vector-ref default-int-handler-vec int))
!        ((#f) noop-sig-handler)
!        (else handler)))
!      ohandler))
!     
!  ;   (cond ((and (not handler) ohandler               ; Toggling from 
something
! ;             (int->signal int)) =>           ;   to ignored.
! ;             (lambda (sig)
! ;               (%set-unix-signal-handler sig 0)))
! ;       ((and handler (not ohandler)          ; Toggling from ignored
! ;             (int->signal int)) =>           ;   to something.
! ;             (lambda (sig)
! ;               (%set-unix-signal-handler sig 2))))
!     
! ;    ohandler))
  
  (define (interrupt-handler int)
!   (let ((handler (interrupt-handler-ref int)))
!     (cond ((eq? handler (vector-ref default-int-handler-vec int)) #t)
!         ((eq? handler noop-sig-handler) #f)
!         (else handler))))
  
- 
  (define (%install-scsh-handlers interactive?)
    (do ((int 0 (+ int 1)))
        ((= int number-of-interrupts))
--- 157,172 ----
  ;;; register will be restored to its previous value.
  
  (define (set-interrupt-handler int handler)
!   (if (or (< int 0) (>= int number-of-interrupts))
!       (error "ill signum in set-interrupt-handler!" int)
!       (let ((old-handler (vector-ref *interrupt-handlers-vector* int)))
!       (vector-set! *interrupt-handlers-vector* int handler)
!       old-handler)))
  
  (define (interrupt-handler int)
!   (interrupt-handler-ref int))
  
  (define (%install-scsh-handlers interactive?)
+   (display "install-scsh-handlers???\n")
    (do ((int 0 (+ int 1)))
        ((= int number-of-interrupts))
***************
*** 284,292 ****
      (let ((i (%signal->interrupt sig)))
        (if (not (or (= i -1)
! ;                (= sig signal/int)           ; Leave ^c and
                   (= sig signal/alrm)))        ; alarm handlers alone.
          (set-interrupt-handler 
           i
!          (vector-ref default-int-handler-vec i)))))
    (let ((scheduler-initial-thread  (current-thread)))
      (if (not (eq? (thread-name scheduler-initial-thread)
--- 178,186 ----
      (let ((i (%signal->interrupt sig)))
        (if (not (or (= i -1)
!                  (= sig signal/int)           ; Leave ^c and
                   (= sig signal/alrm)))        ; alarm handlers alone.
          (set-interrupt-handler 
           i
!          #t))))
    (let ((scheduler-initial-thread  (current-thread)))
      (if (not (eq? (thread-name scheduler-initial-thread)
***************
*** 305,310 ****
                                   (structure-ref threads-internal event-type) 
                                   interrupt)
!                                 (enum interrupt keyboard)))))))
  
  ;;; I am ashamed to say the 33 below is completely bogus.
  ;;; What we want is a value that is 1 + max interrupt value.
--- 199,212 ----
                                   (structure-ref threads-internal event-type) 
                                   interrupt)
!                                 (enum interrupt keyboard))))))
!     (spawn deliver-interrupts 'deliver-interrupts))
  
+ (define (deliver-interrupts)
+   (let lp ((last ((structure-ref scsh-events most-recent-event))))
+     (let ((event ((structure-ref scsh-events wait-interrupt-set)
+                 full-interrupt-set last)))
+       (call-interrupt-handler ((structure-ref scsh-events event-type) event))
+       (lp event))))
+     
  ;;; I am ashamed to say the 33 below is completely bogus.
  ;;; What we want is a value that is 1 + max interrupt value.

Index: startup.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/startup.scm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -r1.9 -r1.10
*** startup.scm 2000/12/21 13:27:28     1.9
--- startup.scm 2001/01/09 15:52:52     1.10
***************
*** 45,50 ****
  (define (dump-scsh-program start filename)
    (really-dump-scsh-program (lambda (args)
-                             (init-low-interrupt)
-                             (install-event-handlers!)
                              (install-env)      
                              (%install-scsh-handlers #f)
--- 45,48 ----

Index: top.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/top.scm,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -r1.11 -r1.12
*** top.scm     2001/01/01 17:21:58     1.11
--- top.scm     2001/01/09 15:52:52     1.12
***************
*** 220,225 ****
                       name)) 
  
- (define (forever-sleeping-thread) (sleep 10000) (forever-sleeping-thread))
-  
  (define (parse-switches-and-execute all-args context)
     (receive (switches term-switch term-val top-entry args)
--- 220,223 ----
***************
*** 238,243 ****
         (lambda ()
         (begin
-        (init-low-interrupt)
-        (install-event-handlers!)
         (%install-scsh-handlers (not term-switch))
         (install-autoreaping)
--- 236,239 ----
***************
*** 268,272 ****
                   context 
                   (lambda () 
-                    (spawn forever-sleeping-thread)
                     (display "welcome to scsh-0.6 alpha " 
                                       (current-output-port))
--- 264,267 ----



<Prev in Thread] Current Thread [Next in Thread>
  • [Scsh-checkins] CVS: scsh-0.6/scsh event.scm,1.6,1.7 low-interrupt.scm,1.4,1.5 procobj.scm,1.8,1.9 scsh-interfaces.scm,1.13,1.14 scsh-package.scm,1.14,1.15 sighandlers.scm,1.12,1.13 startup.scm,1.9,1.10 top.scm,1.11,1.12, Martin Gasbichler <=