Forums before death by AOL, social media and spammers... "We can't have nice things"
|    comp.lang.forth    |    Forth programmers eat a lot of Bratwurst    |    117,927 messages    |
[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]
|    Message 116,356 of 117,927    |
|    albert@spenarnc.xs4all.nl to krishna.myneni@ccreweb.org    |
|    Re: DLSHIFT and DRSHIFT    |
|    27 Mar 24 09:34:25    |
   
   In article ,   
   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.   
   >   
   >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 ===   
      
   These words should be in assembler anyway.   
   So a rigorous testset is more valuable than a supposedly   
   standard implementation.   
      
   Groetjes Albert   
   --   
   Don't praise the day before the evening. One swallow doesn't make spring.   
   You must not say "hey" before you have crossed the bridge. Don't sell the   
   hide of the bear until you shot it. Better one bird in the hand than ten in   
   the air. First gain is a cat purring. - the Wise from Antrim -   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)   
|
[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]
(c) 1994, bbs@darkrealms.ca