Continuations in custom port: "cannot invoke continuation from this context"

[Caleb Ristvedt]

I have a procedure that writes to an output port, a procedure that reads
from an input port, and some processing that I want to do in between. So
I figured that I'd try my hand at using continuations to write a custom
input/output port that would hook the two procedures together. The idea
is that I would give it two initial procedures, one for writing, one for
reading, and the read! and write! procedures would remember what the
latest read/write parameters were and read from / write to the
corresponding bytevectors, switching to the other procedure if there
wasn't a bytevector associated with that side. From what I've heard,
it's basically coroutining.

But I eventually (turns out exceptions in custom ports get silently
swallowed and turned into an attempt to close the port) discovered that
I was getting the error "cannot invoke continuations from this
context". The control flow went like this:

1. writer
2. write!
3. reader
4. read!
5. write!
6. writer
7. write!
8. exception when trying to go to read!

So clearly invoking the write continuation to get from 4 to 5 worked,
but invoking the read continuation to get from 7 to 8 didn't. That
sounds like something I read while looking at delimited continuations:

"... This is because composing a saved continuation with the current
continuation involves relocating the stack frames that were saved from
the old stack onto a (possibly) new position on the new stack, and Guile
can only do this for stack frames that it created for Scheme code, not
stack frames created by the C compiler"

I was under the impression this restriction only held for delimited
continuations, but in case I was wrong, I ran

(use-modules (ice-9 suspendable-ports))
(install-suspendable-ports!)

and it continued to fail.

Here is the code I've been using, in all its hideous glory:

----------------------------------------------------------------
(use-modules (ice-9 suspendable-ports))
(use-modules (rnrs io ports))
(use-modules (ice-9 textual-ports))
(use-modules (rnrs bytevectors))
(install-suspendable-ports!)

(let* ((the-pipe #f)
       (write-cont (lambda () (format the-pipe "Hello, world!~%")))
       (read-cont (lambda () (write (get-line the-pipe))))
       (read-bv #f)
       (read-len 0)
       (read-off 0)
       (write-bv #f)
       (write-len 0)
       (write-off 0))
  (set! the-pipe (make-custom-binary-input/output-port
                  "scheme-pipe"
                  ;; read!
                  (lambda (bv index len)
                    (catch #t
                      (lambda ()
                        (format #t "Reading ~A bytes~%" len)
                        (format #t "write-len: ~A write-off: ~A write-bv: ~A~%"
                                write-len write-off write-bv)
                        ;; Stored data?
                        (if (> write-len len)
                            ;; Write it, return to reader
                            (begin
                              (format #t "Read ~A bytes, return to reader.~%" 
len)
                              (bytevector-copy! write-bv write-off bv index len)
                              (set! write-off (+ write-off len))
                              (set! write-len (- write-len len))
                              len)
                            ;; Write it, return to writer
                            (begin
                              (format #t "Read ~A bytes, return to writer.~%"
                                      write-len)
                              (when (> write-len 0)
                                (bytevector-copy! write-bv write-off bv index
                                                  write-len))
                              (set! read-bv bv)
                              (set! read-off (+ index write-len))
                              (set! read-len (- len write-len))
                              (call/cc
                               (lambda (c)
                                 (set! read-cont c)
                                 (write-cont)))
                              (format #t "RETURN FROM READ!~%")
                              len)))
                      (lambda args
                        (format #t "EXCEPTION IN READ: ~A~%" args))))
                  ;; write!
                  (lambda (bv index len)
                    (catch #t
                      (lambda ()
                        (format #t "Writing ~A bytes~%" len)
                        (format #t "read-len: ~A read-off: ~A~%"
                                read-len read-off)
                        (if (> read-len len)
                            ;; Write it, return to writer
                            (begin
                              (format #t "Wrote ~A bytes, return to writer.~%"
                                      len)
                              (bytevector-copy! bv index read-bv read-off len)
                              (set! read-off (+ read-off len))
                              (set! read-len (- read-len len))
                              len)
                            ;; Write it, return to reader
                            (begin
                              (format #t "Wrote ~A bytes, return to reader.~%"
                                      read-len)
                              (when (> read-len 0)
                                (bytevector-copy! bv index read-bv read-off 
read-len))
                              (set! write-bv bv)
                              (set! write-off (+ index read-len))
                              (set! write-len (- len read-len))
                              (call/cc
                               (lambda (c)
                                 (set! write-cont c)
                                 (read-cont)))
                              (format #t "RETURN FROM WRITE!~%")
                              len)))
                      (lambda args
                        (format #t "EXCEPTION IN WRITE: ~A~%" args))))
                  ;; get-position
                  (lambda ()
                    (format #t "Tried getting pos~%"))
                  ;; set-position!
                  (lambda (pos)
                    (format #t "Tried setting pos~%"))
                  ;; close
                  (lambda ()
                    (format #t "Tried closing~%"))))
  (setvbuf the-pipe 'none)
  (write-cont)
  (format #t "DONE WRITING!~%")
  (read-cont))
----------------------------------------------------------------

But just now I noticed that if I change the reader from

(get-line the-pipe)

to

(get-bytevector-all)

it gets as far as the "DONE WRITING" message and then produces the same
"cannot invoke continuation from this context" error.

Any idea what's going wrong here?

Thanks,

- reepca