From bf523ef3457d20fd1b1c3e8113136966ec035177 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 12 Mar 2018 20:07:10 -0700
Subject: vm: introduce sframe instruction.

This is for allocating a new frame purely on the stack.  The
frame will not be captured by lexical closures, and so can
only be used for non-shared variables and additional
compiler-generated temporaries (if registers run out, for
instance).

* share/txr/stdlib/asm.tl (op-sframe, sframe): New opcode
class and opcode.

* vm.c (vm_do_frame): New static function for the common
implementation of frame and sframe.
(vm_frame): Now just a call with vm_do_frame, passing the flag
indicating that closure capture is enabled for this
environment frame.
(vm_sframe): New static function.

* vmop.h: Regenerated.
---
 share/txr/stdlib/asm.tl |  2 ++
 vm.c                    | 17 ++++++++++++--
 vmop.h                  | 61 +++++++++++++++++++++++++------------------------
 3 files changed, 48 insertions(+), 32 deletions(-)

diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl
index c6a7efc9..4871dd4f 100644
--- a/share/txr/stdlib/asm.tl
+++ b/share/txr/stdlib/asm.tl
@@ -268,6 +268,8 @@
   (:method dis (me asm lev size)
     ^(,me.symbol ,lev ,size)))
 
+(defopcode-derived op-sframe sframe auto op-frame)
+
 (defopcode-derived op-dframe dframe auto op-frame)
 
 (defopcode op-end end auto
diff --git a/vm.c b/vm.c
index 128b8f29..7759500c 100644
--- a/vm.c
+++ b/vm.c
@@ -262,7 +262,7 @@ INLINE void vm_set(struct vm_env *dspl, unsigned ref, val newval)
     mut(env->vec);
 }
 
-static void vm_frame(struct vm *vm, vm_word_t insn)
+static void vm_do_frame(struct vm *vm, vm_word_t insn, int capturable)
 {
   int lev = vm_insn_extra(insn);
   int size = vm_insn_operand(insn);
@@ -272,11 +272,21 @@ static void vm_frame(struct vm *vm, vm_word_t insn)
 
   vm->lev = lev;
   vm->dspl[lev].mem = coerce(val *, zalloca(size * sizeof (val *)));
-  vm->dspl[lev].vec = num_fast(size);
+  vm->dspl[lev].vec = (capturable ? num_fast(size) : 0);
   vm_execute(vm);
   vm->lev = lev - 1;
 }
 
+static void vm_frame(struct vm *vm, vm_word_t insn)
+{
+  vm_do_frame(vm, insn, 1);
+}
+
+static void vm_sframe(struct vm *vm, vm_word_t insn)
+{
+  vm_do_frame(vm, insn, 0);
+}
+
 static void vm_dframe(struct vm *vm, vm_word_t insn)
 {
   val saved_dyn_env = dyn_env;
@@ -610,6 +620,9 @@ static val vm_execute(struct vm *vm)
     case FRAME:
       vm_frame(vm, insn);
       break;
+    case SFRAME:
+      vm_sframe(vm, insn);
+      break;
     case DFRAME:
       vm_dframe(vm, insn);
       break;
diff --git a/vmop.h b/vmop.h
index 6f4d518a..6783b25d 100644
--- a/vmop.h
+++ b/vmop.h
@@ -28,34 +28,35 @@
 typedef enum vm_op {
   NOOP = 0,
   FRAME = 1,
-  DFRAME = 2,
-  END = 3,
-  FIN = 4,
-  CALL = 5,
-  APPLY = 6,
-  MOVRS = 7,
-  MOVSR = 8,
-  MOVRR = 9,
-  MOVRSI = 10,
-  MOVSMI = 11,
-  MOVRBI = 12,
-  JMP = 13,
-  IF = 14,
-  UWPROT = 15,
-  BLOCK = 16,
-  RETSR = 17,
-  RETRS = 18,
-  RETRR = 19,
-  CATCH = 20,
-  HANDLE = 21,
-  GETV = 22,
-  GETF = 23,
-  GETL1 = 24,
-  GETVB = 25,
-  GETFB = 26,
-  GETL1B = 27,
-  SETV = 28,
-  SETL1 = 29,
-  BINDV = 30,
-  CLOSE = 31,
+  SFRAME = 2,
+  DFRAME = 3,
+  END = 4,
+  FIN = 5,
+  CALL = 6,
+  APPLY = 7,
+  MOVRS = 8,
+  MOVSR = 9,
+  MOVRR = 10,
+  MOVRSI = 11,
+  MOVSMI = 12,
+  MOVRBI = 13,
+  JMP = 14,
+  IF = 15,
+  UWPROT = 16,
+  BLOCK = 17,
+  RETSR = 18,
+  RETRS = 19,
+  RETRR = 20,
+  CATCH = 21,
+  HANDLE = 22,
+  GETV = 23,
+  GETF = 24,
+  GETL1 = 25,
+  GETVB = 26,
+  GETFB = 27,
+  GETL1B = 28,
+  SETV = 29,
+  SETL1 = 30,
+  BINDV = 31,
+  CLOSE = 32,
 } vm_op_t;
-- 
cgit v1.2.3