From: krishna.myneni@ccreweb.org   
      
   On 3/27/24 09:56, Ruvim wrote:   
   > On 2024-03-27 07:14, Krishna Myneni wrote:   
   >> On 3/26/24 17:01, Krishna Myneni wrote:   
   >>> Standard source definitions of DLSHIFT and DRSHIFT (double number   
   >>> left shift and right shift), over full shift range, per discussion in   
   >>> prior thread.   
   >>> ...   
   ...   
   >   
   > I wrote a simpler implementation a long time ago. The file   
   > "double-shift.fth" below is a translation from [2] using different names   
   > for constants.   
   >   
   >   
   > === "double-shift.fth"   
   >   
   > :NONAME 0 -1 BEGIN DUP WHILE SWAP 1+ SWAP 1 RSHIFT REPEAT DROP ; EXECUTE   
   > CONSTANT BITS-PER-CELL   
   >   
   > BITS-PER-CELL 1-      CONSTANT MAX-FOR-SHIFT1   
   > BITS-PER-CELL 2* 1-   CONSTANT MAX-FOR-SHIFT2   
   >   
   > : (DLSHIFT) ( xd1 u -- xd2 )   
   >    ( x.lo x.hi  u )   
   >    TUCK LSHIFT >R   
   >    2DUP NEGATE BITS-PER-CELL + RSHIFT >R   
   >    LSHIFT 2R> OR   
   > ;   
   > : DLSHIFT ( xd1 u -- xd2 )   
   >    DUP 0= IF  DROP EXIT THEN   
   >    DUP MAX-FOR-SHIFT2 U> IF  DROP 2DROP 0. EXIT THEN   
   >    DUP MAX-FOR-SHIFT1 U> IF  NIP BITS-PER-CELL - LSHIFT 0 SWAP EXIT THEN   
   >    (DLSHIFT)   
   > ;   
   > : (DRSHIFT) ( xd1 u -- xd2 )   
   >    ( x.lo x.hi  u )   
   >    2DUP RSHIFT >R   
   >    TUCK NEGATE BITS-PER-CELL + LSHIFT >R   
   >    RSHIFT R> OR R>   
   > ;   
   > : DRSHIFT ( xd1 u -- xd2 )   
   >    DUP 0= IF  DROP EXIT THEN   
   >    DUP MAX-FOR-SHIFT2 U> IF  DROP 2DROP 0. EXIT THEN   
   >    DUP MAX-FOR-SHIFT1 U> IF  >R NIP R> BITS-PER-CELL - RSHIFT 0 EXIT THEN   
   >    (DRSHIFT)   
   > ;   
   >   
   > === End of "double-shift.fth"   
   >   
      
   Does it succeed on all of the tests I gave?   
      
   --   
   Krishna   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)