[OpenBIOS] [PATCH] Implement substitute return stack words

Programmingkid programmingkidx at gmail.com
Tue Apr 26 07:13:03 CEST 2016


Implement the sub_>r and sub_r> words. They can be used in place of >r and r>. 

Signed-off-by: John Arbuckle <programmingkidx at gmail.com>

Index: kernel/bootstrap.c
===================================================================
--- kernel/bootstrap.c	(revision 1395)
+++ kernel/bootstrap.c	(working copy)
@@ -89,7 +89,7 @@
 	"here", "here!", "dobranch", "do?branch", "unaligned-w@",
 	"unaligned-w!", "unaligned-l@", "unaligned-l!", "ioc@", "iow@",
 	"iol@", "ioc!", "iow!", "iol!", "i", "j", "call", "sys-debug",
-	"$include", "$encode-file", "(debug", "(debug-off)"
+	"$include", "$encode-file", "(debug", "(debug-off)", "sub_>r", "sub_r>"
 };
 
 /*
Index: kernel/forth.c
===================================================================
--- kernel/forth.c	(revision 1395)
+++ kernel/forth.c	(working copy)
@@ -1848,6 +1848,37 @@
 	PUSH(rstack[rstackcnt - 2]);
 }
 
+/* The substitute return stack */
+#define MAX_SUB_RSTACK_SIZE 100
+static int sub_return_stack[MAX_SUB_RSTACK_SIZE];
+static int top = 0;
+
+/*  
+ *   sub_>r ( i -- )  (Substitute R: -- i )
+ */
+
+static void sub_gt_r(void)
+{
+    if (top >= MAX_SUB_RSTACK_SIZE) {
+        printf_console("Stack overflow\n");
+        return;
+    }
+    sub_return_stack[top++] = POP();
+}
+
+/*
+ *     sub_r> ( -- i )  (Substitute R: i -- )
+ */
+
+static void sub_r_gt(void)
+{
+    if (top < 0 ) {
+        printf_console("Stack underflow\n");
+        return;
+    }
+    PUSH(sub_return_stack[--top]);
+}
+
 /* words[] is a function array of all native code functions used by
  * the dictionary, i.e. CFAs and primitives.
  * Any change here needs a matching change in the primitive word's
@@ -1963,4 +1994,6 @@
     do_encode_file,         /* $encode-file */
     do_debug_xt,            /* (debug  */
     do_debug_off,           /* (debug-off) */
+    sub_gt_r,               /* sub_>r  */
+    sub_r_gt                /* sub_r>  */
 };




More information about the OpenBIOS mailing list