8.14.0.2
6 Advanced Examples
6.1 Self-modifying adder
#lang typed/racket (require x64asm) (define-cast adder #:type (Fixnum -> Fixnum) #:ctype (_fun _int -> _int)) (define-cast adder-get #:type (-> Fixnum) #:ctype (_fun -> _int)) (define arg0 (if (eq? (system-type) 'windows) ecx edi)) (define (make-adder/get [init : Integer]) (parameterize ([current-context (make-context)]) (with-labels #:captured () (:! (label inc)) (add (mref 32 rip + (rel32 (label d))) arg0) (mov eax (imm32 init #:! (label d))) (ret) (:! (label get)) (mov eax (moff 32 (imm64 (label d)))) (ret) (emit-code!) (values (adder (label-addr (label inc))) (adder-get (label-addr (label get)))))))
Examples:
> (define-values (add! get) (make-adder/get 100)) > (add! 10) - : Integer [more precisely: Fixnum]
110
> (get) - : Integer [more precisely: Fixnum]
110
> (add! 25) - : Integer [more precisely: Fixnum]
135
> (get) - : Integer [more precisely: Fixnum]
135
6.2 Computed goto
#lang typed/racket (require x64asm) (define-cast int->int #:type (Integer -> Integer) #:ctype (_fun _int64 -> _int64)) (define arg0 (if (eq? (system-type) 'windows) rcx rdi)) (define-λ! f int->int #:captured (mov rax (imm64 (label data))) (jmp (mref 64 rax + arg0 * 8)) (:! (label here)) (mov eax (imm32 100)) (ret) (:! (label l1)) (mov eax (imm32 200)) (ret) (:! (label l2)) (mov eax (imm32 300)) (ret) (:! (label data)) (data! (imm64 (label here)) (imm64 (label l1)) (imm64 (label l2)))) ;;; This one use a smaller table (define-λ! g int->int #:captured (lea rdx (mref 64 rip + (rel32 (label data)))) (movzx rdx (mref 8 rdx + arg0 * 1)) (lea rax (mref 64 rip + (rel32 (label here)))) (add rax rdx) (jmp rax) (:! (label here)) (mov eax (imm32 100)) (ret) (:! (label l1)) (mov eax (imm32 200)) (ret) (:! (label l2)) (mov eax (imm32 300)) (ret) (:! (label data)) (define (dist [a : Label] [b : Label]) (latent-imm 8 (λ () (- (label-addr b) (label-addr a))))) (data! (imm8 0) (dist (label here) (label l1)) (dist (label here) (label l2))))
Examples:
6.3 Calling C functions
#lang typed/racket (module asin racket/base (require ffi/unsafe) (define asin (cast (ffi-obj-ref "asin" #f) _pointer _uintptr)) (provide asin)) (require/typed 'asin [asin Integer]) (require x64asm) (define-cast ->d #:type (-> Flonum Flonum) #:ctype (_fun _double -> _double)) (define-λ! tail ->d (mov rax (imm64 asin)) (jmp rax)) (define-λ! non-tail ->d (push rbp) (mov rbp rsp) ;;shadow space (when (eq? (system-type) 'windows) (sub rsp (imm8 32))) (mov rax (imm64 asin)) (call rax) (addsd xmm0 xmm0) (leave) (ret))
Examples:
> (non-tail 1.0) - : Flonum
3.141592653589793
> (tail 1.0) - : Flonum
1.5707963267948966
6.4 Error handling via NOP
Here is an advanced example about error handling via nop in caller side.
The code sums a tree of fixnums, but returns #f when a non-fixnum is encountered.
#lang racket (require ffi/unsafe x64asm/untyped) (define err-offset (let ([asm (make-assembler)] [ctx (make-context)] [l (label)] [i (label)]) (:! l #:ctx ctx) (nop #:ctx ctx (mref 32 + (imm32 0 #:! i))) (emit-code! asm ctx) (assembler-shutdown-all! asm) (- (label-addr i) (label-addr l)))) (define (call/on-error target err) (call (rel32 target)) (define here (label)) (:! here) (nop (mref 32 + (latent-imm 32 (λ () (- (label-addr err) (label-addr here))))))) (define (ret-error) (pop r8) (mov r9d (mref 32 r8 + (imm8 err-offset))) (add r8 r9) (jmp r8)) ;;; defines some helper functions to handle platform specific thing as much as possible (define ptr-false (case (system-type 'gc) [(3m) (cast #f _racket _uintptr)] [(cs) 6])) (define notpairp (case (system-type 'gc) [(3m) (λ (p) (mov r8w (mref 16 p)) (cmp r8w (imm8 62)) jne)] [(cs) (λ (p) (mov r8 p) (and r8b (imm8 7)) (cmp r8b (imm8 1)) jne)])) (define notfixp (case (system-type 'gc) [(3m) (λ (p) (mov r8 p) (and r8b (imm8 1)) jz)] [(cs) (λ (p) (mov r8 p) (and r8b (imm8 7)) jnz)])) (define unfix (case (system-type 'gc) [(3m) (λ (p) (sar p (imm8 1)))] [(cs) (λ (p) (sar p (imm8 3)))])) (define fix (case (system-type 'gc) [(3m) (λ (p) (shl p (imm8 1)) (or p (imm8 1)))] [(cs) (λ (p) (shl p (imm8 3)))])) (define arg0 (if (eq? (system-type) 'windows) rcx rdi)) (define-values (car-offset cdr-offset) (case (system-type 'gc) [(3m) (values 8 16)] [(cs) (values 7 15)])) ;;; Since interior nodes don't do anything but pop on error in this example, ;;; an alternative approach may be recording the stack pointer at the beginning, ;;; restoring it when a object neighter pair nor fixnum is encountered, ;;; and then return with false. (define-cast a->a #:type (Any -> Any) #:ctype (_fun _racket -> _racket)) (define-λ! sum-tree-fixnums a->a #:captured (push rbp) (mov rbp rsp) (call/on-error (label inner) (label err)) (fix rax) (:! (label err)) (leave) (ret) (:! (label inner)) ((notfixp arg0) (rel8 (label not-fix))) (mov rax arg0) (unfix rax) (ret) (:! (label not-fix)) ((notpairp arg0) (rel8 (label invalid))) (push arg0) (mov arg0 (mref 64 arg0 + (imm8 car-offset))) (call/on-error (label inner) (label child-err)) (pop arg0) (mov arg0 (mref 64 arg0 + (imm8 cdr-offset))) (push rax) (call/on-error (label inner) (label child-err)) (pop r8) (add rax r8) (ret) (:! (label child-err)) (pop r8) (ret-error) (:! (label invalid)) (mov rax (imm64 ptr-false)) (ret-error))