scsh-0.6/scsh/low-interrupt.scm

84 lines
2.3 KiB
Scheme
Raw Normal View History

2003-05-01 06:21:33 -04:00
; 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
hup
quit
term
tstp
usr1
usr2
info
io
poll
prof
pwr
urg
vtalrm
winch
xcpu
xfsz
))
(define number-of-interrupts
low-interrupt-count)
(define interrupt/alarm (enum low-interrupt alarm))
(define interrupt/keyboard (enum low-interrupt keyboard))
(define interrupt/post-gc (enum low-interrupt post-gc))
(define interrupt/i/o-completion (enum low-interrupt i/o-completion))
(define interrupt/chld (enum low-interrupt chld))
(define interrupt/cont (enum low-interrupt cont))
(define interrupt/hup (enum low-interrupt hup))
(define interrupt/quit (enum low-interrupt quit))
(define interrupt/term (enum low-interrupt term))
(define interrupt/tstp (enum low-interrupt tstp))
(define interrupt/usr1 (enum low-interrupt usr1))
(define interrupt/usr2 (enum low-interrupt usr2))
(define interrupt/info (enum low-interrupt info))
(define interrupt/io (enum low-interrupt io))
(define interrupt/poll (enum low-interrupt poll))
(define interrupt/prof (enum low-interrupt prof))
(define interrupt/pwr (enum low-interrupt pwr))
(define interrupt/urg (enum low-interrupt urg))
(define interrupt/vtalrm (enum low-interrupt vtalrm))
(define interrupt/winch (enum low-interrupt winch))
(define interrupt/xcpu (enum low-interrupt xcpu))
(define interrupt/xfsz (enum low-interrupt xfsz))
(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)))))