/usr/share/scsh-0.6/misc/engine.scm is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | ; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Christopher P. Haynes and Daniel P. Friedman.
; Engines build process abstractions.
; 1984 ACM Symposium on Lisp and Functional Programming, pages 18-24.
; This is incompatible with the threads package.
; ,open primitives interrupts
(define interrupt/alarm (enum interrupt alarm))
(define (run thunk interval when-done when-timeout)
(let ((save (vector-ref interrupt-handlers interrupt/alarm)))
(let ((finish
(call-with-current-continuation
(lambda (k)
(vector-set! interrupt-handlers
interrupt/alarm
(lambda (tem ei)
(set-enabled-interrupts! ei)
(call-with-current-continuation
(lambda (resume)
(k (lambda ()
(when-timeout (lambda ()
(resume #f)))))))))
(schedule-interrupt interval *exponent* #f)
(call-with-values thunk
(lambda vals
(let ((time-remaining (schedule-interrupt 0 0 #f)))
(lambda ()
(apply when-done time-remaining vals)))))))))
(vector-set! interrupt-handlers
interrupt/alarm
save)
(finish))))
(define *exponent* -3)
(define-syntax engine
(syntax-rules ()
((engine ?E) (%engine (lambda () ?E)))))
(define (%engine thunk)
(lambda (ticks done out)
(run thunk
ticks
(lambda (ticks val)
(done val ticks))
(lambda (new-thunk)
(out (%engine new-thunk))))))
; Example from the LFP '84 paper (verbatim)
;(define-syntax rec
; (syntax-rules () ((rec ?X ?E) (letrec ((?X ?E)) ?X))))
;
;(define complete
; (lambda (eng)
; ((rec loop
; (lambda (eng count)
; (eng 1000
; (lambda (val ticks-left)
; (cons val
; (+ (- 1000 ticks-left)
; count)))
; (lambda (eng)
; (loop eng (+ count 1000))))))
; eng 0)))
|