Introducing ARSHIFT (Arithmetic Shift Right) to fix heart game.

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

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 

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
 ;
 

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
 ;
 

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--) \