about summary refs log tree commit diff stats
path: root/apps/mu.subx
diff options
context:
space:
mode:
authorKartik Agaram <vc@akkartik.com>2020-06-28 11:50:50 -0700
committerKartik Agaram <vc@akkartik.com>2020-06-28 11:50:50 -0700
commit1a89b13b9c316010d3409f2fbec1e7de72646ac8 (patch)
treecbd2cffd20e5393b06c9e67bc9e8b13028c59d2a /apps/mu.subx
parentbf4fbab76d08bc27b6420dca94a2b56a9b14acdf (diff)
downloadmu-1a89b13b9c316010d3409f2fbec1e7de72646ac8.tar.gz
6585
Diffstat (limited to 'apps/mu.subx')
-rw-r--r--apps/mu.subx107
1 files changed, 97 insertions, 10 deletions
diff --git a/apps/mu.subx b/apps/mu.subx
index ad7f6d47..3c55e561 100644
--- a/apps/mu.subx
+++ b/apps/mu.subx
@@ -4876,6 +4876,54 @@ test-get-with-wrong-base-type:
     5d/pop-to-ebp
     c3/return
 
+test-get-with-wrong-base-type-2:
+    # . prologue
+    55/push-ebp
+    89/<- %ebp 4/r32/esp
+    # setup
+    (clear-stream _test-input-stream)
+    (clear-stream $_test-input-buffered-file->buffer)
+    (clear-stream _test-output-stream)
+    (clear-stream $_test-output-buffered-file->buffer)
+    (clear-stream _test-error-stream)
+    (clear-stream $_test-error-buffered-file->buffer)
+    # var ed/edx: exit-descriptor = tailor-exit-descriptor(16)
+    68/push 0/imm32
+    68/push 0/imm32
+    89/<- %edx 4/r32/esp
+    (tailor-exit-descriptor %edx 0x10)
+    #
+    (write _test-input-stream "fn foo {\n")
+    (write _test-input-stream "  var a: (addr t)\n")
+    (write _test-input-stream "  var c/ecx: (addr int) <- get a, y\n")
+    (write _test-input-stream "}\n")
+    (write _test-input-stream "type t {\n")
+    (write _test-input-stream "  x: int\n")
+    (write _test-input-stream "}\n")
+    # convert
+    (convert-mu _test-input-buffered-file _test-output-buffered-file _test-error-buffered-file %edx)
+    # registers except esp clobbered at this point
+    # restore ed
+    89/<- %edx 4/r32/esp
+    (flush _test-output-buffered-file)
+    (flush _test-error-buffered-file)
+#?     # dump _test-error-stream {{{
+#?     (write 2 "^")
+#?     (write-stream 2 _test-error-stream)
+#?     (write 2 "$\n")
+#?     (rewind-stream _test-error-stream)
+#?     # }}}
+    # check output
+    (check-stream-equal _test-output-stream  ""  "F - test-get-with-wrong-base-type-2: output should be empty")
+    (check-next-stream-line-equal _test-error-stream  "fn foo: stmt get: var 'a' is an 'addr' type, and so must live in a register"  "F - test-get-with-wrong-base-type-2: error message")
+    # check that stop(1) was called
+    (check-ints-equal *(edx+4) 2 "F - test-get-with-wrong-base-type-2: exit status")
+    # don't restore from ebp
+    81 0/subop/add %esp 8/imm32
+    # . epilogue
+    5d/pop-to-ebp
+    c3/return
+
 test-get-with-wrong-offset-type:
     # . prologue
     55/push-ebp
@@ -10406,24 +10454,49 @@ check-mu-get-stmt:  # stmt: (addr stmt), fn: (addr function), err: (addr buffere
     # esi = stmt
     8b/-> *(ebp+8) 6/r32/esi
     # - check for 0 inouts
-    # var base/ebx: (addr stmt-var) = stmt->inouts->value
+    # var base/ecx: (addr var) = stmt->inouts->value
     (lookup *(esi+0xc) *(esi+0x10))  # Stmt1-inouts Stmt1-inouts => eax
-    89/<- %ebx 0/r32/eax
     3d/compare-eax-and 0/imm32/false
     0f 84/jump-if-= $check-mu-get-stmt:error-too-few-inouts/disp32
+    (lookup *eax *(eax+4))  # Stmt-var-value Stmt-var-value => eax
+    89/<- %ecx 0/r32/eax
     # - check base type
-    (container-type %ebx)  # => eax
-    (is-container? %eax)  # => eax
+    # if it's an 'addr', check that it's in a register
+    # var base-type/ebx: (addr tree type-id) = lookup(base->type)
+    (lookup *(ecx+8) *(ecx+0xc))  # Var-type Var-type => eax
+    89/<- %ebx 0/r32/eax
+    {
+      81 7/subop/compare *ebx 0/imm32/false  # Tree-is-atom
+      75/jump-if-!= break/disp8
+      # if (type->left != addr) break
+      (lookup *(ebx+4) *(ebx+8))  # Tree-left Tree-left => eax
+      (is-simple-mu-type? %eax 2)  # => eax
+      3d/compare-eax-and 0/imm32/false
+      74/jump-if-= break/disp8
+      # now check for register
+      81 7/subop/compare *(ecx+0x18) 0/imm32  # Var-register
+      0f 84/jump-if-= $check-mu-get-stmt:error-base-type-addr-but-not-register/disp32
+      # type->left is now an addr; skip it
+      (lookup *(ebx+0xc) *(ebx+0x10))  # Tree-right Tree-right => eax
+      89/<- %ebx 0/r32/eax
+    }
+    # ensure type is a container
+    # var base-type-id/ebx: type-id = base-type->value
+    8b/-> *(ebx+4) 3/r32/ebx  # Tree-value
+    (is-container? %ebx)  # => eax
     3d/compare-eax-and 0/imm32/false
     0f 84/jump-if-= $check-mu-get-stmt:error-bad-base/disp32
-    # var offset/ecx: (addr var) = stmt->inouts->next->value
+    # var offset/ecx: (addr stmt-var) = stmt->inouts->next
     (lookup *(esi+0xc) *(esi+0x10))  # Stmt1-inouts Stmt1-inouts => eax
     (lookup *(eax+8) *(eax+0xc))  # Stmt-var-next Stmt-var-next => eax
+    89/<- %ecx 0/r32/eax
     # - check for 1 inout
     3d/compare-eax-and 0/imm32/false
     0f 84/jump-if-= $check-mu-get-stmt:error-too-few-inouts/disp32
-    (lookup *eax *(eax+4))  # Stmt-var-value Stmt-var-value => eax
+    # var offset/ecx: (addr var) = lookup(offset->value)
+    (lookup *ecx *(ecx+4))  # Stmt-var-value Stmt-var-value => eax
     89/<- %ecx 0/r32/eax
+    # - check for valid field
     81 7/subop/compare *(ecx+0x14) -1/imm32/uninitialized  # Var-offset
     0f 84/jump-if-= $check-mu-get-stmt:error-bad-field/disp32
     # - check for too many inouts
@@ -10517,7 +10590,8 @@ $check-mu-get-stmt:error-bad-base:
     (lookup *eax *(eax+4))  # Function-name Function-name => eax
     (write-buffered *(ebp+0x10) %eax)
     (write-buffered *(ebp+0x10) ": stmt get: var '")
-    (lookup *ebx *(ebx+4))  # Stmt-var-value Stmt-var-value => eax
+    (lookup *(esi+0xc) *(esi+0x10))  # Stmt1-inouts Stmt1-inouts => eax
+    (lookup *eax *(eax+4))  # Stmt-var-value Stmt-var-value => eax
     (lookup *eax *(eax+4))  # Var-name Var-name => eax
     (write-buffered *(ebp+0x10) %eax)
     (write-buffered *(ebp+0x10) "' must have a 'type' definition\n")
@@ -10525,6 +10599,21 @@ $check-mu-get-stmt:error-bad-base:
     (stop *(ebp+0x14) 1)
     # never gets here
 
+$check-mu-get-stmt:error-base-type-addr-but-not-register:
+    (write-buffered *(ebp+0x10) "fn ")
+    8b/-> *(ebp+0xc) 0/r32/eax
+    (lookup *eax *(eax+4))  # Function-name Function-name => eax
+    (write-buffered *(ebp+0x10) %eax)
+    (write-buffered *(ebp+0x10) ": stmt get: var '")
+    (lookup *(esi+0xc) *(esi+0x10))  # Stmt1-inouts Stmt1-inouts => eax
+    (lookup *eax *(eax+4))  # Stmt-var-value Stmt-var-value => eax
+    (lookup *eax *(eax+4))  # Var-name Var-name => eax
+    (write-buffered *(ebp+0x10) %eax)
+    (write-buffered *(ebp+0x10) "' is an 'addr' type, and so must live in a register\n")
+    (flush *(ebp+0x10))
+    (stop *(ebp+0x14) 1)
+    # never gets here
+
 $check-mu-get-stmt:error-bad-field:
     # error("fn " fn ": stmt get: type " type " has no member called '" curr->name "'\n")
     (write-buffered *(ebp+0x10) "fn ")
@@ -10532,11 +10621,9 @@ $check-mu-get-stmt:error-bad-field:
     (lookup *eax *(eax+4))  # Function-name Function-name => eax
     (write-buffered *(ebp+0x10) %eax)
     (write-buffered *(ebp+0x10) ": stmt get: type '")
-    # . var tmp/eax = container-type(base)
-    (container-type %ebx)  # => eax
     # . write(Type-id->data[tmp])
     bf/copy-to-edi Type-id/imm32
-    (write-buffered *(ebp+0x10) *(edi+eax<<2+0xc))
+    (write-buffered *(ebp+0x10) *(edi+ebx<<2+0xc))
     # .
     (write-buffered *(ebp+0x10) "' has no member called '")
     (lookup *ecx *(ecx+4))  # Var-name Var-name => eax
ref='#n441'>441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505