From: krishna.myneni@ccreweb.org   
      
   On 3/29/24 09:32, Hans Bezemer wrote:   
   > On 27-03-2024 20:49, Krishna Myneni wrote:   
   >> On 3/27/24 11:36, Ruvim wrote:   
   >>   
   >>>>> === "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"   
   >   
   > Can't make it any shorter than this. And no idea what happens with less   
   > robust LSHIFT or RSHIFT implementations. CELL-BITS should be most   
   > obvious, : SPIN SWAP ROT ; should fix most porting issues, replace ;THEN   
   > with EXIT THEN. It passes all tests.   
   >   
   > : dlshift   
   >    dup 0> 0= if drop ;then   
   >    >r over 0 invert cell-bits r@ - dup >r lshift and r> rshift swap   
   >    r@ lshift or swap r> lshift swap   
   > ;   
   >   
   > : drshift   
   >    dup 0> 0= if drop ;then   
   >    >r dup 0 invert cell-bits r@ - dup >r rshift and r> lshift swap   
   >    r@ rshift spin r> rshift or swap   
   > ;   
   >   
      
   Thanks! I have updated LSHIFT and RSHIFT in kForth-32 and kForth-64 to   
   handle shift count >= BITS_PER_CELL to give the expected answer (0).   
      
   --   
   Krishna   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)