mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-01-11 08:00:27 +00:00
Code Issues 1 Releases Wiki Activity

Proper re-entry into debug state nested fibers.

Browse Source
This commit is contained in:
Calvin Rose 2018-05-16 09:24:34 -04:00
parent 6ac59251e9
commit 0fd9224e4a
3 changed files with 38 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
doc/bytecode.md
View File

@ -218,7 +218,7 @@ failure to return or error.
| `pusha` | `(pusha array)` | Push values in $array as args | | `pusha` | `(pusha array)` | Push values in $array as args |
| `put` | `(put ds key val)` | $ds[$key] = $val | | `put` | `(put ds key val)` | $ds[$key] = $val |
| `puti` | `(puti ds index val)` | $ds[index] = $val | | `puti` | `(puti ds index val)` | $ds[index] = $val |
| `res` | `(res fiber val)` | Resume $fiber with value $val | | `res` | `(res dest fiber val)` | $dest = resume $fiber with $val |
| `ret` | `(ret val)` | Return $val | | `ret` | `(ret val)` | Return $val |
| `retn` | `(retn)` | Return nil | | `retn` | `(retn)` | Return nil |
| `setu` | `(setu env index val)` | envs[env][index] = $val | | `setu` | `(setu env index val)` | envs[env][index] = $val |
@ -231,5 +231,5 @@ failure to return or error.
| `sub` | `(sub dest lhs rhs)` | $dest = $lhs - $rhs | | `sub` | `(sub dest lhs rhs)` | $dest = $lhs - $rhs |
| `tcall` | `(tcall callee)` | Return call($callee) | | `tcall` | `(tcall callee)` | Return call($callee) |
| `tchck` | `(tcheck slot types)` | Assert $slot does matches types | | `tchck` | `(tcheck slot types)` | Assert $slot does matches types |
| `yield` | `(yield value)` | Yield $value to parent fiber | | `yield` | `(yield dest value)` | $dest = yield $value to parent |

14
src/core/vm.c
View File

@ -41,7 +41,7 @@ Dst dst_run(DstFiber *fiber) {
/* Save old fiber to reset */ /* Save old fiber to reset */
DstFiber *old_vm_fiber = dst_vm_fiber; DstFiber *old_vm_fiber = dst_vm_fiber;
/* VM state */ /* interpreter state */
register Dst *stack; register Dst *stack;
register uint32_t *pc; register uint32_t *pc;
register DstFunction *func; register DstFunction *func;
@ -731,8 +731,6 @@ static void *op_lookup[255] = {
switch (nextfiber->status) { switch (nextfiber->status) {
default: default:
vm_throw("expected pending, new, or debug fiber"); vm_throw("expected pending, new, or debug fiber");
case DST_FIBER_DEBUG:
break;
case DST_FIBER_NEW: case DST_FIBER_NEW:
{ {
dst_fiber_push(nextfiber, val); dst_fiber_push(nextfiber, val);
@ -740,11 +738,21 @@ static void *op_lookup[255] = {
nextfiber->flags &= ~DST_FIBER_FLAG_NEW; nextfiber->flags &= ~DST_FIBER_FLAG_NEW;
break; break;
} }
case DST_FIBER_DEBUG:
{
if (!nextfiber->child) {
DstStackFrame *nextframe = dst_fiber_frame(nextfiber);
nextframe->pc++;
}
break;
}
case DST_FIBER_PENDING: case DST_FIBER_PENDING:
{ {
if (!nextfiber->child) {
DstStackFrame *nextframe = dst_fiber_frame(nextfiber); DstStackFrame *nextframe = dst_fiber_frame(nextfiber);
nextfiber->data[nextfiber->frame + ((*nextframe->pc >> 8) & 0xFF)] = val; nextfiber->data[nextfiber->frame + ((*nextframe->pc >> 8) & 0xFF)] = val;
nextframe->pc++; nextframe->pc++;
}
break; break;
} }
} }

23
test/suite1.dst
View File

@ -71,6 +71,27 @@
(assert (= "hello, world" `hello, world`) "simple long string") (assert (= "hello, world" `hello, world`) "simple long string")
(assert (= "hello, \"world\"" `hello, "world"`) "long string with embedded quotes") (assert (= "hello, \"world\"" `hello, "world"`) "long string with embedded quotes")
(assert (= "hello, \\\\\\ \"world\"" `hello, \\\ "world"`), "long string with embedded quotes and backslashes") (assert (= "hello, \\\\\\ \"world\"" `hello, \\\ "world"`),
"long string with embedded quotes and backslashes")
# More fiber semantics
(var myvar 0)
(defn fiberstuff []
(++ myvar)
(def f (fiber.new (fn [] (++ myvar) (debug) (++ myvar))))
(fiber.resume f)
(++ myvar))
(def myfiber (fiber.new fiberstuff :dey))
(assert (= myvar 0) "fiber creation does not call fiber function")
(fiber.resume myfiber)
(assert (= myvar 2) "fiber debug statement breaks at proper point")
(assert (= (fiber.status myfiber) :debug) "fiber enters debug state")
(fiber.resume myfiber)
(assert (= myvar 4) "fiber resumes properly from debug state")
(assert (= (fiber.status myfiber) :dead) "fiber properly dies from debug state")
(end-suite) (end-suite)