===== Shifting doubles: DLSHIFT and DRSHIFT ===== an.02apr2024 The code is for 32bit cells, to keep it readable. For other cell widths adjust the number 32 everywhere. ===== Coded with LSHIFT and RSHIFT ===== decimal : DLSHIFT ( lo hi n -- lo' hi' ) \ n in [0,32*2] tuck lshift >r \ hi' 2dup 32 - 2dup lshift >r \ lower lo to upper hi negate rshift >r \ upper lo to lower hi lshift \ lo' 2r> r> or or ; \ compose hi' : DRSHIFT ( lo hi n -- lo' hi' ) \ n in [0,32*2] tuck 2dup rshift >r \ hi' 32 - 2dup rshift >r \ upper hi to lower lo negate lshift >r \ lower hi to upper lo rshift 2r> or or \ compose lo' r> ; \ hi' ===== Possibly a problem ===== We assume for single cell LSHIFT and RSHIFT: - x n shift --> x, for n=0 - x n shift --> 0, for n not in [0,32-1]. More precise: for n in [-32,-1] or in [32,32*2]. Test your forth. If 2. does not hold: : LSHIFT ( x n -- x' ) dup 32 u< if lshift exit then 2drop 0 ; ===== Test code ===== decimal : DU.HEX ( ud -- ) base @ >r hex <# 32 2/ 0 do # loop #> type space r> base ! ; : (TEST) ( ud ud -- ) 2over 2over du.hex du.hex cr ." #shifts dlshift--------- drshift---------" 32 2* 2 + -2 do cr i 3 and 0= if cr then i 7 .r space 2over 2over i dlshift du.hex i drshift du.hex loop 2drop 2drop ; : TEST1 ( -- ) -1. 2dup (test) ; : TEST2 ( -- ) 0 -1 dup 1 rshift xor 1. (test) ; ===== Test results (noForth t) ===== @)test1 FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF #shifts dlshift--------- drshift--------- -2 0000000000000000 0000000000000000 -1 0000000000000000 0000000000000000 0 FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF 1 FFFFFFFFFFFFFFFE 7FFFFFFFFFFFFFFF 2 FFFFFFFFFFFFFFFC 3FFFFFFFFFFFFFFF 3 FFFFFFFFFFFFFFF8 1FFFFFFFFFFFFFFF 4 FFFFFFFFFFFFFFF0 0FFFFFFFFFFFFFFF 5 FFFFFFFFFFFFFFE0 07FFFFFFFFFFFFFF 6 FFFFFFFFFFFFFFC0 03FFFFFFFFFFFFFF 7 FFFFFFFFFFFFFF80 01FFFFFFFFFFFFFF 8 FFFFFFFFFFFFFF00 00FFFFFFFFFFFFFF 9 FFFFFFFFFFFFFE00 007FFFFFFFFFFFFF A FFFFFFFFFFFFFC00 003FFFFFFFFFFFFF B FFFFFFFFFFFFF800 001FFFFFFFFFFFFF C FFFFFFFFFFFFF000 000FFFFFFFFFFFFF D FFFFFFFFFFFFE000 0007FFFFFFFFFFFF E FFFFFFFFFFFFC000 0003FFFFFFFFFFFF F FFFFFFFFFFFF8000 0001FFFFFFFFFFFF 10 FFFFFFFFFFFF0000 0000FFFFFFFFFFFF 11 FFFFFFFFFFFE0000 00007FFFFFFFFFFF 12 FFFFFFFFFFFC0000 00003FFFFFFFFFFF 13 FFFFFFFFFFF80000 00001FFFFFFFFFFF 14 FFFFFFFFFFF00000 00000FFFFFFFFFFF 15 FFFFFFFFFFE00000 000007FFFFFFFFFF 16 FFFFFFFFFFC00000 000003FFFFFFFFFF 17 FFFFFFFFFF800000 000001FFFFFFFFFF 18 FFFFFFFFFF000000 000000FFFFFFFFFF 19 FFFFFFFFFE000000 0000007FFFFFFFFF 1A FFFFFFFFFC000000 0000003FFFFFFFFF 1B FFFFFFFFF8000000 0000001FFFFFFFFF 1C FFFFFFFFF0000000 0000000FFFFFFFFF 1D FFFFFFFFE0000000 00000007FFFFFFFF 1E FFFFFFFFC0000000 00000003FFFFFFFF 1F FFFFFFFF80000000 00000001FFFFFFFF 20 FFFFFFFF00000000 00000000FFFFFFFF 21 FFFFFFFE00000000 000000007FFFFFFF 22 FFFFFFFC00000000 000000003FFFFFFF 23 FFFFFFF800000000 000000001FFFFFFF 24 FFFFFFF000000000 000000000FFFFFFF 25 FFFFFFE000000000 0000000007FFFFFF 26 FFFFFFC000000000 0000000003FFFFFF 27 FFFFFF8000000000 0000000001FFFFFF 28 FFFFFF0000000000 0000000000FFFFFF 29 FFFFFE0000000000 00000000007FFFFF 2A FFFFFC0000000000 00000000003FFFFF 2B FFFFF80000000000 00000000001FFFFF 2C FFFFF00000000000 00000000000FFFFF 2D FFFFE00000000000 000000000007FFFF 2E FFFFC00000000000 000000000003FFFF 2F FFFF800000000000 000000000001FFFF 30 FFFF000000000000 000000000000FFFF 31 FFFE000000000000 0000000000007FFF 32 FFFC000000000000 0000000000003FFF 33 FFF8000000000000 0000000000001FFF 34 FFF0000000000000 0000000000000FFF 35 FFE0000000000000 00000000000007FF 36 FFC0000000000000 00000000000003FF 37 FF80000000000000 00000000000001FF 38 FF00000000000000 00000000000000FF 39 FE00000000000000 000000000000007F 3A FC00000000000000 000000000000003F 3B F800000000000000 000000000000001F 3C F000000000000000 000000000000000F 3D E000000000000000 0000000000000007 3E C000000000000000 0000000000000003 3F 8000000000000000 0000000000000001 40 0000000000000000 0000000000000000 41 0000000000000000 0000000000000000 OK.0 @)test2 0000000000000001 8000000000000000 #shifts dlshift--------- drshift--------- -2 0000000000000000 0000000000000000 -1 0000000000000000 0000000000000000 0 0000000000000001 8000000000000000 1 0000000000000002 4000000000000000 2 0000000000000004 2000000000000000 3 0000000000000008 1000000000000000 4 0000000000000010 0800000000000000 5 0000000000000020 0400000000000000 6 0000000000000040 0200000000000000 7 0000000000000080 0100000000000000 8 0000000000000100 0080000000000000 9 0000000000000200 0040000000000000 A 0000000000000400 0020000000000000 B 0000000000000800 0010000000000000 C 0000000000001000 0008000000000000 D 0000000000002000 0004000000000000 E 0000000000004000 0002000000000000 F 0000000000008000 0001000000000000 10 0000000000010000 0000800000000000 11 0000000000020000 0000400000000000 12 0000000000040000 0000200000000000 13 0000000000080000 0000100000000000 14 0000000000100000 0000080000000000 15 0000000000200000 0000040000000000 16 0000000000400000 0000020000000000 17 0000000000800000 0000010000000000 18 0000000001000000 0000008000000000 19 0000000002000000 0000004000000000 1A 0000000004000000 0000002000000000 1B 0000000008000000 0000001000000000 1C 0000000010000000 0000000800000000 1D 0000000020000000 0000000400000000 1E 0000000040000000 0000000200000000 1F 0000000080000000 0000000100000000 20 0000000100000000 0000000080000000 21 0000000200000000 0000000040000000 22 0000000400000000 0000000020000000 23 0000000800000000 0000000010000000 24 0000001000000000 0000000008000000 25 0000002000000000 0000000004000000 26 0000004000000000 0000000002000000 27 0000008000000000 0000000001000000 28 0000010000000000 0000000000800000 29 0000020000000000 0000000000400000 2A 0000040000000000 0000000000200000 2B 0000080000000000 0000000000100000 2C 0000100000000000 0000000000080000 2D 0000200000000000 0000000000040000 2E 0000400000000000 0000000000020000 2F 0000800000000000 0000000000010000 30 0001000000000000 0000000000008000 31 0002000000000000 0000000000004000 32 0004000000000000 0000000000002000 33 0008000000000000 0000000000001000 34 0010000000000000 0000000000000800 35 0020000000000000 0000000000000400 36 0040000000000000 0000000000000200 37 0080000000000000 0000000000000100 38 0100000000000000 0000000000000080 39 0200000000000000 0000000000000040 3A 0400000000000000 0000000000000020 3B 0800000000000000 0000000000000010 3C 1000000000000000 0000000000000008 3D 2000000000000000 0000000000000004 3E 4000000000000000 0000000000000002 3F 8000000000000000 0000000000000001 40 0000000000000000 0000000000000000 41 0000000000000000 0000000000000000 OK.0 ===== Contributions =====

Alternative Implementations

===== Coded with D2* and D2/ ===== an.02apr2024 decimal : DLSHIFT ( lo hi n -- lo' hi' ) \ n in [0,32*2] dup 32 2* u< if 0 ?do d2* loop exit then 2drop drop 0. ; : DRSHIFT ( lo hi n -- lo' hi' ) \ n in [0,32*2] dup 32 2* u< if 0 ?do d2/ [ -1 1 rshift ] literal and loop exit then 2drop drop 0. ; Remember that D2/ is in fact an arithmetic shift.