From f0419b247a3940934d11951e79e3b1400afadc97 Mon Sep 17 00:00:00 2001
From: ketmar <ketmar@ketmar.no-ip.org>
Date: Thu, 23 Jul 2020 15:49:37 +0000
Subject: [PATCH] dsforth: added `SHL`, `SHR` and `SAR`

FossilOrigin-Name: 75e53fdf5d8dccf259bb847e602b74d885833d9b16ee5e16ebaa92898cc3af44
---
 dsforth/math_misc.zas | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)

diff --git a/dsforth/math_misc.zas b/dsforth/math_misc.zas
index 35b180c..37a8fdf 100644
--- a/dsforth/math_misc.zas
+++ b/dsforth/math_misc.zas
@@ -115,6 +115,85 @@ $FORTH_CODE_WORD 256UMOD
   jp    i_pushhl
 $FORTH_END_CODE_WORD 256UMOD
 
+$FORTH_CODE_WORD SHL
+;; k8
+;; ( n count -- n<<count )
+  pop   de
+  pop   hl
+  ld    a,d
+  or    a
+  jr    nz,shl_zero_res
+  ld    a,e
+  or    a
+  jp    z,i_pushhl
+  cp    16
+  jr    nc,shl_zero_res
+shl_loop:
+  or    a
+  rl    l
+  rl    h
+  dec   e
+  jr    nz,shl_loop
+  jp    i_pushhl
+shl_zero_res:
+  ld    hl,0
+  jp    i_pushhl
+$FORTH_END_CODE_WORD SHL
+
+$FORTH_CODE_WORD SHR
+;; k8
+;; ( n count -- n>>count )
+  pop   de
+  pop   hl
+  ld    a,d
+  or    a
+  jr    nz,shl_zero_res
+  ld    a,e
+  or    a
+  jp    z,i_pushhl
+  cp    16
+  jr    nc,shl_zero_res
+shr_loop:
+  or    a
+  rr    h
+  rr    l
+  dec   e
+  jr    nz,shr_loop
+  jp    i_pushhl
+$FORTH_END_CODE_WORD SHR
+
+$FORTH_CODE_WORD SAR
+;; k8
+;; ( n count -- n>>count )
+  pop   de
+  pop   hl
+  ld    a,d
+  or    a
+  jr    nz,sal_too_much
+  ld    a,e
+  or    a
+  jp    z,i_pushhl
+  cp    16
+  jr    nc,sal_too_much
+  ld    a,h
+  ld    d,0x80
+sar_loop:
+  cp    d
+  ccf
+  rr    h
+  rr    l
+  dec   e
+  jr    nz,sar_loop
+  jp    i_pushhl
+sal_too_much:
+  bit   7,h
+  ld    hl,0
+  jp    z,i_pushhl
+  dec   hl
+  jp    i_pushhl
+$FORTH_END_CODE_WORD SAR
+
+
 $FORTH_CODE_WORD ISGN
 ;; k8
 ;; ( 16 -- -1 or 0 or 1 )
-- 
2.11.4.GIT