Backup
This commit is contained in:
parent
1662abad7c
commit
ae7aacf67f
|
|
@ -14,6 +14,7 @@ Akku.*
|
|||
srfi
|
||||
snow
|
||||
*.wasm
|
||||
*.wat
|
||||
*.js
|
||||
*.a
|
||||
*.o
|
||||
|
|
@ -22,4 +23,4 @@ snow
|
|||
*.link
|
||||
core.*
|
||||
venv*
|
||||
|
||||
retropikzel/wasm/plus.sld
|
||||
|
|
|
|||
3
Makefile
3
Makefile
|
|
@ -51,8 +51,9 @@ test-docker: testfiles
|
|||
CSC_OPIONS="-L -lcurl" \
|
||||
test-r7rs test.${SFX} ${PKG}
|
||||
|
||||
retropikzel/wasm/plus.wasm: retropikzel/wasm/plus.c
|
||||
retropikzel/wasm/plus.wat: retropikzel/wasm/plus.c
|
||||
emcc -o retropikzel/wasm/plus.js retropikzel/wasm/plus.c
|
||||
wasm-dis retropikzel/wasm/plus.wasm > retropikzel/wasm/plus.wat
|
||||
|
||||
clean:
|
||||
git clean -X -f
|
||||
|
|
|
|||
|
|
@ -0,0 +1,181 @@
|
|||
(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 '()))))
|
||||
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
(define-library
|
||||
(retropikzel wasm)
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(retropikzel leb128))
|
||||
(export wasm->sexp)
|
||||
(include "wasm.scm"))
|
||||
|
|
@ -1,162 +1,201 @@
|
|||
(define (list-slice l start end)
|
||||
(vector->list (vector-copy (list->vector l) start end)))
|
||||
(define (get-function-names wat)
|
||||
(filter-map
|
||||
(lambda (item)
|
||||
(if (and (equal? (car item) 'export) (assq 'func item))
|
||||
(cons (cadr (assq 'func item)) (string->symbol (cadr item)))
|
||||
#f))
|
||||
(cdr wat)))
|
||||
|
||||
(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 (get-global-export-names wat)
|
||||
(filter-map
|
||||
(lambda (item)
|
||||
(if (and (equal? (car item) 'export) (assq 'global item))
|
||||
(cons (cadr (assq 'global item)) (string->symbol (cadr item)))
|
||||
#f))
|
||||
(cdr wat)))
|
||||
|
||||
(define (read-types type-count section-size port result)
|
||||
(define (get-globals wat)
|
||||
(filter-map
|
||||
(lambda (item)
|
||||
(cond
|
||||
((equal? (car item) 'global)
|
||||
`(define ,(list-ref item 1) ,(cadr (car (reverse item)))))
|
||||
((and (equal? (car item) 'export) (assq 'global item))
|
||||
`(define ,(string->symbol (cadr item)) ,(cadr (car (reverse item)))))
|
||||
(else #f)))
|
||||
(cdr wat)))
|
||||
|
||||
#;(define (get-memory-export-names wat)
|
||||
(filter-map
|
||||
(lambda (item)
|
||||
(if (and (equal? (car item) 'export) (assq 'memory item))
|
||||
(string->symbol
|
||||
(string-append "memory-"
|
||||
(symbol->string (cadr (assq 'memory item)))))
|
||||
#f))
|
||||
(cdr wat)))
|
||||
|
||||
(define (get-memories wat)
|
||||
(filter-map
|
||||
(lambda (item)
|
||||
(cond
|
||||
((equal? (car item) 'memory)
|
||||
(let* ((sizes (list-tail item 2))
|
||||
(size (cond ((= (length sizes) 1)
|
||||
(list-ref sizes 0))
|
||||
(else (list-ref sizes 1)))))
|
||||
`(vector-set! memory-index
|
||||
,(string->number
|
||||
(string-copy (symbol->string (list-ref item 1))
|
||||
1))
|
||||
(make-vector ,size 0))))
|
||||
(else #f)))
|
||||
(cdr wat)))
|
||||
|
||||
(define (symbol-append sym1 sym2)
|
||||
(string->symbol (string-append (symbol->string sym1) (symbol->string sym2))))
|
||||
|
||||
(define (char-index str c)
|
||||
(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))))))
|
||||
((looper
|
||||
(lambda (index)
|
||||
(cond ((>= index (string-length str)) -1)
|
||||
((char=? c (string-ref str index)) index)
|
||||
(else (looper (+ index 1)))))))
|
||||
(looper 0)))
|
||||
|
||||
(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)))
|
||||
(display "HERE: ")
|
||||
(write import-count)
|
||||
(newline)
|
||||
(write result)
|
||||
(newline)
|
||||
(read-import import-count
|
||||
section-size
|
||||
port
|
||||
(cons `(import (module ,module-name)
|
||||
(field ,field-name)
|
||||
(type ,type-index))
|
||||
result)))))
|
||||
(define (offset=N->N sym)
|
||||
(string->number
|
||||
(string-copy
|
||||
(symbol->string sym)
|
||||
(+ (char-index (symbol->string sym) #\=) 1))))
|
||||
|
||||
(define (read-functions type-count section-size port result)
|
||||
`((bytes ,(read-bytevector (- section-size 1) port))))
|
||||
(define (symbol-starts-with? sym str)
|
||||
(if (not (symbol? sym))
|
||||
#f
|
||||
(let ((sym-str (symbol->string sym)))
|
||||
(and (>= (string-length sym-str) (string-length str))
|
||||
(string=? (string-copy sym-str 0 (string-length str)) str)))))
|
||||
|
||||
(define (read-tables type-count section-size port result)
|
||||
`((bytes ,(read-bytevector (- section-size 1) port))))
|
||||
(define (body-item->sexp item)
|
||||
(cond ((not (list? item)) item)
|
||||
((equal? (car item) 'local)
|
||||
`(define ,(list-ref item 1) 0))
|
||||
((equal? (car item) 'global.get)
|
||||
(list-ref item 1))
|
||||
((equal? (car item) 'global.set)
|
||||
`(set! ,(list-ref item 1) ,@(map body-item->sexp (list-tail item 2))))
|
||||
((equal? (car item) 'global.tee)
|
||||
`(set! ,(list-ref item 1) ,@(map body-item->sexp (list-tail item 2))))
|
||||
((equal? (car item) 'local.get)
|
||||
(list-ref item 1))
|
||||
((equal? (car item) 'local.set)
|
||||
`(set! ,(list-ref item 1) ,@(map body-item->sexp (list-tail item 2))))
|
||||
((equal? (car item) 'local.tee)
|
||||
`(set! ,(list-ref item 1) ,@(map body-item->sexp (list-tail item 2))))
|
||||
((equal? (car item) 'result)
|
||||
#f)
|
||||
((equal? (car item) 'i32.const)
|
||||
(list-ref item 1))
|
||||
((equal? (car item) 'i32.and)
|
||||
`(bitwise-and ,@(map body-item->sexp (cdr item))))
|
||||
((equal? (car item) 'i32.add)
|
||||
`(+ ,@(map body-item->sexp (cdr item))))
|
||||
((equal? (car item) 'i32.sub)
|
||||
`(- ,@(map body-item->sexp (cdr item))))
|
||||
((equal? (car item) 'i32.store)
|
||||
`(vector-set!
|
||||
(vector-ref memory-index
|
||||
,(if (list? (list-ref item 2))
|
||||
(body-item->sexp (list-ref item 2))
|
||||
(list-ref item 2)))
|
||||
,(offset=N->N (body-item->sexp (list-ref item 1)))
|
||||
,(body-item->sexp (list-ref item 3))))
|
||||
((equal? (car item) 'i32.load)
|
||||
`(vector-ref
|
||||
(vector-ref memory-index
|
||||
,(if (symbol-starts-with? (list-ref item 1) "offset=")
|
||||
(offset=N->N (list-ref item 1))
|
||||
0))
|
||||
,(if (symbol-starts-with? (list-ref item 1) "offset=")
|
||||
(if (list? (list-ref item 2))
|
||||
(body-item->sexp (list-ref item 2))
|
||||
(body-item->sexp (list-ref item 2)))
|
||||
(if (list? (list-ref item 1))
|
||||
(body-item->sexp (list-ref item 1))
|
||||
(body-item->sexp (list-ref item 1))))))
|
||||
((equal? (car item) 'call)
|
||||
`(,@(map body-item->sexp (cdr item))))
|
||||
#;((equal? (car item) 'block)
|
||||
(display "HERE: block ")
|
||||
(write (list-tail item 2))
|
||||
(newline)
|
||||
`(call-with-current-continuation
|
||||
(lambda (,(list-ref item 1))
|
||||
,@(map body-item->sexp (list-tail item 2)))))
|
||||
#;((or (equal? (car item) 'i32.eqz))
|
||||
`(= ,@(map body-item->sexp (cdr item))))
|
||||
#;((equal? (car item) 'br_if)
|
||||
`(when (= 1 ,@(map body-item->sexp (list-tail item 2))) (,(list-ref item 1))))
|
||||
(else (map body-item->sexp item)))
|
||||
)
|
||||
|
||||
(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-functions (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 '()))))
|
||||
(define (get-functions function-names wat)
|
||||
(filter-map
|
||||
(lambda (item)
|
||||
(if (equal? (car item) 'func)
|
||||
(let ((name (if (assq (list-ref item 1) function-names)
|
||||
(cdr (assq (list-ref item 1) function-names))
|
||||
(list-ref item 1)))
|
||||
(params (filter-map
|
||||
(lambda (item)
|
||||
(if (and (list? item) (equal? (car item) 'param))
|
||||
(list-ref item 1)
|
||||
#f))
|
||||
(cdr item)))
|
||||
(return (filter-map
|
||||
(lambda (item)
|
||||
(if (and (list? item)
|
||||
(equal? (car item) 'return))
|
||||
item
|
||||
#f))
|
||||
(cdr item)))
|
||||
(body (filter-map
|
||||
(lambda (item)
|
||||
(if (and (list? item)
|
||||
(equal? (car item) 'param))
|
||||
#f
|
||||
(body-item->sexp item)))
|
||||
(cdr item))))
|
||||
(list-set! item 0 'define)
|
||||
(list-set! item 1 name)
|
||||
`(define ,name
|
||||
(lambda ,params
|
||||
(call-with-current-continuation
|
||||
(lambda (return)
|
||||
,@(cdr body))))))
|
||||
#f))
|
||||
(cdr wat)))
|
||||
|
||||
(define (wat-module->r7rs-library library-name port)
|
||||
(let* ((wat (read port))
|
||||
(global-export-names (get-global-export-names wat))
|
||||
(globals (get-globals wat))
|
||||
;(memory-export-names (get-memory-export-names wat))
|
||||
(memories (get-memories wat))
|
||||
(function-names (get-function-names wat))
|
||||
(exports (append (map cdr function-names)
|
||||
(map cdr global-export-names)
|
||||
;memory-export-names
|
||||
))
|
||||
(functions (get-functions function-names wat)))
|
||||
`(define-library
|
||||
,library-name
|
||||
(import (scheme base)
|
||||
(srfi 60))
|
||||
(export ,@exports)
|
||||
(begin
|
||||
(define memory-index (make-vector 8))
|
||||
,@memories
|
||||
,@globals
|
||||
,@functions))))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
(define-library
|
||||
(retropikzel wasm)
|
||||
(import (scheme base)
|
||||
(scheme read)
|
||||
(scheme write)
|
||||
(retropikzel leb128))
|
||||
(export wasm->sexp)
|
||||
(srfi 1))
|
||||
(export wat-module->r7rs-library)
|
||||
(include "wasm.scm"))
|
||||
|
|
|
|||
|
|
@ -1,9 +1,21 @@
|
|||
int x = 100;
|
||||
#include <stdio.h>
|
||||
#include <emscripten/emscripten.h>
|
||||
#include <stdint.h>
|
||||
|
||||
extern int plus(int a, int b) {
|
||||
#ifdef __cplusplus
|
||||
#define EXTERN extern "C"
|
||||
#else
|
||||
#define EXTERN
|
||||
#endif
|
||||
|
||||
EXTERN EMSCRIPTEN_KEEPALIVE uint64_t x = 100;
|
||||
|
||||
EXTERN EMSCRIPTEN_KEEPALIVE int plus(int a, int b) {
|
||||
return a + b;
|
||||
}
|
||||
|
||||
/*
|
||||
int plus_three(int a, int b, int c) {
|
||||
return a + b + c;
|
||||
}
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -1,9 +1,10 @@
|
|||
(test-begin "wasm")
|
||||
|
||||
(define testdir "retropikzel/wasm")
|
||||
(define testfile1 (string-append testdir "/" "plus.wasm"))
|
||||
(define testfile2 (string-append "/tmp/tr7/a.out.wasm"))
|
||||
(define sexp (wasm->sexp (open-binary-input-file testfile2)))
|
||||
(show #t (pretty sexp))
|
||||
(define testfile1 (string-append testdir "/" "plus.wat"))
|
||||
(define testfile2 (string-append "/tmp/test/tr7.wat"))
|
||||
(define lib (wat-module->r7rs-library '(testlibrary) (open-input-file testfile1)))
|
||||
|
||||
(with-output-to-file "/tmp/testwasm/testlibrary.sld" (lambda () (show #t (pretty lib))))
|
||||
|
||||
(test-end "wasm")
|
||||
|
|
|
|||
Loading…
Reference in New Issue