;; bytecode return (define (emit-return n) (cond ((eq? n 0) (emit-byte-code 0)) ((eq? n 1) (emit-byte-code 1)) (else (begin (emit-byte-code 2) (emit-byte-code-check n))))) ;; bytecode literal (define (emit-literal slot) (case slot ((0) (emit-byte-code 3)) ((1) (emit-byte-code 4)) ((2) (emit-byte-code 5)) ((3) (emit-byte-code 6)) ((4) (emit-byte-code 7)) ((5) (emit-byte-code 8)) (else (begin (emit-byte-code 9) (emit-byte-code-check slot))))) ;; bytecode closure (define (emit-closure slot) (begin (emit-byte-code 10) (emit-byte-code-check slot))) ;; bytecode apply (define (emit-apply n) (case n ((0) (emit-byte-code 11)) ((1) (emit-byte-code 12)) ((2) (emit-byte-code 13)) ((3) (emit-byte-code 14)) ((4) (emit-byte-code 15)) (else (begin (emit-byte-code 16) (emit-byte-code-check n))))) ;; bytecode reg-set (define (emit-reg-set n) (case n ((0) (emit-byte-code 17)) ((1) (emit-byte-code 18)) ((2) (emit-byte-code 19)) (else (if (< n 10) (begin (emit-byte-code 20) (emit-byte-code-check n)) (begin (emit-byte-code 21) (emit-byte-code-check n)))))) ;; bytecode reg-ref (define (emit-reg-ref n) (case n ((0) (emit-byte-code 22)) ((1) (emit-byte-code 23)) ((2) (emit-byte-code 24)) (else (if (< n 10) (begin (emit-byte-code 25) (emit-byte-code-check n)) (begin (emit-byte-code 26) (emit-byte-code-check n)))))) ;; bytecode reg-xfer (define (emit-reg-xfer from to) (case from ((0) (case to ((1) (emit-byte-code 27)) ((2) (emit-byte-code 28)) ((3) (emit-byte-code 29)) (else (if (< to 10) (begin (emit-byte-code 30) (emit-byte-code-check to)) (begin (emit-byte-code 31) (emit-byte-code-check to)))))) ((1) (case to ((0) (emit-byte-code 32)) ((2) (emit-byte-code 33)) ((3) (emit-byte-code 34)) (else (if (< to 10) (begin (emit-byte-code 35) (emit-byte-code-check to)) (begin (emit-byte-code 36) (emit-byte-code-check to)))))) ((2) (case to ((0) (emit-byte-code 37)) ((1) (emit-byte-code 38)) ((3) (emit-byte-code 39)) (else (if (< to 10) (begin (emit-byte-code 40) (emit-byte-code-check to)) (begin (emit-byte-code 41) (emit-byte-code-check to)))))) ((3) (case to ((0) (emit-byte-code 42)) ((1) (emit-byte-code 43)) ((2) (emit-byte-code 44)) (else (if (< to 10) (begin (emit-byte-code 45) (emit-byte-code-check to)) (begin (emit-byte-code 46) (emit-byte-code-check to)))))) (else (case to ((0) (if (< from 10) (begin (emit-byte-code 47) (emit-byte-code-check from)) (begin (emit-byte-code 48) (emit-byte-code-check from)))) ((1) (if (< from 10) (begin (emit-byte-code 49) (emit-byte-code-check from)) (begin (emit-byte-code 50) (emit-byte-code-check from)))) ((2) (if (< from 10) (begin (emit-byte-code 51) (emit-byte-code-check from)) (begin (emit-byte-code 52) (emit-byte-code-check from)))) ((3) (if (< from 10) (begin (emit-byte-code 53) (emit-byte-code-check from)) (begin (emit-byte-code 54) (emit-byte-code-check from)))) (else (if (< from 10) (if (< to 10) (begin (emit-byte-code 55) (emit-byte-code-check from) (emit-byte-code-check to)) (begin (emit-byte-code 56) (emit-byte-code-check from) (emit-byte-code-check to))) (if (< to 10) (begin (emit-byte-code 57) (emit-byte-code-check from) (emit-byte-code-check to)) (begin (emit-byte-code 58) (emit-byte-code-check from) (emit-byte-code-check to))))))))) ;; bytecode pop (define (emit-pop) (emit-byte-code 59)) ;; bytecode lex-ref (define (emit-lex-ref frame slot) (case frame ((0) (case slot ((0) (emit-byte-code 60)) ((1) (emit-byte-code 61)) ((2) (emit-byte-code 62)) (else (begin (emit-byte-code 63) (emit-byte-code-check slot))))) ((1) (case slot ((0) (emit-byte-code 64)) ((1) (emit-byte-code 65)) ((2) (emit-byte-code 66)) (else (begin (emit-byte-code 67) (emit-byte-code-check slot))))) ((2) (case slot ((0) (emit-byte-code 68)) ((1) (emit-byte-code 69)) ((2) (emit-byte-code 70)) (else (begin (emit-byte-code 71) (emit-byte-code-check slot))))) (else (begin (emit-byte-code 72) (emit-byte-code-check frame) (emit-byte-code-check slot))))) ;; bytecode lex-set (define (emit-lex-set frame slot) (case frame ((0) (case slot ((0) (emit-byte-code 73)) ((1) (emit-byte-code 74)) ((2) (emit-byte-code 75)) (else (begin (emit-byte-code 76) (emit-byte-code-check slot))))) ((1) (case slot ((0) (emit-byte-code 77)) ((1) (emit-byte-code 78)) ((2) (emit-byte-code 79)) (else (begin (emit-byte-code 80) (emit-byte-code-check slot))))) ((2) (case slot ((0) (emit-byte-code 81)) ((1) (emit-byte-code 82)) ((2) (emit-byte-code 83)) (else (begin (emit-byte-code 84) (emit-byte-code-check slot))))) (else (begin (emit-byte-code 85) (emit-byte-code-check frame) (emit-byte-code-check slot))))) ;; bytecode tl-ref (define (emit-tl-ref i) (begin (emit-byte-code 86) (emit-byte-code-check i))) ;; bytecode tl-set (define (emit-tl-set i) (begin (emit-byte-code 87) (emit-byte-code-check i))) ;; bytecode immob (define (emit-immob x) (case x ((#t) (emit-byte-code 88)) ((#f) (emit-byte-code 89)) ((()) (emit-byte-code 90)) (else (cond ((ascii-char? x) (begin (emit-byte-code 91) (emit-byte-code-check (ascii-char->integer x)))) ((unicode-char? x) (begin (emit-byte-code 92) (emit-byte-code-16-check (unicode-char->integer x)))) ((unique-obj? x) (begin (emit-byte-code 93) (emit-byte-code-check (get-immob-value x)))) (else (begin (emit-byte-code 94) (emit-byte-code-16-check (obj-high-bits x)) (emit-byte-code-16-check (obj-low-bits x)))))))) ;; bytecode make-primop (define (emit-make-primop num-args) (begin (emit-byte-code 95) (emit-byte-code-check (- num-args 1)))) ;; bytecode special-primop (define (emit-special-primop op num-args) (case op ((cons) (assert (= num-args 2)) (emit-byte-code 96)) ((car) (assert (= num-args 1)) (emit-byte-code 97)) ((cdr) (assert (= num-args 1)) (emit-byte-code 98)) ((make) (emit-make-primop num-args)) (else (error/internal "special-primop not defined: ~s" op)))) ;; bytecode save (define (emit-save n l) (case n ((0) (begin (emit-byte-code 99) (emit-byte-code-16-check (ref-label l)))) ((1) (begin (emit-byte-code 100) (emit-byte-code-16-check (ref-label l)))) ((2) (begin (emit-byte-code 101) (emit-byte-code-16-check (ref-label l)))) ((3) (begin (emit-byte-code 102) (emit-byte-code-16-check (ref-label l)))) ((4) (begin (emit-byte-code 103) (emit-byte-code-16-check (ref-label l)))) ((5) (begin (emit-byte-code 104) (emit-byte-code-16-check (ref-label l)))) (else (begin (emit-byte-code 105) (emit-byte-code-check n) (emit-byte-code-16-check (ref-label l)))))) ;; bytecode restore (define (emit-restore n) (case n ((0) (emit-byte-code 106)) ((1) (emit-byte-code 107)) ((2) (emit-byte-code 108)) ((3) (emit-byte-code 109)) ((4) (emit-byte-code 110)) ((5) (emit-byte-code 111)) (else (begin (emit-byte-code 112) (emit-byte-code-check n))))) ;; bytecode jump (define (emit-jump n l) (begin (emit-byte-code 113) (emit-byte-code-16-check (ref-label l)))) ;; bytecode bjump (define (emit-bjump n l) (begin (emit-byte-code 114) (emit-byte-code-check n) (emit-byte-code-16-check (ref-label l)))) ;; bytecode branch-if-false (define (emit-branch-if-false l) (begin (emit-byte-code 115) (emit-byte-code-16-check (ref-label l)))) ;; bytecode check= (define (emit-check= n) (case n ((0) (emit-byte-code 116)) ((1) (emit-byte-code 117)) ((2) (emit-byte-code 118)) ((3) (emit-byte-code 119)) ((4) (emit-byte-code 120)) (else (begin (emit-byte-code 121) (emit-byte-code-check n))))) ;; bytecode check>= (define (emit-check>= n) (if (> n 0) (begin (emit-byte-code 122) (emit-byte-code-check n)))) ;; bytecode set-false< (define (emit-set-false< n) (case n ((0)) ((1) (emit-byte-code 123)) ((2) (emit-byte-code 124)) (else (begin (emit-byte-code 125) (emit-byte-code-check n))))) ;; bytecode collect> (define (emit-collect> n) (case n ((0) (emit-byte-code 126)) ((1) (emit-byte-code 127)) ((2) (emit-byte-code 128)) ((3) (emit-byte-code 129)) (else (begin (emit-byte-code 130) (emit-byte-code-check n))))) ;; bytecode unbind (define (emit-unbind) (emit-byte-code 131)) ;; bytecode bind-first-regs (define (emit-bind-first-regs n) (case n ((1) (emit-byte-code 132)) ((2) (emit-byte-code 133)) ((3) (emit-byte-code 134)) ((4) (emit-byte-code 135)) ((5) (emit-byte-code 136)) (else (begin (emit-byte-code 137) (emit-byte-code-check n))))) ;; bytecode bind (define (emit-bind n) (case n ((1) (emit-byte-code 138)) ((2) (emit-byte-code 139)) ((3) (emit-byte-code 140)) ((4) (emit-byte-code 141)) ((5) (emit-byte-code 142)) (else (begin (emit-byte-code 143) (emit-byte-code-check n))))) ;; bytecode raw-int (define (emit-raw-int n) (if (and (>= n 0) (< n 256)) (if (eq? n 0) (emit-byte-code 144) (if (eq? n 1) (emit-byte-code 145) (begin (emit-byte-code 146) (emit-byte-code-check n)))) (if (and (< n 0) (> n -257)) (begin (emit-byte-code 147) (emit-byte-code-check (+ n 256))) (if (and (>= n -32768) (< n 32768)) (begin (emit-byte-code 148) (emit-byte-code-s16-check n)) (begin (emit-byte-code 149) (emit-byte-code-s32 n)))))) ;; bytecode fixnum (define (emit-fixnum n) (if (and (>= n 0) (< n 256)) (case n ((0) (emit-byte-code 150)) ((1) (emit-byte-code 151)) (else (begin (emit-byte-code 152) (emit-byte-code-check n)))) (if (and (< n 0) (> n -257)) (begin (emit-byte-code 153) (emit-byte-code-check (+ n 256))) (if (and (>= n -32768) (< n 32768)) (begin (emit-byte-code 154) (emit-byte-code-s16-check n)) (begin (emit-byte-code 155) (emit-byte-code-s32 n)))))) ;; bytecode raw-bool (define (emit-raw-bool r) (if r (emit-byte-code 156) (emit-byte-code 157))) ;; bytecode this-function (define (emit-this-function) (emit-byte-code 158)) ;; bytecode use-function-envt (define (emit-use-function-envt) (emit-byte-code 159)) ;; bytecode use-empty-envt (define (emit-use-empty-envt) (emit-byte-code 160)) ;; bytecode gvec-load (define (emit-gvec-load index) (begin (emit-byte-code 161) (emit-byte-code-check index))) ;; bytecode gvec-store (define (emit-gvec-store index) (begin (emit-byte-code 162) (emit-byte-code-check index))) ;; bytecode applyf (define (emit-applyf n) (case n ((0) (emit-byte-code 163)) ((1) (emit-byte-code 164)) ((2) (emit-byte-code 165)) ((3) (emit-byte-code 166)) ((4) (emit-byte-code 167)) (else (begin (emit-byte-code 168) (emit-byte-code-check n))))) ;; bytecode applyg (define (emit-applyg n) (case n ((1) (emit-byte-code 169)) ((2) (emit-byte-code 170)) ((3) (emit-byte-code 171)) (else (begin (emit-byte-code 172) (emit-byte-code-check n))))) ;; bytecode tl-ref/bound (define (emit-tl-ref/bound i) (case i ((0) (emit-byte-code 173)) ((1) (emit-byte-code 174)) ((2) (emit-byte-code 175)) ((3) (emit-byte-code 176)) ((4) (emit-byte-code 177)) ((5) (emit-byte-code 178)) ((6) (emit-byte-code 179)) ((7) (emit-byte-code 180)) ((8) (emit-byte-code 181)) ((9) (emit-byte-code 182)) (else (begin (emit-byte-code 183) (emit-byte-code-check i)))))