Skip to content

Instantly share code, notes, and snippets.

@Bogdanp

Bogdanp/go-runtime.rkt Secret

Created Nov 17, 2020
Embed
What would you like to do?
#lang racket/base
(require (for-syntax racket/base
syntax/parse/lib/function-header)
data/gvector
monotonic
(prefix-in http: net/http-easy)
racket/contract
racket/math
racket/random
syntax/parse/define
wasm/private/memory
wasm/private/vm)
(provide
current-vm
*go*)
(define buf (make-bytes 65536))
(define global
(hash
"AbortController" (lambda ()
(make-hash
`(("signal" . `(lambda ()
null)))))
"Array" (lambda ()
'Array)
"Date" (lambda ()
(hash
"getTimezoneOffset" (lambda (_d)
-120)))
"Headers" (lambda ()
(make-hash))
"Object" (lambda ()
(make-hash))
"Uint8Array" (lambda (len)
(hash "buf" (make-bytes (inexact->exact len))))
"crypto" (hash)
"fetch" (lambda (_who uri opts)
#;(printf "fetch uri=~s opts~s~n" uri opts)
(define res-ch (make-channel))
(thread
(lambda ()
(channel-put res-ch (http:get uri))))
(make-hash
`(("then" . ,(lambda (_who ok-callback err-callback)
(define res (channel-get res-ch))
(ok-callback
(hash
"ok" ((integer-in 200 299) (http:response-status-code res))
"status" (http:response-status-code res)
"headers" (hash
"entries" (lambda args
(hash
"next" (lambda args
(hash "done" #t)))))
"body" (hash
"getReader" (lambda args
(hash
"cancel" (lambda (reason)
(hash
"then" (lambda (_who ok-callback err-callback)
(ok-callback reason)))))))
"_response" res)))))))
"fs" (hash
"constants" (hash
"O_WRONLY" -1
"O_RDWR" -1
"O_CREAT" -1
"O_TRUNC" -1
"O_APPEND" -1
"O_EXCL" -1)
"write" (lambda (_fs fd buf offset len position callback)
(display (hash-ref buf "buf")
(case (inexact->exact fd)
[(1) (current-output-port)]
[(2) (current-error-port)]))
(callback 'null len)))
"process" (hash)))
(define this
(make-hash
`(("_pendingEvent" . null)
("_makeFuncWrapper" . ,(lambda (this id)
#;(printf "making callback for id: ~s~n" id)
(lambda args
#;(printf "id: ~a args: ~a~n" id args)
(define event
(make-hash
`(("id" . ,id)
("this" . ,this)
("args" . ,args))))
(hash-set! this "_pendingEvent" event)
((ref "resume"))
(hash-ref event "result")))))))
(define *values*
(gvector +nan.0 0 'null #true #false global this))
(define *refs*
(make-hash))
(define *go*
(make-hash))
(define-syntax-parser define/go
[(_ hd:function-header)
#'(define/go hd
(error 'hd.name "not implemented"))]
[(_ hd:function-header body ...+)
#:with name-str (datum->syntax #'hd.name (symbol->string (syntax->datum #'hd.name)))
#'(begin
(define hd body ...)
(hash-set! *go* name-str hd.name))])
(define current-vm
(make-parameter #f))
(define (ref id)
(vm-ref (current-vm) id void))
(define (load-s32 ea)
(memory-load! (ref "mem") buf ea 4)
(integer-bytes->integer buf #t #f 0 4))
(define (load-u32 ea)
(memory-load! (ref "mem") buf ea 4)
(integer-bytes->integer buf #f #f 0 4))
(define (load-s64 ea)
(memory-load! (ref "mem") buf ea 8)
(integer-bytes->integer buf #t #f 0 8))
(define (load-u64 ea)
(memory-load! (ref "mem") buf ea 8)
(integer-bytes->integer buf #f #f 0 8))
(define (load-f64 ea)
(memory-load! (ref "mem") buf ea 8)
(floating-point-bytes->real buf #f 0 8))
(define (store-u8 ea n)
(memory-store! (ref "mem") ea (integer->integer-bytes n 1 #f #f)))
(define (store-s32 ea n)
(memory-store! (ref "mem") ea (integer->integer-bytes n 4 #t #f)))
(define (store-u32 ea n)
(memory-store! (ref "mem") ea (integer->integer-bytes n 4 #f #f)))
(define (store-s64 ea n)
(memory-store! (ref "mem") ea (integer->integer-bytes n 8 #t #f)))
(define (store-f64 ea n)
(memory-store! (ref "mem") ea (real->floating-point-bytes n 8 #f)))
(define (load-value addr)
(define f (load-f64 addr))
(cond
[(nan? f)
(gvector-ref *values* (load-u32 addr))]
[(zero? f)
'undefined]
[else f]))
(define (load-slice addr)
(define arr (load-s64 addr))
(define len (load-s64 (+ addr 8)))
(define data (make-bytes len))
(begin0 data
(memory-load! (ref "mem") data arr len)))
(define (load-value-slice addr)
(define arr (load-s64 addr))
(define len (load-s64 (+ addr 8)))
(for/list ([i (in-range len)])
(load-value (+ arr (* i 8)))))
(define (store-value addr v)
(define nan-head #x7FF80000)
(cond
[(number? v)
(cond
[(nan? v)
(store-u32 (+ addr 4) nan-head)
(store-u32 (+ addr 0) 0)]
[(zero? v)
(store-u32 (+ addr 4) nan-head)
(store-u32 (+ addr 0) 1)]
[else
(store-f64 addr v)])]
[(eq? v 'undefined)
(store-f64 addr 0)]
[(eq? v 'null)
(store-u32 (+ addr 4) nan-head)
(store-u32 (+ addr 0) 2)]
[(eq? v #true)
(store-u32 (+ addr 4) nan-head)
(store-u32 (+ addr 0) 3)]
[(eq? v #false)
(store-u32 (+ addr 4) nan-head)
(store-u32 (+ addr 0) 4)]
[else
(define ref
(hash-ref *refs* v (lambda ()
(define ref (gvector-count *values*))
(gvector-add! *values* v)
(begin0 ref
(hash-set! *refs* v ref)))))
(define flag
(cond
[(string? v) 1]
[(symbol? v) 2]
[(procedure? v) 3]
[else 0]))
(store-u32 (+ addr 4) (bitwise-ior nan-head flag))
(store-u32 (+ addr 0) ref)]))
(define (load-string addr)
(define s (load-s64 addr))
(define len (load-s64 (+ addr 8)))
(define data (make-bytes len))
(memory-load! (ref "mem") data s len)
(bytes->string/utf-8 data))
(define/go (debug . args)
(printf "debug: ~s~n" args)
null)
(define/go (runtime.wasmExit sp)
(define code (load-s32 (+ sp 8)))
(error 'runtime.wasmExit "~a" code))
(define/go (runtime.wasmWrite sp)
(define port
(case (load-s64 (+ 8 sp))
[(1) (current-output-port)]
[(2) (current-error-port)]))
(define p (load-s64 (+ 16 sp)))
(define n (load-s64 (+ 24 sp)))
(define data (make-bytes n))
(memory-load! (ref "mem") data p n)
(begin0 null
(display data port)))
(define origin
(- (* (current-milliseconds) 1000000) (nanotime)))
(define/go (runtime.nanotime sp)
(begin0 null
(store-s64 (+ sp 8) (+ origin (nanotime)))))
(define/go (runtime.walltime sp)
(define ms (current-milliseconds))
(begin0 null
(store-s64 (+ sp 8) (quotient ms 1000))
(store-s32 (+ sp 16) (* (remainder ms 1000) 1000000))))
(define/go (runtime.scheduleTimeoutEvent . args))
(define/go (runtime.clearTimeoutEvent . args))
(define/go (runtime.getRandomData sp)
(define arr (load-s64 (+ sp 8)))
(define len (load-s64 (+ sp 16)))
(begin0 null
(memory-store! (ref "mem") arr (crypto-random-bytes len))))
(define/go (syscall/js.stringVal sp)
(define str (load-string (+ sp 8)))
(begin0 null
(store-value (+ sp 24) str)))
(define/go (syscall/js.valueGet sp)
(define t (load-value (+ sp 8)))
(define k (load-string (+ sp 16)))
#;(printf "t: ~s k: ~s~n" t k)
(define v (hash-ref t k))
(define res-sp (car ((ref "getsp"))))
(begin0 null
(store-value (+ res-sp 32) v)))
(define/go (syscall/js.valueSet sp)
(define t (load-value (+ sp 8)))
(define k (load-string (+ sp 16)))
(define v (load-value (+ sp 32)))
(begin0 null
(hash-set! t k v)))
(define/go (syscall/js.valueIndex sp)
(define lst (load-value (+ sp 8)))
(define idx (load-s64 (+ sp 16)))
(define val (list-ref lst idx))
#;(printf "lst=~s idx=~s val=~s~n" lst idx val)
(begin0 null
(store-value (+ sp 24) val)))
(define/go (syscall/js.valueSetIndex . args))
(define/go (syscall/js.valueCall sp)
(begin0 null
(with-handlers ([exn:fail?
(lambda (e)
((error-display-handler) (exn-message e) e)
(define res-sp (car ((ref "getsp"))))
(store-value (+ res-sp 56) (exn-message e))
(store-u8 (+ res-sp 64) 0))])
(define v (load-value (+ sp 8)))
(define k (load-string (+ sp 16)))
#;(printf "f: ~s k: ~s~n" v k)
(define m (hash-ref v k))
(define args (load-value-slice (+ sp 32)))
(define res (apply m (cons v args)))
(define res-sp (car ((ref "getsp"))))
(store-value (+ res-sp 56) res)
(store-u8 (+ res-sp 64) 1))))
(define/go (syscall/js.valueNew sp)
(begin0 null
(with-handlers ([exn:fail?
(lambda (e)
((error-display-handler) (exn-message e) e)
(store-value (+ sp 40) (exn-message e))
(store-u8 (+ sp 48) 0))])
(define v (load-value (+ sp 8)))
(define args (load-value-slice (+ sp 16)))
(define res (apply v args))
(define res-sp (car ((ref "getsp"))))
(store-value (+ res-sp 40) res)
(store-u8 (+ res-sp 48) 1))))
(define/go (syscall/js.valueLength sp)
(define val (load-value (+ sp 8)))
(define len (inexact->exact (length val)))
#;(printf "val=~s len=~s~n" val len)
(begin0 null
(store-s64 (+ sp 16) len)))
(define/go (syscall/js.valuePrepareString . args))
(define/go (syscall/js.valueLoadString . args))
(define/go (syscall/js.copyBytesToGo sp))
(define/go (syscall/js.copyBytesToJS sp)
(define dst (load-value (+ sp 8)))
(define src (load-slice (+ sp 16)))
(define dst-buf (hash-ref dst "buf"))
(for ([(b idx) (in-indexed src)])
(bytes-set! dst-buf idx b))
(begin0 null
(store-s64 (+ sp 40) (bytes-length src))
(store-u8 (+ sp 48) 1)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.