fork download
  1. ; two stacks
  2.  
  3. (define mem-size 10) ; small for testing
  4. (define arena (make-vector mem-size))
  5.  
  6. (define lo-one 0) (define hi-one 0)
  7. (define lo-two (- mem-size 1)) (define hi-two (- mem-size 1))
  8.  
  9. (define (push-one x)
  10. (cond ((< lo-two hi-one) (error 'push-one "arena overflow"))
  11. (else (vector-set! arena hi-one x) (set! hi-one (+ hi-one 1)))))
  12.  
  13. (define (push-two x)
  14. (cond ((< lo-two hi-one) (error 'push-two "arena overflow"))
  15. (else (vector-set! arena lo-two x) (set! lo-two (- lo-two 1)))))
  16.  
  17. (define (pop-one)
  18. (cond ((= lo-one hi-one) (error 'pop-one "empty stack"))
  19. (else (set! hi-one (- hi-one 1)) (vector-ref arena hi-one))))
  20.  
  21. (define (pop-two)
  22. (cond ((= lo-two hi-two) (error 'pop-two "empty stack"))
  23. (else (set! lo-two (+ lo-two 1)) (vector-ref arena lo-two))))
  24.  
  25. (push-one 1)
  26. (push-one 2)
  27. (push-one 3)
  28. (push-one 4)
  29. (push-one 5)
  30. (push-one 6)
  31. (push-two #\a)
  32. (push-two #\b)
  33. (push-two #\c)
  34. (push-two #\d)
  35. (display (pop-one)) (newline)
  36. (display (pop-one)) (newline)
  37. (display (pop-one)) (newline)
  38. (display (pop-one)) (newline)
  39. (display (pop-one)) (newline)
  40. (display (pop-one)) (newline)
  41. (display (pop-two)) (newline)
  42. (display (pop-two)) (newline)
  43. (display (pop-two)) (newline)
  44. (display (pop-two)) (newline)
Success #stdin #stdout 0.01s 8672KB
stdin
Standard input is empty
stdout
6
5
4
3
2
1
d
c
b
a