122 lines
3.9 KiB
Scheme
122 lines
3.9 KiB
Scheme
(define (wasm-bytevector? bytes)
|
|
(equal? (bytevector-copy bytes 0 4) (bytevector #x0 #x61 #x73 #x6D)))
|
|
|
|
(define (wasm-version bytes)
|
|
(bytevector-copy bytes 4 8))
|
|
|
|
(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 (bytes->type bytes)
|
|
(let ((first-byte (bytevector-u8-ref bytes 0)))
|
|
(cond
|
|
((equal? first-byte #x7C) 'f64)
|
|
((equal? first-byte #x7D) 'f32)
|
|
((equal? first-byte #x7E) 'f64)
|
|
((equal? first-byte #x7F) 'f32)
|
|
(else 'unknown)
|
|
;(else (error "Unsupported type byte" first-byte))
|
|
)))
|
|
|
|
(define (bytes->types bytes)
|
|
(letrec*
|
|
((bytes-length (bytevector-length bytes))
|
|
(looper
|
|
(lambda (index types)
|
|
(if (>= index bytes-length)
|
|
types
|
|
(looper (+ index 1) (bytes->type (bytevector-copy bytes index)))))))
|
|
(looper 0 '())))
|
|
|
|
(define (section-bytes->sexp name bytes)
|
|
(let* ((id-and-id-length (leb128->integer-and-length bytes))
|
|
(data-bytes (bytevector-copy bytes (cdr id-and-id-length)))
|
|
(data-length (bytevector-length data-bytes))
|
|
)
|
|
(cond
|
|
#;((equal? name 'type)
|
|
(let* ((number-of-types (leb128->integer-and-length bytes))
|
|
(types (bytes->types (bytevector-copy bytes (cdr number-of-types)))))
|
|
(display "TYPE: type, content = ")
|
|
(write bytes)
|
|
(newline)
|
|
`((number-of-types . ,(car number-of-types))
|
|
(types . ,types))))
|
|
((equal? name 'type)
|
|
(let ((number-of-types (bytevector-u8-ref bytes 0)))
|
|
(display "TYPE: type ")
|
|
(write data-length)
|
|
(newline)
|
|
(write data-bytes)
|
|
(newline)
|
|
(write number-of-types)
|
|
(newline)
|
|
'()))
|
|
(else '()))))
|
|
|
|
(define (wasm->sexp-old bytes)
|
|
(let* ((bytes-length (bytevector-length bytes))
|
|
(magic-bytes (if (> bytes-length 3) (bytevector-copy bytes 0 4) #u8())))
|
|
(when (not (equal? magic-bytes #u8(#x00 #x61 #x73 #x6D)))
|
|
(error "Binary is not wasm (missing magic bytes)"))
|
|
(letrec*
|
|
((wasm-version (bytevector-copy bytes 4 8))
|
|
(section-data '())
|
|
(index 8) ;; Jump over magic bytes and version
|
|
(looper (lambda ()
|
|
(when (< index bytes-length)
|
|
(let* ((id (bytevector-u8-ref bytes index))
|
|
(name (section-id->name id))
|
|
(len (uleb128->integer-and-length bytes (+ index 1) 0 0))
|
|
(data-bytes (bytevector-copy bytes index (+ index (car len)))))
|
|
(display "HERE: index ")
|
|
(write index)
|
|
(newline)
|
|
(display "HERE: data-bytes ")
|
|
(write data-bytes)
|
|
(newline)
|
|
(set! section-data
|
|
(append section-data
|
|
`((id . ,id)
|
|
(name . ,name)
|
|
(data . ,(section-bytes->sexp name data-bytes)))))
|
|
(set! index (+ index 1 (car len) (cdr len)))
|
|
(looper)
|
|
)))))
|
|
(looper)
|
|
section-data)))
|
|
|
|
(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)"))
|
|
(let ((version (read-bytevector 4 port)))
|
|
|
|
(display "HERE: ")
|
|
(write magic-bytes)
|
|
(newline)
|
|
(write version)
|
|
(newline)
|
|
(write (read-uleb128 port))
|
|
(newline)
|
|
(write (read-uleb128 port))
|
|
(newline)
|
|
|
|
|
|
)))
|
|
|