crook

Author: dvanhorn

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)))
+

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,15 +45,15 @@
           (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))]
     ['eof-object?
      (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

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)

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)

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

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)

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"))
 

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)))
+