home bbs files messages ]

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,369 of 117,927   
   Krishna Myneni to Ruvim   
   Re: DLSHIFT and DRSHIFT   
   27 Mar 24 14:49:02   
   
   From: krishna.myneni@ccreweb.org   
      
   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"   
   >>>   
   >>   
   >> Does it succeed on all of the tests I gave?   
   >   
   > Of course, I checked — it succeed your tests.   
   >   
   >   
      
   Thanks.   
      
   -- KM   
      
   --- 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