5666 - start of sugar for structured control flow

2 files changed, 337 insertions, 0 deletions

diff --git a/apps/braces b/apps/braces
new file mode 100755
index 00000000..c3f88cd8
--- /dev/null
+++ b/apps/braces
Binary files differdiff --git a/apps/braces.subx b/apps/braces.subx
new file mode 100644
index 00000000..e090692f
--- /dev/null
+++ b/apps/braces.subx
@@ -0,0 +1,337 @@
+# Structured control flow using break/loop rather than jump.
+#
+# To run (on Linux):
+#   $ ./ntranslate init.linux 0*.subx apps/subx-common.subx apps/calls.subx
+#   $ mv a.elf apps/calls
+#
+# Example 1:
+#   $ cat x.subx
+#   {
+#     7c/if-lesser break/disp8
+#     74/if-equal loop/disp8
+#   }
+#   $ cat x.subx |apps/calls
+#   _loop1:
+#     7c/if-lesser _break1/disp8
+#     74/if-equal _loop1/disp8
+#   _break1:
+#
+# Example 2:
+#   $ cat x.subx
+#   {
+#     7c/if-lesser break/disp8
+#   }
+#   {
+#     74/if-equal loop/disp8
+#   }
+#   $ cat x.subx |apps/calls
+#   _loop1:
+#     7c/if-lesser _break1/disp8
+#   _break1:
+#   _loop2:
+#     74/if-equal _loop2/disp8
+#   _break2:
+#
+# Example 3:
+#   $ cat x.subx
+#   {
+#     {
+#       74/if-equal loop/disp8
+#     }
+#     7c/if-lesser loop/disp8
+#   }
+#   $ cat x.subx |apps/calls
+#   _loop1:
+#     _loop2:
+#       74/if-equal _loop2/disp8
+#     _break2:
+#     7c/if-lesser _loop1/disp8
+#   _break1:
+
+== code
+
+Entry:  # run tests if necessary, a REPL if not
+    # . prolog
+    89/<- %ebp 4/r32/esp
+    # initialize heap
+    (new-segment Heap-size Heap)
+    # if (argc <= 1) goto run-main
+    81 7/subop/compare *ebp 1/imm32
+    7e/jump-if-lesser-or-equal $run-main/disp8
+    # if (argv[1] != "test")) goto run-main
+    (kernel-string-equal? *(ebp+8) "test")  # => eax
+    3d/compare-eax-and 0/imm32
+    74/jump-if-equal $run-main/disp8
+    #
+    (run-tests)
+    # syscall(exit, *Num-test-failures)
+    8b/-> *Num-test-failures 3/r32/ebx
+    eb/jump $main:end/disp8
+$run-main:
+    (convert Stdin Stdout)
+    # syscall(exit, 0)
+    bb/copy-to-ebx 0/imm32
+$main:end:
+    b8/copy-to-eax 1/imm32/exit
+    cd/syscall 0x80/imm8
+
+convert:  # in : (address buffered-file), out : (address buffered-file) -> <void>
+    # pseudocode:
+    #   var line = new-stream(512, 1)
+    #   var label-stack : (address stack) = new-stack(32*4)  # at most 32 levels of nesting
+    #   var next-label-id : int = 1
+    #   while true
+    #     clear-stream(line)
+    #     read-line-buffered(in, line)
+    #     if (line->write == 0) break                           # end of file
+    #     skip-chars-matching-whitespace(line)
+    #     if line->data[line->read] == '{'
+    #       print(out, "_loop" next-label-id ":\n")
+    #       push(label-stack, next-label-id)
+    #       ++next-label-id
+    #     if line->data[line->read] == '}'
+    #       var top = pop(label-stack)
+    #       print(out, "_break" top ":\n")
+    #     while true
+    #       var word-slice : (address slice) = next-word-or-expression(line)
+    #       if slice-empty?(word-slice)                         # end of line
+    #         break
+    #       if slice-starts-with?(word-slice, "#")              # comment
+    #         continue
+    #       if slice-starts-with?(word-slice, "break/")
+    #         var top = top(label-stack)
+    #         write(out, "_break" top)
+    #         word-slice->start += len("break")
+    #       else if slice-starts-with?(word-slice, "loop/")
+    #         var top = top(label-stack)
+    #         write(out, "_loop" top)
+    #         word-slice->start += len("loop")
+    #       write(out, word-slice " ")
+    #     write(out, "\n")
+    #   flush(out)
+    # . prolog
+    55/push-ebp
+    89/<- %ebp 4/r32/esp
+    # . save registers
+$convert:loop:
+    eb/jump $convert:loop/disp8
+$convert:end:
+    # . restore registers
+    # . epilog
+    89/<- %esp 5/r32/ebp
+    5d/pop-to-ebp
+    c3/return
+
+# let's just put stack primitives here for now
+# we need to think about how to maintain layers of the library at different levels of syntax sugar
+
+# A stack looks like this:
+#   top: int
+#   data: (array byte)  # prefixed by length as usual
+
+clear-stack:  # s : (address stack)
+    # . prolog
+    55/push-ebp
+    89/<- %ebp 4/r32/esp
+    # . save registers
+    50/push-eax
+    51/push-ecx
+    # eax = s
+    8b/-> *(ebp+8) 0/r32/eax
+    # ecx = s->length
+    8b/-> *(eax+4) 1/r32/ecx
+    # ecx = &s->data[s->length]
+    8d/copy-address *(eax+ecx+8) 1/r32/ecx
+    # s->top = 0
+    c7/copy 0/subop/copy *eax 0/imm32
+    # eax = s->data
+    81 0/subop/add %eax 8/imm32
+$clear-stack:loop:
+    # if (eax >= ecx) break
+    39/compare %eax 1/r32/ecx
+    73/jump-if-greater-or-equal-unsigned $clear-stack:end/disp8
+    # *eax = 0
+    c6 0/subop/copy-byte *eax 0/imm8
+    # ++eax
+    40/increment-eax
+    eb/jump $clear-stack:loop/disp8
+$clear-stack:end:
+    # . restore registers
+    59/pop-to-ecx
+    58/pop-to-eax
+    # . epilog
+    89/<- %esp 5/r32/ebp
+    5d/pop-to-ebp
+    c3/return
+
+test-clear-stack:
+    # var ecx : (address stack) = stack of size 8 with random data in it
+    68/push 34/imm32
+    68/push 35/imm32
+    68/push 8/imm32/length
+    68/push 14/imm32/top
+    89/<- %ecx 4/r32/esp
+    # clear
+    (clear-stack %ecx)
+    # top should be 0
+    58/pop-to-eax
+    (check-ints-equal %eax 0 "F - test-clear-stack: top")
+    # length should remain 8
+    58/pop-to-eax
+    (check-ints-equal %eax 8 "F - test-clear-stack: length")
+    # first word is 0
+    58/pop-to-eax
+    (check-ints-equal %eax 0 "F - test-clear-stack: data[0..3]")
+    # second word is 0
+    58/pop-to-eax
+    (check-ints-equal %eax 0 "F - test-clear-stack: data[4..7]")
+    c3/return
+
+push:  # s : (address stack), n : int
+    # . prolog
+    55/push-ebp
+    89/<- %ebp 4/r32/esp
+    # . save registers
+    50/push-eax
+    51/push-ecx
+    56/push-esi
+    # esi = s
+    8b/-> *(ebp+8) 6/r32/esi
+    # ecx = s->top
+    8b/-> *esi 1/r32/ecx
+    # if (s->top >= s->length) abort
+    39/compare *(esi+4) 1/r32/ecx
+    7e/jump-if-lesser-or-equal $push:abort/disp8
+    # s->data[s->top] = n
+    8b/-> *(ebp+0xc) 0/r32/eax
+    89/<- *(esi+ecx+8) 0/r32/eax
+    # s->top += 4
+    81 0/subop/add *esi 4/imm32
+$push:end:
+    # . restore registers
+    5e/pop-to-esi
+    59/pop-to-ecx
+    58/pop-to-eax
+    # . epilog
+    89/<- %esp 5/r32/ebp
+    5d/pop-to-ebp
+    c3/return
+
+$push:abort:
+    # print(stderr, "error: push: no space left")
+    # . write-buffered(Stderr, "error: push: no space left")
+    # . . push args
+    68/push "error: push: no space left"/imm32
+    68/push Stderr/imm32
+    # . . call
+    e8/call write-buffered/disp32
+    # . . discard args
+    81 0/subop/add %esp 8/imm32
+    # . flush(Stderr)
+    # . . push args
+    68/push Stderr/imm32
+    # . . call
+    e8/call flush/disp32
+    # . . discard args
+    81 0/subop/add %esp 4/imm32
+    # . syscall(exit, 1)
+    bb/copy-to-ebx 1/imm32
+    b8/copy-to-eax 1/imm32/exit
+    cd/syscall 0x80/imm8
+    # never gets here
+
+test-push:
+    # var ecx : (address stack) = empty stack of size 8
+    68/push 0/imm32
+    68/push 0/imm32
+    68/push 8/imm32/length
+    68/push 0/imm32/top
+    89/<- %ecx 4/r32/esp
+    #
+    (push %ecx 42)
+    # top
+    58/pop-to-eax
+    (check-ints-equal %eax 4 "F - test-push: top")
+    # length
+    58/pop-to-eax
+    (check-ints-equal %eax 8 "F - test-push: length")
+    # first word is 42
+    58/pop-to-eax
+    (check-ints-equal %eax 42 "F - test-push: data[0..3]")
+    # second word is 0
+    58/pop-to-eax
+    (check-ints-equal %eax 0 "F - test-push: data[4..7]")
+    c3/return
+
+pop:  # s : (address stack) -> n/eax : int
+    # . prolog
+    55/push-ebp
+    89/<- %ebp 4/r32/esp
+    # . save registers
+    51/push-ecx
+    56/push-esi
+    # esi = s
+    8b/-> *(ebp+8) 6/r32/esi
+    # if (s->top <= 0) abort
+    81 7/subop/compare *esi 0/imm32
+    7e/jump-if-lesser-or-equal $pop:abort/disp8
+    # s->top -= 4
+    81 5/subop/subtract *esi 4/imm32
+    # eax = s->data[s->top]
+    8b/-> *esi 1/r32/ecx/top
+    8b/-> *(esi+ecx+8) 0/r32/eax
+$pop:end:
+    # . restore registers
+    5e/pop-to-esi
+    59/pop-to-ecx
+    # . epilog
+    89/<- %esp 5/r32/ebp
+    5d/pop-to-ebp
+    c3/return
+
+$pop:abort:
+    # print(stderr, "error: pop: nothing left in stack")
+    # . write-buffered(Stderr, "error: pop: nothing left in stack")
+    # . . push args
+    68/push "error: pop: nothing left in stack"/imm32
+    68/push Stderr/imm32
+    # . . call
+    e8/call write-buffered/disp32
+    # . . discard args
+    81 0/subop/add %esp 8/imm32
+    # . flush(Stderr)
+    # . . push args
+    68/push Stderr/imm32
+    # . . call
+    e8/call flush/disp32
+    # . . discard args
+    81 0/subop/add %esp 4/imm32
+    # . syscall(exit, 1)
+    bb/copy-to-ebx 1/imm32
+    b8/copy-to-eax 1/imm32/exit
+    cd/syscall 0x80/imm8
+    # never gets here
+
+test-pop:
+    # var ecx : (address stack) = stack of size 8 containing just 42
+    68/push 0/imm32
+    68/push 42/imm32
+    68/push 8/imm32/length
+    68/push 4/imm32/top
+    89/<- %ecx 4/r32/esp
+    #
+    (pop %ecx)  # => eax
+    # result
+    (check-ints-equal %eax 42 "F - test-pop: result")
+    # top
+    58/pop-to-eax
+    (check-ints-equal %eax 0 "F - test-pop: top")
+    # length
+    58/pop-to-eax
+    (check-ints-equal %eax 8 "F - test-pop: length")
+    # clean up
+    58/pop-to-eax
+    58/pop-to-eax
+    c3/return
+
+== data