Table of Contents

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:

  1. x n shift –> x, for n=0
  2. 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.