182 lines
6.6 KiB
Scheme
182 lines
6.6 KiB
Scheme
(define (read-bytevector-until until . port)
|
|
(letrec*
|
|
((current-port (if (null? port) (current-input-port) (car port)))
|
|
(checklist (if (list? until) until (list until)))
|
|
(looper (lambda (bytes)
|
|
(display "HERE: ")
|
|
(write checklist)
|
|
(newline)
|
|
(write (member (peek-u8 current-port) checklist =))
|
|
(newline)
|
|
(if (or (eof-object? (peek-u8 current-port))
|
|
(member (peek-u8 current-port) checklist =))
|
|
bytes
|
|
(looper (bytevector-append bytes (bytevector (read-u8 current-port))))))))
|
|
(looper (bytevector))))
|
|
|
|
(define (list-slice l start end)
|
|
(vector->list (vector-copy (list->vector l) start end)))
|
|
|
|
(define (byte->type byte)
|
|
(cond ((= byte 0) 'void)
|
|
;; Number types
|
|
((= byte #x7C) 'f64)
|
|
((= byte #x7D) 'f32)
|
|
((= byte #x7E) 'i64)
|
|
((= byte #x7F) 'i32)
|
|
;; Vector type
|
|
((= byte #x7B) 'V128)
|
|
;; Heap types
|
|
((= byte #x69) 'exn)
|
|
((= byte #x6A) 'array)
|
|
((= byte #x6B) 'struct)
|
|
((= byte #x6C) 'i31)
|
|
((= byte #x6D) 'eq)
|
|
((= byte #x6E) 'any)
|
|
((= byte #x6F) 'extern)
|
|
((= byte #x70) 'func)
|
|
((= byte #x71) 'none)
|
|
((= byte #x72) 'noextern)
|
|
((= byte #x73) 'nofunc)
|
|
((= byte #x74) 'noexn)
|
|
(else
|
|
(display "byte->type warning: Unknown type ")
|
|
(display (bytevector byte))
|
|
(newline)
|
|
'unknown)))
|
|
|
|
(define (read-types type-count section-size port result)
|
|
(letrec*
|
|
((type-delimiter #x60)
|
|
(type-signature-byte->name
|
|
(lambda (byte)
|
|
(cond ((= byte #x5E) 'array)
|
|
((= byte #x5F) 'struct)
|
|
((= byte #x60) 'func)
|
|
(else 'unknown))))
|
|
(type-signature-byte?
|
|
(lambda (byte)
|
|
(not (symbol=? (type-signature-byte->name byte) 'unknown))))
|
|
(type-bytes->type
|
|
(lambda (bytes)
|
|
(let*
|
|
((argument-count (list-ref bytes 1))
|
|
(argument-types (map byte->type (list-slice bytes 2 (+ 2 argument-count))))
|
|
(return-type (byte->type (car (reverse bytes)))))
|
|
(append
|
|
`(,(type-signature-byte->name (list-ref bytes 0))
|
|
,(if (null? argument-types) '() `(param ,@argument-types))
|
|
,(if (symbol=? return-type 'void) '() `(result ,return-type)))))))
|
|
(read-type
|
|
(lambda (type-result)
|
|
(cond
|
|
((and (or (eof-object? (peek-u8 port))
|
|
(type-signature-byte? (peek-u8 port))
|
|
(= (+ (apply + (map length result))
|
|
(+ (length type-result) 1))
|
|
section-size))
|
|
(> (length type-result) 0))
|
|
(reverse type-result))
|
|
(else
|
|
(read-type (cons (read-u8 port) type-result)))))))
|
|
(cond
|
|
((= (length result) type-count)
|
|
(map type-bytes->type (reverse result)))
|
|
(else (read-types type-count section-size port (cons (read-type '()) result))))))
|
|
|
|
(define (read-import import-count section-size port result)
|
|
(if (= (length result) import-count)
|
|
result
|
|
(letrec*
|
|
((import-kind->type (lambda (type) (cond ((= type 0) 'func) (else 'unknown))))
|
|
(module-name-length (read-u8 port))
|
|
(module-name (utf8->string (read-bytevector module-name-length port)))
|
|
(field-name-length (read-u8 port))
|
|
(field-name (utf8->string (read-bytevector field-name-length port)))
|
|
(import-kind (read-u8 port))
|
|
(type-index (read-u8 port)))
|
|
(read-import import-count
|
|
section-size
|
|
port
|
|
(cons `(import (module ,module-name)
|
|
(field ,field-name)
|
|
(type ,type-index))
|
|
result)))))
|
|
|
|
(define (read-function function-count section-size port result)
|
|
(display "HERE: ")
|
|
(write result)
|
|
(newline)
|
|
(if (= (length result) function-count)
|
|
(reverse result)
|
|
(read-function function-count
|
|
section-size
|
|
port
|
|
(cons (read-bytevector-until 0 port) result))))
|
|
|
|
(define (read-tables type-count section-size port result)
|
|
`((bytes ,(read-bytevector (- section-size 1) port))))
|
|
|
|
(define (read-memory type-count section-size port result)
|
|
`((bytes ,(read-bytevector (- section-size 1) port))))
|
|
|
|
(define (read-global type-count section-size port result)
|
|
`((bytes ,(read-bytevector (- section-size 1) port))))
|
|
|
|
(define (read-section name size port)
|
|
(list name
|
|
(cond
|
|
((symbol=? name 'custom) (read-bytevector size port))
|
|
((symbol=? name 'type) (read-types (read-u8 port) size port '()))
|
|
((symbol=? name 'import) (read-import (read-u8 port) size port '()))
|
|
((symbol=? name 'function) (read-function (read-u8 port) size port '()))
|
|
((symbol=? name 'table) (read-tables (read-u8 port) size port '()))
|
|
((symbol=? name 'memory) (read-memory (read-u8 port) size port '()))
|
|
((symbol=? name 'global) (read-global (read-u8 port) size port '()))
|
|
((symbol=? name 'export) (read-bytevector size port))
|
|
((symbol=? name 'start) (read-bytevector size port))
|
|
((symbol=? name 'element) (read-bytevector size port))
|
|
((symbol=? name 'code) (read-bytevector size port))
|
|
((symbol=? name 'data) (read-bytevector size port)))))
|
|
|
|
(define (section-id->name id)
|
|
(cond ((= id 0) 'custom)
|
|
((= id 1) 'type)
|
|
((= id 2) 'import)
|
|
((= id 3) 'function)
|
|
((= id 4) 'table)
|
|
((= id 5) 'memory)
|
|
((= id 6) 'global)
|
|
((= id 7) 'export)
|
|
((= id 8) 'start)
|
|
((= id 9) 'element)
|
|
((= id 10) 'code)
|
|
((= id 11) 'data)
|
|
((= id 12) 'data-count)
|
|
((= id 13) 'tag)
|
|
(else (error "section-id->name: unrecognized section id" id))))
|
|
|
|
(define (wasm->sexp-loop port result)
|
|
(let* ((section-id (read-u8 port))
|
|
(section-name (section-id->name section-id))
|
|
(size (read-uleb128 port))
|
|
(section (read-section section-name size port)))
|
|
(display "Section name: ")
|
|
(display section-name)
|
|
(newline)
|
|
(display "Section size: ")
|
|
(write size)
|
|
(newline)
|
|
(if (eof-object? (peek-u8 port))
|
|
(reverse result)
|
|
(wasm->sexp-loop port (cons section result)))))
|
|
|
|
(define (wasm->sexp port)
|
|
(let ((magic-bytes (read-bytevector 4 port)))
|
|
(when (not (equal? magic-bytes #u8(#x00 #x61 #x73 #x6D)))
|
|
(error "Binary is not wasm (missing magic bytes)"))
|
|
(letrec*
|
|
((version (read-bytevector 4 port)))
|
|
(wasm->sexp-loop port '()))))
|
|
|