#lang racket/base
(require rackunit racket/unsafe/ops (for-syntax racket/base))
(provide (all-defined-out))
(define-syntax MAX-DATA-SIZE
(lambda (stx) #'30000))
(define-struct (exn:fail:out-of-bounds exn:fail)
(srcloc)
#:property prop:exn:srclocs
(lambda (a-struct)
(list (exn:fail:out-of-bounds-srcloc a-struct))))
(define-syntax-rule (new-state)
(values (make-bytes MAX-DATA-SIZE 0)
0))
(define-syntax-rule (raise-range-errors! a-state caller-name loc)
(raise (make-exn:fail:out-of-bounds
(format "~a: pointer went out of range of data"
caller-name)
(current-continuation-marks)
loc)))
(define-syntax-rule (increment-ptr data ptr loc)
(begin
(set! ptr (unsafe-fx+ ptr 1))
(when (unsafe-fx>= ptr MAX-DATA-SIZE)
(raise-range-errors! a-state 'increment-ptr loc))))
(define-syntax-rule (decrement-ptr data ptr loc)
(begin
(set! ptr (unsafe-fx- ptr 1))
(when (unsafe-fx< ptr 0)
(raise-range-errors! a-state 'decrement-ptr loc))))
(define-syntax-rule (increment-byte data ptr)
(unsafe-bytes-set! data ptr
(unsafe-fxmodulo
(unsafe-fx+ (unsafe-bytes-ref data ptr)
1)
256)))
(define-syntax-rule (decrement-byte data ptr)
(unsafe-bytes-set! data ptr
(unsafe-fxmodulo
(unsafe-fx- (unsafe-bytes-ref data ptr)
1)
256)))
(define-syntax-rule (write-byte-to-stdout data ptr)
(begin
(write-byte (unsafe-bytes-ref data ptr) (current-output-port))
(flush-output (current-output-port))))
(define-syntax-rule (read-byte-from-stdin data ptr)
(unsafe-bytes-set! data ptr (let ([v (read-byte (current-input-port))])
(if (eof-object? v)
0
v))))
(define-syntax-rule (loop data ptr body ...)
(unless (unsafe-fx= (unsafe-bytes-ref data ptr)
0)
(let loop ()
body ...
(unless (unsafe-fx= (unsafe-bytes-ref data ptr)
0)
(loop)))))
(let-values ([(data ptr) (new-state)])
(increment-byte data ptr)
(check-equal? 1 (bytes-ref data 0))
(increment-byte data ptr)
(check-equal? 2 (bytes-ref data 0))
(decrement-byte data ptr)
(check-equal? 1 (bytes-ref data 0)))
(let-values ([(data ptr) (new-state)])
(increment-ptr data ptr #f)
(increment-byte data ptr)
(check-equal? 0 (bytes-ref data 0))
(check-equal? 1 (bytes-ref data 1))
(decrement-ptr data ptr #f)
(increment-byte data ptr)
(check-equal? 1 (bytes-ref data 0))
(check-equal? 1 (bytes-ref data 1)))
(let-values ([(data ptr) (new-state)])
(parameterize ([current-input-port
(open-input-bytes (bytes 3 1 4))])
(read-byte-from-stdin data ptr)
(increment-ptr data ptr #f)
(read-byte-from-stdin data ptr)
(increment-ptr data ptr #f)
(read-byte-from-stdin data ptr))
(check-equal? 3 (bytes-ref data 0))
(check-equal? 1 (bytes-ref data 1))
(check-equal? 4 (bytes-ref data 2)))
(let-values ([(data ptr) (new-state)])
(set! data (bytes 80 76 84))
(let ([simulated-stdout (open-output-string)])
(parameterize ([current-output-port simulated-stdout])
(write-byte-to-stdout data ptr)
(increment-ptr data ptr #f)
(write-byte-to-stdout data ptr)
(increment-ptr data ptr #f)
(write-byte-to-stdout data ptr))
(check-equal? "PLT" (get-output-string simulated-stdout))))
(let-values ([(data ptr) (new-state)])
(set! data (bytes 0 104 101 108 112 109 101 105
109 109 101 108 116 105 110 103 ))
(set! ptr 15)
(loop data ptr
(loop data ptr (decrement-byte data ptr))
(decrement-ptr data ptr #f))
(check-equal? 0 ptr)
(check-equal? (make-bytes 16 0) data))