/usr/share/scheme48-1.9/big/compose-cont.scm is in scheme48 1.9-5.
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 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees
(define (compose-continuation proc cont)
(primitive-cwcc
(lambda (k)
(with-continuation cont ;(if cont cont null-continuation)
(lambda ()
(proc (primitive-cwcc
(lambda (k2) (with-continuation k (lambda () k2))))))))))
; Old definition that relies on details of VM architecture:
;(define null-continuation #f)
;(define null-continuation (make-continuation 4 #f)) ;temp kludge
;(continuation-set! null-continuation 1 0)
;(continuation-set! null-continuation 2
; ;; op/trap = 140
; (segment-data->template (make-code-vector 1 140) #f '()))
;(put 'primitive-cwcc 'scheme-indent-hook 0)
;(put 'with-continuation 'scheme-indent-hook 1)
;(define compose-continuation
; (let ((tem
; (let ((cv (make-code-vector 6 0)))
; (code-vector-set! cv 0 op/push) ;push return value
; (code-vector-set! cv 1 op/local) ;fetch procedure
; (code-vector-set! cv 3 1) ;over = 1
; (code-vector-set! cv 4 op/call)
; (code-vector-set! cv 5 1) ;one argument
; (segment-data->template cv 0 '()))))
; (lambda (proc parent-cont)
; (let ((cont (make-continuation 4 #f)))
; (continuation-set! cont 0 parent-cont)
; (continuation-set! cont 1 0) ;pc
; (continuation-set! cont 2 tem) ;template
; (continuation-set! cont 3 (vector #f proc)) ;environment
; cont))))
|