From: krishna.myneni@ccreweb.org   
      
   Standard source definitions of DLSHIFT and DRSHIFT (double number left   
   shift and right shift), over full shift range, per discussion in prior   
   thread.   
      
   Tests needed.   
      
   --   
   Krishna Myneni   
      
      
   === Start Code ===   
      
   1 cells 3 lshift constant BITS_PER_CELL   
   BITS_PER_CELL 2* constant BITS_PER_DOUBLE   
      
   \ Return the u least significant bits of cell value u1   
   \ as the most significant bits of u2   
   : lsbits ( u1 u -- u2 )   
         BITS_PER_CELL min   
         BITS_PER_CELL - negate   
         lshift ;   
      
   \ Return the u most significant bits of cell value u1   
   \ as the least significant bits of u2   
   : msbits ( u1 u -- u2 )   
         BITS_PER_CELL min   
         BITS_PER_CELL - negate   
         rshift ;   
      
   0 value ubits   
      
   \ u is the number of bits to shift   
      
   : DLSHIFT ( ud u -- ud2 )   
        dup 0= IF drop EXIT THEN   
        BITS_PER_DOUBLE min dup to ubits   
        BITS_PER_CELL > IF   
          drop      \ high double has been left shifted out   
          ubits BITS_PER_CELL - lshift   
          0 swap    \ new low double   
        ELSE   
          ubits lshift swap   
          dup >r   
          ubits msbits or   
          r> ubits lshift   
          swap   
        THEN ;   
      
   : DRSHIFT ( ud u -- ud2 )   
        dup 0= IF drop EXIT THEN   
        BITS_PER_DOUBLE min dup to ubits   
        BITS_PER_CELL > IF   
          nip    \ low double has been right shifted out   
          ubits BITS_PER_CELL - rshift   
          0      \ new high double   
        ELSE   
          swap ubits rshift   
          swap dup >r   
          ubits lsbits or   
          r> ubits rshift   
        THEN ;   
      
   === End Code ===   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)