Add some more opcodes for comparison with numeric types.

2025-02-02 18:29:10 +00:00 · 2018-05-07 12:34:04 -04:00 · 2018-05-07 12:34:04 -04:00 · 0cd6cdc28b
commit 0cd6cdc28b
parent 104b09d848
7 changed files with 206 additions and 50 deletions
--- a/doc/bytecode.md
+++ b/doc/bytecode.md
@ -172,17 +172,24 @@ failure to return or error.
 | `bxor`      | `(bxor dest lhs rhs)`       | $dest = $lhs ^ $rhs               |
 | `call`      | `(call dest callee)`        | $dest = call($callee)             |
 | `clo`       | `(clo dest index)`          | $dest = closure(defs[$index])     |
-| `cmp`       | `(cmp dest lhs rhs)`        | $dest = dst_compare($lhs, $rhs)   |
+| `cmp`       | `(cmp dest lhs rhs)`        | $dest = dst\_compare($lhs, $rhs)  |
 | `debug`     | `(debug)`                   | Suspend current fiber             |
 | `div`       | `(div dest lhs rhs)`        | $dest = $lhs / $rhs               |
 | `divi`      | `(divi dest lhs rhs)`       | $dest = $lhs /i $rhs              |
 | `divim`     | `(divim dest lhs im)`       | $dest = $lhs /i im                |
 | `divr`      | `(divr dest lhs rhs)`       | $dest = $lhs /r $rhs              |
 | `eq`        | `(eq dest lhs rhs)`         | $dest = $lhs == $rhs              |
+| `eqi`       | `(eqi dest lhs rhs)`        | $dest = $lhs ==i $rhs             |
+| `eqim`      | `(eqim dest lhs im)`        | $dest = $lhs ==i im               |
+| `eqr`       | `(eqr dest lhs rhs)`        | $dest = $lhs ==r $rhs             |
 | `err`       | `(err message)`             | Throw error $message.             |
 | `get`       | `(get dest ds key)`         | $dest = $ds[$key]                 |
 | `geti`      | `(geti dest ds index)`      | $dest = $ds[index]                |
 | `gt`        | `(gt dest lhs rhs)`         | $dest = $lhs > $rhs               |
+| `gti`       | `(gti dest lhs rhs)`        | $dest = $lhs \>i $rhs             |
+| `gtim`      | `(gtim dest lhs im)`        | $dest = $lhs \>i im               |
+| `gtr`       | `(gtr dest lhs rhs)`        | $dest = $lhs \>r $rhs             |
+| `gter`      | `(gter dest lhs rhs)`       | $dest = $lhs >=r $rhs             |
 | `jmp`       | `(jmp label)`               | pc = label, pc += offset          |
 | `jmpif`     | `(jmpif cond label)`        | if $cond pc = label else pc++     |
 | `jmpno`     | `(jmpno cond label)`        | if $cond pc++ else pc = label     |
@ -194,6 +201,10 @@ failure to return or error.
 | `ldt`       | `(ldt dest)`                | $dest = true                      |
 | `ldu`       | `(ldu dest env index)`      | $dest = envs[env][index]          |
 | `lt`        | `(lt dest lhs rhs)`         | $dest = $lhs < $rhs               |
+| `lti`       | `(lti dest lhs rhs)`        | $dest = $lhs \<i $rhs             |
+| `ltim`      | `(ltim dest lhs im)`        | $dest = $lhs \<i im               |
+| `ltr`       | `(ltr dest lhs rhs)`        | $dest = $lhs \<r $rhs             |
+| `lter`      | `(lter dest lhs rhs)`       | $dest = $lhs <=r $rhs             |
 | `movf`      | `(movf src dest)`           | $dest = $src                      |
 | `movn`      | `(movn dest src)`           | $dest = $src                      |
 | `mul`       | `(mul dest lhs rhs)`        | $dest = $lhs * $rhs               |
--- a/src/assembler/asm.c
+++ b/src/assembler/asm.c
@ -93,10 +93,17 @@ static const DstInstructionDef dst_ops[] = {
    {"divim", DOP_DIVIDE_IMMEDIATE},
    {"divr", DOP_DIVIDE_REAL},
    {"eq", DOP_EQUALS},
+    {"eqi", DOP_EQUALS_INTEGER},
+    {"eqim", DOP_EQUALS_IMMEDIATE},
+    {"eqr", DOP_EQUALS_REAL},
    {"err", DOP_ERROR},
    {"get", DOP_GET},
    {"geti", DOP_GET_INDEX},
    {"gt", DOP_GREATER_THAN},
+    {"gti", DOP_GREATER_THAN_INTEGER},
+    {"gtim", DOP_GREATER_THAN_IMMEDIATE},
+    {"gtr", DOP_GREATER_THAN_REAL},
+    {"gter", DOP_GREATER_THAN_EQUAL_REAL},
    {"jmp", DOP_JUMP},
    {"jmpif", DOP_JUMP_IF},
    {"jmpno", DOP_JUMP_IF_NOT},
@ -108,6 +115,10 @@ static const DstInstructionDef dst_ops[] = {
    {"ldt", DOP_LOAD_TRUE},
    {"ldu", DOP_LOAD_UPVALUE},
    {"lt", DOP_LESS_THAN},
+    {"lti", DOP_LESS_THAN_INTEGER},
+    {"ltim", DOP_LESS_THAN_IMMEDIATE},
+    {"ltr", DOP_LESS_THAN_REAL},
+    {"lter", DOP_LESS_THAN_EQUAL_REAL},
    {"movf", DOP_MOVE_FAR},
    {"movn", DOP_MOVE_NEAR},
    {"mul", DOP_MULTIPLY},
--- a/src/compiler/boot.dst
+++ b/src/compiler/boot.dst
@ -41,6 +41,20 @@
 (apply1 tuple (array-concat
  @['defmacro name :private] more)))

+(defmacro defdo
+ "Define a value inside of a do form."
+ [name & more]
+ (apply1 tuple (array-concat
+  @['def name]
+  (apply1 tuple (array-concat @['do] more)))))
+
+(defmacro defdo-
+ "Define a private value inside of a do form."
+ [name & more]
+ (apply1 tuple (array-concat
+  @['def name :private]
+  (apply1 tuple (array-concat @['do] more)))))
+
 (defmacro defn-
 "Define a private function that will not be exported."
 [name & more]
--- a/src/core/bytecode.c
+++ b/src/core/bytecode.c
@ -62,8 +62,19 @@ enum DstInstructionType dst_instructions[DOP_INSTRUCTION_COUNT] = {
    DIT_SL, /* DOP_JUMP_IF, */
    DIT_SL, /* DOP_JUMP_IF_NOT, */
    DIT_SSS, /* DOP_GREATER_THAN, */
+    DIT_SSS, /* DOP_GREATER_THAN_INTEGER, */
+    DIT_SSI, /* DOP_GREATER_THAN_IMMEDIATE, */
+    DIT_SSS, /* DOP_GREATER_THAN_REAL, */
+    DIT_SSS, /* DOP_GREATER_THAN_EQUAL_REAL, */
    DIT_SSS, /* DOP_LESS_THAN, */
+    DIT_SSS, /* DOP_LESS_THAN_INTEGER, */
+    DIT_SSI, /* DOP_LESS_THAN_IMMEDIATE, */
+    DIT_SSS, /* DOP_LESS_THAN_REAL, */
+    DIT_SSS, /* DOP_LESS_THAN_EQUAL_REAL, */
    DIT_SSS, /* DOP_EQUALS, */
+    DIT_SSS, /* DOP_EQUALS_INTEGER, */
+    DIT_SSI, /* DOP_EQUALS_IMMEDIATE, */
+    DIT_SSS, /* DOP_EQUALS_REAL, */
    DIT_SSS, /* DOP_COMPARE, */
    DIT_S, /* DOP_LOAD_NIL, */
    DIT_S, /* DOP_LOAD_TRUE, */
--- a/src/core/vm.c
+++ b/src/core/vm.c
@ -108,8 +108,19 @@ static void *op_lookup[255] = {
    &&label_DOP_JUMP_IF,
    &&label_DOP_JUMP_IF_NOT,
    &&label_DOP_GREATER_THAN,
+    &&label_DOP_GREATER_THAN_INTEGER,
+    &&label_DOP_GREATER_THAN_IMMEDIATE,
+    &&label_DOP_GREATER_THAN_REAL,
+    &&label_DOP_GREATER_THAN_EQUAL_REAL,
    &&label_DOP_LESS_THAN,
+    &&label_DOP_LESS_THAN_INTEGER,
+    &&label_DOP_LESS_THAN_IMMEDIATE,
+    &&label_DOP_LESS_THAN_REAL,
+    &&label_DOP_LESS_THAN_EQUAL_REAL,
    &&label_DOP_EQUALS,
+    &&label_DOP_EQUALS_INTEGER,
+    &&label_DOP_EQUALS_IMMEDIATE,
+    &&label_DOP_EQUALS_REAL,
    &&label_DOP_COMPARE,
    &&label_DOP_LOAD_NIL,
    &&label_DOP_LOAD_TRUE,
@ -389,6 +400,39 @@ static void *op_lookup[255] = {
    pc++;
    vm_next();

+    /* Candidate */
+    VM_OP(DOP_LESS_THAN_INTEGER)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) <
+            dst_unwrap_integer(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_LESS_THAN_IMMEDIATE)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) < ((*(int32_t *)pc) >> 24)
+    );
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_LESS_THAN_REAL)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_real(stack[oparg(2, 0xFF)]) <
+            dst_unwrap_real(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_LESS_THAN_EQUAL_REAL)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_real(stack[oparg(2, 0xFF)]) <=
+            dst_unwrap_real(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
+
    VM_OP(DOP_GREATER_THAN)
    stack[oparg(1, 0xFF)] = dst_wrap_boolean(dst_compare(
            stack[oparg(2, 0xFF)],
@ -397,6 +441,38 @@ static void *op_lookup[255] = {
    pc++;
    vm_next();

+    /* Candidate */
+    VM_OP(DOP_GREATER_THAN_INTEGER)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) >
+            dst_unwrap_integer(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_GREATER_THAN_IMMEDIATE)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) > ((*(int32_t *)pc) >> 24)
+    );
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_GREATER_THAN_REAL)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_real(stack[oparg(2, 0xFF)]) >
+            dst_unwrap_real(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_GREATER_THAN_EQUAL_REAL)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_real(stack[oparg(2, 0xFF)]) >=
+            dst_unwrap_real(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
    VM_OP(DOP_EQUALS)
    stack[oparg(1, 0xFF)] = dst_wrap_boolean(dst_equals(
            stack[oparg(2, 0xFF)],
@ -405,6 +481,32 @@ static void *op_lookup[255] = {
    pc++;
    vm_next();

+    /* Candidate */
+    VM_OP(DOP_EQUALS_INTEGER)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) ==
+            dst_unwrap_integer(stack[oparg(3, 0xFF)])
+        );
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_EQUALS_REAL)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_real(stack[oparg(2, 0xFF)]) ==
+            dst_unwrap_real(stack[oparg(3, 0xFF)])
+        );
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_EQUALS_IMMEDIATE)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) == ((*(int32_t *)pc) >> 24)
+    );
+    pc++;
+    vm_next();
+
    VM_OP(DOP_COMPARE)
    stack[oparg(1, 0xFF)] = dst_wrap_integer(dst_compare(
        stack[oparg(2, 0xFF)],
--- a/src/include/dst/dstopcodes.h
+++ b/src/include/dst/dstopcodes.h
@ -94,8 +94,19 @@ enum DstOpCode {
    DOP_JUMP_IF,
    DOP_JUMP_IF_NOT,
    DOP_GREATER_THAN,
+    DOP_GREATER_THAN_INTEGER,
+    DOP_GREATER_THAN_IMMEDIATE,
+    DOP_GREATER_THAN_REAL,
+    DOP_GREATER_THAN_EQUAL_REAL,
    DOP_LESS_THAN,
+    DOP_LESS_THAN_INTEGER,
+    DOP_LESS_THAN_IMMEDIATE,
+    DOP_LESS_THAN_REAL,
+    DOP_LESS_THAN_EQUAL_REAL,
    DOP_EQUALS,
+    DOP_EQUALS_INTEGER,
+    DOP_EQUALS_IMMEDIATE,
+    DOP_EQUALS_REAL,
    DOP_COMPARE,
    DOP_LOAD_NIL,
    DOP_LOAD_TRUE,
--- a/src/mainclient/init.dst
+++ b/src/mainclient/init.dst
@ -1,55 +1,51 @@
 (do

-(var *should-repl* :private false)
-(var *no-file* :private true)
-(var *raw-stdin* :private false)
+  (var *should-repl* :private false)
+  (var *no-file* :private true)
+  (var *raw-stdin* :private false)

-# Flag handlers
-(def handlers :private {
-  "h" (fn [] 
-        (print "usage: " (get args 0) " [options] scripts...")
-        (print "Options are:")
-        (print "  -h Show this help")
-        (print "  -v Print the version string")
-        (print "  -s Use raw stdin instead of getline like functionality")
-        (print "  -e Execute a string of dst")
-        (print "  -r Enter the repl after running all scripts")
-        (os-exit 0)
-        1)
-  "v" (fn [] (print VERSION) (os-exit 0) 1)
-  "s" (fn [] (:= *raw-stdin* true) (:= *should-repl* true) 1)
-  "r" (fn [] (:= *should-repl* true) 1)
-  "e" (fn [i] 
-       (:= *no-file* false)
-       (eval (get args (+ i 1)))
-       2)
-})
+  # Flag handlers
+  (def handlers :private {
+                          "h" (fn [] 
+                                  (print "usage: " (get args 0) " [options] scripts...")
+                                  (print "Options are:")
+                                  (print "  -h Show this help")
+                                  (print "  -v Print the version string")
+                                  (print "  -s Use raw stdin instead of getline like functionality")
+                                  (print "  -e Execute a string of dst")
+                                  (print "  -r Enter the repl after running all scripts")
+                                  (os-exit 0)
+                                  1)
+                          "v" (fn [] (print VERSION) (os-exit 0) 1)
+                          "s" (fn [] (:= *raw-stdin* true) (:= *should-repl* true) 1)
+                          "r" (fn [] (:= *should-repl* true) 1)
+                          "e" (fn [i] 
+                                  (:= *no-file* false)
+                                  (eval (get args (+ i 1)))
+                                  2)
+                          })

-(defn- dohandler [n i]
- (def h (get handlers n))
- (if h (h i) (print "unknown flag -" n)))
+  (defn- dohandler [n i]
+    (def h (get handlers n))
+    (if h (h i) (print "unknown flag -" n)))

-# Process arguments
-(var i 1)
-(def lenargs (length args))
-(while (< i lenargs)
- (def arg (get args i))
- (if (= "-" (string-slice arg 0 1))
-  (+= i (dohandler (string-slice arg 1 2) i))
-  (do
-   (:= *no-file* false)
-   (import arg)
-   (++ i))))
+  # Process arguments
+  (var i 1)
+  (def lenargs (length args))
+  (while (< i lenargs)
+         (def arg (get args i))
+         (if (= "-" (string-slice arg 0 1))
+           (+= i (dohandler (string-slice arg 1 2) i))
+           (do
+             (:= *no-file* false)
+             (import arg)
+             (++ i))))

-(defn xgetline [buf p]
-  (def prompt (string (parser-state p) "> "))
-  (getline prompt buf))
-
-(when (or *should-repl* *no-file*) 
-  (if *raw-stdin*
-    (repl nil identity)
-    (do
-      (print (string "Dst " VERSION "  Copyright (C) 2017-2018 Calvin Rose"))
-      (repl xgetline))))
-
-)
+  (when (or *should-repl* *no-file*) 
+    (if *raw-stdin*
+      (repl nil identity)
+      (do
+        (print (string "Dst " VERSION "  Copyright (C) 2017-2018 Calvin Rose"))
+        (repl (fn [buf p]
+                  (def prompt (string (parser-state p) "> "))
+                  (getline prompt buf)))))))