0
(require (lib "foreign.ss")) (unsafe!)
0
(provide for-each-erlang-packet
0
-; We'll start with the standard ports
0
- (define erlang-input-port (current-input-port))
0
- (define erlang-output-port (current-output-port))
0
- (set! erlang-input-port (fd->input-port 3 'erlang-in))
0
- (set! erlang-output-port (fd->output-port 4 'erlang-out)))
0
; The all-important fd->input port code thanks to Matthew Flatt
0
- (define (fd->input-port fd name)
0
- (scheme_make_fd_input_port fd name 0 0))
0
+(define (fd->input-port fd name)
0
+ (scheme_make_fd_input_port fd name 0 0))
0
+(define (fd->output-port fd name)
0
+ (scheme_make_fd_output_port fd name 0 0 0))
0
- (define (fd->output-port fd name)
0
- (scheme_make_fd_output_port fd name 0 0 0))
0
+(define scheme_make_fd_input_port
0
+ (get-ffi-obj "scheme_make_fd_input_port" #f
0
+ (_fun _int _scheme _int _int -> _scheme)))
0
- (define scheme_make_fd_input_port
0
- (get-ffi-obj "scheme_make_fd_input_port" #f
0
- (_fun _int _scheme _int _int -> _scheme)))
0
+(define scheme_make_fd_output_port
0
+ (get-ffi-obj "scheme_make_fd_output_port"
0
+ (_fun _int _scheme _int _int _int -> _scheme)))
0
+; We'll start with the standard ports
0
+(define erlang-input-port (fd->input-port 3 'erlang-in))
0
+(define erlang-output-port (fd->output-port 4 'erlang-out))
0
- (define scheme_make_fd_output_port
0
- (get-ffi-obj "scheme_make_fd_output_port"
0
- (_fun _int _scheme _int _int _int -> _scheme)))
0
; Data conversion functions
0
- (define ERL_MAGIC_NUMBER #"\203")
0
- (define ERL_VERSION #"\141")
0
- (define ERL_SMALL_INT 97)
0
- (define ERL_SMALL_BIGNUM 110)
0
- (define ERL_LARGE_BIGNUM 111)
0
- (define ERL_NEW_REF 114)
0
- (define ERL_SMALL_TUPLE 104)
0
- (define ERL_LARGE_TUPLE 105)
0
- (define ERL_STRING 107)
0
- (define ERL_NEW_FUN 112)
0
-; May return #eof or data
0
+(define ERL_MAGIC_NUMBER #"\203")
0
+(define ERL_SMALL_INT 97)
0
+(define ERL_SMALL_BIGNUM 110)
0
+(define ERL_LARGE_BIGNUM 111)
0
+(define ERL_NEW_REF 114)
0
+(define ERL_SMALL_TUPLE 104)
0
+(define ERL_LARGE_TUPLE 105)
0
+(define ERL_STRING 107)
0
+(define ERL_NEW_FUN 112)
0
+(define (peek-1 data) (peek-bytes 1 0 data))
0
+(define (peek-2 data) (peek-bytes 2 0 data))
0
+(define (read-1 data) (read-bytes 1 data))
0
+(define (read-4 data) (read-bytes 4 data))
0
(define (read-stream n) (read-bytes n erlang-input-port))
0
-; Must return data or throws 'unexpected-eof
0
(define (read-stream-i n)
0
(let ([data (read-bytes n erlang-input-port)])
0
([eof-object? data] (raise 'unexpected-eof))
0
+(define-syntax define-binary-parser
0
+ [(_ name (byte-value processor) ...)
0
+ (let ([identifier (bytes-ref bytes 0)])
0
+ (fprintf (current-error-port) "In term parser! Bytes: ~s~n" bytes)
0
+ [(equal? identifier byte-value)
0
+ (fprintf (current-error-port) "Matched ~s to ~s~n" identifier byte-value)
0
+ (processor (subbytes bytes 1))] ...
0
+ [else (raise `(unknown-data-type ,identifier ,bytes))]))))
0
+(define-binary-parser erlang-term-parser
0
+ [ERL_SMALL_INT (lambda (bytes) (integer-bytes->integer (bytes-append #"\0" bytes) #f #t))]
0
+ [ERL_INT (lambda (bytes) (integer-bytes->integer bytes #t #t))]
0
+ [ERL_ATOM (lambda (bytes) (string->symbol (bytes->string/utf-8 (subbytes bytes 2))))]
0
+ [ERL_STRING (lambda (bytes) (bytes->string/utf-8 (subbytes bytes 2)))]
0
(define (read-size-field)
0
(let ([size-bytes (read-stream 4)])
0
(let* ([mnum (read-magic-number)]
0
[data-bytes (read-stream-i (sub1 size))])
0
(fprintf (current-error-port) "RECORD (~s): ~s~n" mnum data-bytes)
0
+
(erlang-term-parser data-bytes)))
0
(define (read-next-packet)
0
(let ([size-record (read-size-field)])
0
(define (for-each-erlang-packet lam)
0
(display "Waiting on packet to read.\n")
0
(let ([packet (read-next-packet)])
0
+ [(eof-object? packet) packet]
0
[else (lam packet) (for-each-erlang-packet lam)])))
0
\ No newline at end of file
Comments
No one has commented yet.