diff --git a/iniquity-plus/assert.rkt b/iniquity-plus/assert.rkt new file mode 100644 index 0000000..de6da68 --- /dev/null +++ b/iniquity-plus/assert.rkt @@ -0,0 +1,69 @@ +#lang racket +(provide assert-integer assert-char assert-byte assert-codepoint + assert-box assert-cons + assert-natural assert-vector assert-string) +(require a86/ast) +(require "types.rkt") + +(define r9 'r9) + +(define (assert-type mask type) + (λ (arg) + (seq (Mov r9 arg) + (And r9 mask) + (Cmp r9 type) + (Jne 'err)))) + +;; Register -> Asm + + +(define assert-integer + (assert-type mask-int type-int)) + +;; Register -> Asm + + +(define assert-char + (assert-type mask-char type-char)) + + + + +(define assert-box + (assert-type ptr-mask type-box)) +(define assert-cons + (assert-type ptr-mask type-cons)) +(define assert-vector + (assert-type ptr-mask type-vect)) +(define assert-string + (assert-type ptr-mask type-str)) + +;; Register -> Asm +(define (assert-codepoint r) + (let ((ok (gensym))) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err) + (Cmp r (value->bits 1114111)) + (Jg 'err) + (Cmp r (value->bits 55295)) + (Jl ok) + (Cmp r (value->bits 57344)) + (Jg ok) + (Jmp 'err) + (Label ok)))) + +;; Register -> Asm +(define (assert-byte r) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err) + (Cmp r (value->bits 255)) + (Jg 'err))) + +;; Register -> Asm +(define (assert-natural r) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err))) + diff --git a/iniquity-plus/compile-ops.rkt b/iniquity-plus/compile-ops.rkt index 4dd9235..78e9038 100644 --- a/iniquity-plus/compile-ops.rkt +++ b/iniquity-plus/compile-ops.rkt @@ -2,6 +2,7 @@ (provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack assert-cons) (require "ast.rkt") (require "types.rkt") +(require "assert.rkt") (require a86/ast) (define rax 'rax) @@ -44,7 +45,7 @@ (Sar rax char-shift) (Sal rax int-shift))] ['integer->char - (seq (assert-codepoint) + (seq (assert-codepoint rax) (Sar rax int-shift) (Sal rax char-shift) (Xor rax type-char))] @@ -52,7 +53,7 @@ (seq (Cmp rax (value->bits eof)) if-equal)] ['write-byte - (seq assert-byte + (seq (assert-byte rax) pad-stack (Mov rdi rax) (Call 'write_byte) @@ -270,71 +271,25 @@ (Mov (Offset r8 8) rax) (Mov rax (value->bits (void))))])) +(define (type-pred mask type) + (seq (And rax mask) + (Cmp rax type) + if-equal)) -;; -> Asm +;; Asm ;; set rax to #t or #f if comparison flag is equal (define if-equal (seq (Mov rax (value->bits #f)) (Mov r9 (value->bits #t)) (Cmove rax r9))) -;; -> Asm +;; Asm ;; set rax to #t or #f if comparison flag is less than (define if-lt (seq (Mov rax (value->bits #f)) (Mov r9 (value->bits #t)) (Cmovl rax r9))) -(define (assert-type mask type) - (λ (arg) - (seq (Mov r9 arg) - (And r9 mask) - (Cmp r9 type) - (Jne 'err)))) - -(define (type-pred mask type) - (seq (And rax mask) - (Cmp rax type) - if-equal)) - -(define assert-integer - (assert-type mask-int type-int)) -(define assert-char - (assert-type mask-char type-char)) -(define assert-box - (assert-type ptr-mask type-box)) -(define assert-cons - (assert-type ptr-mask type-cons)) -(define assert-vector - (assert-type ptr-mask type-vect)) -(define assert-string - (assert-type ptr-mask type-str)) - -(define (assert-codepoint) - (let ((ok (gensym))) - (seq (assert-integer rax) - (Cmp rax (value->bits 0)) - (Jl 'err) - (Cmp rax (value->bits 1114111)) - (Jg 'err) - (Cmp rax (value->bits 55295)) - (Jl ok) - (Cmp rax (value->bits 57344)) - (Jg ok) - (Jmp 'err) - (Label ok)))) - -(define assert-byte - (seq (assert-integer rax) - (Cmp rax (value->bits 0)) - (Jl 'err) - (Cmp rax (value->bits 255)) - (Jg 'err))) - -(define (assert-natural r) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'err))) ;; Asm ;; Dynamically pad the stack to be aligned for a call diff --git a/iniquity-plus/exec-io.rkt b/iniquity-plus/exec-io.rkt index 1b112b4..fb1d306 100644 --- a/iniquity-plus/exec-io.rkt +++ b/iniquity-plus/exec-io.rkt @@ -1,7 +1,6 @@ #lang racket (require a86/interp) (require "compile.rkt") -(require "interp-io.rkt") (require "types.rkt") (require "build-runtime.rkt") (provide exec/io) diff --git a/iniquity-plus/exec.rkt b/iniquity-plus/exec.rkt index c2fa74e..959a509 100644 --- a/iniquity-plus/exec.rkt +++ b/iniquity-plus/exec.rkt @@ -1,7 +1,6 @@ #lang racket (require a86/interp) (require "compile.rkt") -(require "interp.rkt") (require "types.rkt") (require "build-runtime.rkt") (provide exec) diff --git a/iniquity-plus/interp-io.rkt b/iniquity-plus/interp-io.rkt index 11d24fd..b17cc96 100644 --- a/iniquity-plus/interp-io.rkt +++ b/iniquity-plus/interp-io.rkt @@ -3,7 +3,7 @@ (require "interp.rkt") ;; String Prog -> (Cons Value String) ;; Interpret p with given string as input, -;; return value and collected output as string +;; return answer and collected output as string (define (interp/io p input) (define result (box #f)) (define output diff --git a/iniquity-plus/interp.rkt b/iniquity-plus/interp.rkt index 3603ddd..166a7f4 100644 --- a/iniquity-plus/interp.rkt +++ b/iniquity-plus/interp.rkt @@ -16,6 +16,8 @@ ;; | (string Character ...) ;; | (vector Value ...) +;; type Answer = Value | 'err + ;; type Env = (Listof (List Id Value)) ;; Prog -> Answer (define (interp p) diff --git a/iniquity-plus/main.rkt b/iniquity-plus/main.rkt index e0e3892..49636c1 100644 --- a/iniquity-plus/main.rkt +++ b/iniquity-plus/main.rkt @@ -2,12 +2,19 @@ (require "ast.rkt") (require "parse.rkt") (require "interp.rkt") +(require "interp-io.rkt") (require "compile.rkt") +(require "types.rkt") (require "run.rkt") +(require "exec.rkt") +(require "exec-io.rkt") (provide (all-from-out "ast.rkt")) (provide (all-from-out "parse.rkt")) (provide (all-from-out "interp.rkt")) +(provide (all-from-out "interp-io.rkt")) (provide (all-from-out "compile.rkt")) +(provide (all-from-out "types.rkt")) (provide (all-from-out "run.rkt")) - +(provide (all-from-out "exec.rkt")) +(provide (all-from-out "exec-io.rkt")) diff --git a/knock-plus/assert.rkt b/knock-plus/assert.rkt new file mode 100644 index 0000000..de6da68 --- /dev/null +++ b/knock-plus/assert.rkt @@ -0,0 +1,69 @@ +#lang racket +(provide assert-integer assert-char assert-byte assert-codepoint + assert-box assert-cons + assert-natural assert-vector assert-string) +(require a86/ast) +(require "types.rkt") + +(define r9 'r9) + +(define (assert-type mask type) + (λ (arg) + (seq (Mov r9 arg) + (And r9 mask) + (Cmp r9 type) + (Jne 'err)))) + +;; Register -> Asm + + +(define assert-integer + (assert-type mask-int type-int)) + +;; Register -> Asm + + +(define assert-char + (assert-type mask-char type-char)) + + + + +(define assert-box + (assert-type ptr-mask type-box)) +(define assert-cons + (assert-type ptr-mask type-cons)) +(define assert-vector + (assert-type ptr-mask type-vect)) +(define assert-string + (assert-type ptr-mask type-str)) + +;; Register -> Asm +(define (assert-codepoint r) + (let ((ok (gensym))) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err) + (Cmp r (value->bits 1114111)) + (Jg 'err) + (Cmp r (value->bits 55295)) + (Jl ok) + (Cmp r (value->bits 57344)) + (Jg ok) + (Jmp 'err) + (Label ok)))) + +;; Register -> Asm +(define (assert-byte r) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err) + (Cmp r (value->bits 255)) + (Jg 'err))) + +;; Register -> Asm +(define (assert-natural r) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err))) + diff --git a/knock-plus/compile-ops.rkt b/knock-plus/compile-ops.rkt index 645e7bd..95820c8 100644 --- a/knock-plus/compile-ops.rkt +++ b/knock-plus/compile-ops.rkt @@ -2,6 +2,7 @@ (provide compile-op0 compile-op1 compile-op2 compile-op3 compile-opN pad-stack) (require "ast.rkt") (require "types.rkt") +(require "assert.rkt") (require a86/ast) (define rax 'rax) @@ -44,7 +45,7 @@ (Sar rax char-shift) (Sal rax int-shift))] ['integer->char - (seq (assert-codepoint) + (seq (assert-codepoint rax) (Sar rax int-shift) (Sal rax char-shift) (Xor rax type-char))] @@ -52,7 +53,7 @@ (seq (Cmp rax (value->bits eof)) if-equal)] ['write-byte - (seq assert-byte + (seq (assert-byte rax) pad-stack (Mov rdi rax) (Call 'write_byte) @@ -304,71 +305,25 @@ (Mov (Offset 'rbx (* 8 n)) r9) (compile-op-vect (sub1 n)))])) +(define (type-pred mask type) + (seq (And rax mask) + (Cmp rax type) + if-equal)) -;; -> Asm +;; Asm ;; set rax to #t or #f if comparison flag is equal (define if-equal (seq (Mov rax (value->bits #f)) (Mov r9 (value->bits #t)) (Cmove rax r9))) -;; -> Asm +;; Asm ;; set rax to #t or #f if comparison flag is less than (define if-lt (seq (Mov rax (value->bits #f)) (Mov r9 (value->bits #t)) (Cmovl rax r9))) -(define (assert-type mask type) - (λ (arg) - (seq (Mov r9 arg) - (And r9 mask) - (Cmp r9 type) - (Jne 'err)))) - -(define (type-pred mask type) - (seq (And rax mask) - (Cmp rax type) - if-equal)) - -(define assert-integer - (assert-type mask-int type-int)) -(define assert-char - (assert-type mask-char type-char)) -(define assert-box - (assert-type ptr-mask type-box)) -(define assert-cons - (assert-type ptr-mask type-cons)) -(define assert-vector - (assert-type ptr-mask type-vect)) -(define assert-string - (assert-type ptr-mask type-str)) - -(define (assert-codepoint) - (let ((ok (gensym))) - (seq (assert-integer rax) - (Cmp rax (value->bits 0)) - (Jl 'err) - (Cmp rax (value->bits 1114111)) - (Jg 'err) - (Cmp rax (value->bits 55295)) - (Jl ok) - (Cmp rax (value->bits 57344)) - (Jg ok) - (Jmp 'err) - (Label ok)))) - -(define assert-byte - (seq (assert-integer rax) - (Cmp rax (value->bits 0)) - (Jl 'err) - (Cmp rax (value->bits 255)) - (Jg 'err))) - -(define (assert-natural r) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'err))) ;; Asm ;; Dynamically pad the stack to be aligned for a call diff --git a/knock-plus/exec-io.rkt b/knock-plus/exec-io.rkt index 1b112b4..fb1d306 100644 --- a/knock-plus/exec-io.rkt +++ b/knock-plus/exec-io.rkt @@ -1,7 +1,6 @@ #lang racket (require a86/interp) (require "compile.rkt") -(require "interp-io.rkt") (require "types.rkt") (require "build-runtime.rkt") (provide exec/io) diff --git a/knock-plus/exec.rkt b/knock-plus/exec.rkt index c2fa74e..959a509 100644 --- a/knock-plus/exec.rkt +++ b/knock-plus/exec.rkt @@ -1,7 +1,6 @@ #lang racket (require a86/interp) (require "compile.rkt") -(require "interp.rkt") (require "types.rkt") (require "build-runtime.rkt") (provide exec) diff --git a/knock-plus/interp-io.rkt b/knock-plus/interp-io.rkt index 11d24fd..b17cc96 100644 --- a/knock-plus/interp-io.rkt +++ b/knock-plus/interp-io.rkt @@ -3,7 +3,7 @@ (require "interp.rkt") ;; String Prog -> (Cons Value String) ;; Interpret p with given string as input, -;; return value and collected output as string +;; return answer and collected output as string (define (interp/io p input) (define result (box #f)) (define output diff --git a/knock-plus/interp.rkt b/knock-plus/interp.rkt index 93c1023..dcb86d6 100644 --- a/knock-plus/interp.rkt +++ b/knock-plus/interp.rkt @@ -17,6 +17,8 @@ ;; | (string Character ...) ;; | (vector Value ...) +;; type Answer = Value | 'err + ;; type Env = (Listof (List Id Value)) ;; Prog -> Answer (define (interp p) diff --git a/knock-plus/main.rkt b/knock-plus/main.rkt index e0e3892..49636c1 100644 --- a/knock-plus/main.rkt +++ b/knock-plus/main.rkt @@ -2,12 +2,19 @@ (require "ast.rkt") (require "parse.rkt") (require "interp.rkt") +(require "interp-io.rkt") (require "compile.rkt") +(require "types.rkt") (require "run.rkt") +(require "exec.rkt") +(require "exec-io.rkt") (provide (all-from-out "ast.rkt")) (provide (all-from-out "parse.rkt")) (provide (all-from-out "interp.rkt")) +(provide (all-from-out "interp-io.rkt")) (provide (all-from-out "compile.rkt")) +(provide (all-from-out "types.rkt")) (provide (all-from-out "run.rkt")) - +(provide (all-from-out "exec.rkt")) +(provide (all-from-out "exec-io.rkt"))