From e6ca85f4f6cc8eeedbdc6c8893f4e531b69cf1ee Mon Sep 17 00:00:00 2001
From: Brad Nelson <flagxor@gmail.com>
Date: Sat, 4 Jun 2022 20:38:36 -0700
Subject: [PATCH] Introducing ARSHIFT (Arithmetic Shift Right) to fix heart
 game.

---
 common/base_tests.fs            | 5 +++++
 common/forth_namespace_tests.fs | 1 +
 common/graphics_utils.fs        | 8 ++++----
 common/heart.fs                 | 8 ++++----
 common/opcodes.h                | 1 +
 examples/bezier_test.fs         | 2 +-
 6 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/common/base_tests.fs b/common/base_tests.fs
index c414990..ce2ab44 100644
--- a/common/base_tests.fs
+++ b/common/base_tests.fs
@@ -138,3 +138,8 @@ e: test-rshift
   $1234 4 rshift $123 =assert
   -1 cell 8 * 1- rshift 1 =assert
 ;e
+
+e: test-arshift
+  $1234 4 arshift $123 =assert
+  -1 cell 8 * 1- arshift -1 =assert
+;e
diff --git a/common/forth_namespace_tests.fs b/common/forth_namespace_tests.fs
index 7aaac6f..3fe2e3c 100644
--- a/common/forth_namespace_tests.fs
+++ b/common/forth_namespace_tests.fs
@@ -220,6 +220,7 @@ e: check-core-opcodes
   out: */MOD 
   out: LSHIFT 
   out: RSHIFT 
+  out: ARSHIFT 
   out: AND 
   out: OR 
   out: XOR 
diff --git a/common/graphics_utils.fs b/common/graphics_utils.fs
index 38781d3..0b53281 100644
--- a/common/graphics_utils.fs
+++ b/common/graphics_utils.fs
@@ -65,10 +65,10 @@ gstack value gp
 graphics definitions also internals
 
 : box { left top w h }
-  left sx * tx + 16 rshift
-  top sy * ty + 16 rshift
-  w sx * 16 rshift
-  h sy * 16 rshift
+  left sx * tx + 16 arshift
+  top sy * ty + 16 arshift
+  w sx * 16 arshift
+  h sy * 16 arshift
   raw-box
 ;
 
diff --git a/common/heart.fs b/common/heart.fs
index b67f08d..3c95e15 100644
--- a/common/heart.fs
+++ b/common/heart.fs
@@ -85,10 +85,10 @@ graphics internals definitions
 graphics definitions also internals
 
 : heart 0 { x y s r }
-  x sx * tx + 16 rshift
-  y sy * ty + 16 rshift
-  s sx * 16 rshift
-  s sy * 16 rshift
+  x sx * tx + 16 arshift
+  y sy * ty + 16 arshift
+  s sx * 16 arshift
+  s sy * 16 arshift
   raw-heart
 ;
 
diff --git a/common/opcodes.h b/common/opcodes.h
index bfa55ca..6b41217 100644
--- a/common/opcodes.h
+++ b/common/opcodes.h
@@ -83,6 +83,7 @@ typedef struct {
   X("*/MOD", SSMOD, SSMOD_FUNC) \
   Y(LSHIFT, tos = (*sp-- << tos)) \
   Y(RSHIFT, tos = (((ucell_t) *sp--) >> tos)) \
+  Y(ARSHIFT, tos = (*sp-- >> tos)) \
   Y(AND, tos &= *sp--) \
   Y(OR, tos |= *sp--) \
   Y(XOR, tos ^= *sp--) \
diff --git a/examples/bezier_test.fs b/examples/bezier_test.fs
index 7d68ad5..fc65f88 100755
--- a/examples/bezier_test.fs
+++ b/examples/bezier_test.fs
@@ -68,7 +68,7 @@ scanlines max-scanlines cells erase
 : draw-spans max-scanlines 0 do i draw-row loop ;
 
 : 0.<< ( n -- n ) 16 lshift ;
-: 0.>> ( n -- n ) 16 rshift ;
+: 0.>> ( n -- n ) 16 arshift ;
 
 : line ( x1 y1 x2 y2 )
   0 0 0 0 { x1 y1 x2 y2 dx dy sy ey }