[BACK]Return to primitives CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/Attic/primitives between versions 1.62 and 1.63

version 1.62, 1997/02/08 22:58:15 version 1.63, 1997/02/09 21:51:40
Line 300  rp += 2; Line 300  rp += 2;
 *--rp = nlimit;  *--rp = nlimit;
 *--rp = nstart;  *--rp = nstart;
 :  :
  r> -rot swap >r >r >r ;   r> swap rot >r >r >r ;
   
 (?do)   nlimit nstart --        gforth  paren_question_do  (?do)   nlimit nstart --        gforth  paren_question_do
 *--rp = nlimit;  *--rp = nlimit;
Line 320  else { Line 320  else {
        cell+ >r         cell+ >r
   THEN ;                                \ --> CORE-EXT    THEN ;                                \ --> CORE-EXT
   
   \+has-xconds [IF]
   
 (+do)   nlimit nstart --        gforth  paren_plus_do  (+do)   nlimit nstart --        gforth  paren_plus_do
 *--rp = nlimit;  *--rp = nlimit;
 *--rp = nstart;  *--rp = nstart;
Line 400  else { Line 402  else {
      cell+       cell+
  THEN  >r ;   THEN  >r ;
   
   \+[THEN]
   
 i       -- n            core  i       -- n            core
 n = *rp;  n = *rp;
 :  :
Line 665  ud = (UDCell)u1 * (UDCell)u2; Line 669  ud = (UDCell)u1 * (UDCell)u2;
        r> 2* r> swap         r> 2* r> swap
    LOOP 2drop ;     LOOP 2drop ;
 : d2*+ ( ud n -- ud+n c )  : d2*+ ( ud n -- ud+n c )
        over MINI     over MINI
        and >r >r 2dup d+ swap r> + swap r> ;     and >r >r 2dup d+ swap r> + swap r> ;
   
 um/mod  ud u1 -- u2 u3          core    u_m_slash_mod  um/mod  ud u1 -- u2 u3          core    u_m_slash_mod
 #ifdef BUGGY_LONG_LONG  #ifdef BUGGY_LONG_LONG
Line 683  u2 = ud%u1; Line 687  u2 = ud%u1;
    LOOP drop swap 1 rshift or swap ;     LOOP drop swap 1 rshift or swap ;
 : /modstep ( ud c R: u -- ud-?u c R: u )  : /modstep ( ud c R: u -- ud-?u c R: u )
    over I' u< 0= or IF I' - 1 ELSE 0 THEN  d2*+ ;     over I' u< 0= or IF I' - 1 ELSE 0 THEN  d2*+ ;
   : d2*+ ( ud n -- ud+n c )
      over MINI
      and >r >r 2dup d+ swap r> + swap r> ;
   
 m+      d1 n -- d2              double          m_plus  m+      d1 n -- d2              double          m_plus
 #ifdef BUGGY_LONG_LONG  #ifdef BUGGY_LONG_LONG
Line 912  NEXT_P0; Line 919  NEXT_P0;
   
 >r      w --            core    to_r  >r      w --            core    to_r
 *--rp = w;  *--rp = w;
   :
    (>r) ;
   : (>r)  rp@ cell+ @ rp@ ! rp@ cell+ ! ;
   
 r>      -- w            core    r_from  r>      -- w            core    r_from
 w = *rp++;  w = *rp++;
   :
    rp@ cell+ @ rp@ @ rp@ cell+ ! (rdrop) rp@ ! ;
   Create (rdrop) ' ;s A,
   
 rdrop   --              gforth  rdrop   --              gforth
 rp++;  rp++;
Line 1069  c! c c_addr --  core cstore Line 1082  c! c c_addr --  core cstore
 [ bigendian [IF] ]  [ bigendian [IF] ]
     [ cell>bit 4 = [IF] ]      [ cell>bit 4 = [IF] ]
         tuck 1 and IF  $FF and  ELSE  8<<  THEN >r          tuck 1 and IF  $FF and  ELSE  8<<  THEN >r
         dup -2 and @ over 1 and          dup -2 and @ over 1 and cells masks + @ and
         IF  $FF00  ELSE  $FF  THEN  and r> or swap -2 and !          r> or swap -2 and ! ;
     [ [ELSE] ]          Create masks $00FF , $FF00 ,
       [ELSE] ]
         dup [ cell 1- ] literal and dup           dup [ cell 1- ] literal and dup 
         [ cell 1- ] literal xor >r          [ cell 1- ] literal xor >r
         - dup @ $FF r@ 0 ?DO 8<< LOOP invert and          - dup @ $FF r@ 0 ?DO 8<< LOOP invert and
         rot $FF and r> 0 ?DO 8<< LOOP or swap !          rot $FF and r> 0 ?DO 8<< LOOP or swap ! ;
     [ [THEN] ]      [THEN]
 [ [ELSE] ]  [ELSE] ]
     [ cell>bit 4 = [IF] ]      [ cell>bit 4 = [IF] ]
         tuck 1 and IF  8<<  ELSE  $FF and  THEN >r          tuck 1 and IF  8<<  ELSE  $FF and  THEN >r
         dup -2 and @ over 1 and          dup -2 and @ over 1 and cells masks + @ and
         IF  $FF  ELSE  $FF00  THEN  and r> or swap -2 and !          r> or swap -2 and ! ;
     [ [ELSE] ]          Create masks $FF00 , $00FF ,
       [ELSE] ]
         dup [ cell 1- ] literal and dup >r          dup [ cell 1- ] literal and dup >r
         - dup @ $FF r@ 0 ?DO 8<< LOOP invert and          - dup @ $FF r@ 0 ?DO 8<< LOOP invert and
         rot $FF and r> 0 ?DO 8<< LOOP or swap !          rot $FF and r> 0 ?DO 8<< LOOP or swap ! ;
     [ [THEN] ]      [THEN]
 [ [THEN] ]  [THEN]
 ;  
 : 8<< 2* 2* 2* 2*  2* 2* 2* 2* ;  : 8<< 2* 2* 2* 2*  2* 2* 2* 2* ;
   
 2!      w1 w2 a_addr --         core    two_store  2!      w1 w2 a_addr --         core    two_store
Line 1141  for (; f83name1 != NULL; f83name1 = f83n Line 1155  for (; f83name1 != NULL; f83name1 = f83n
     break;      break;
 f83name2=f83name1;  f83name2=f83name1;
 :  :
  BEGIN  dup  WHILE      BEGIN  dup WHILE  (find-samelen)  dup  WHILE
         >r dup r@ cell+ c@ $1F and =          >r 2dup r@ cell+ char+ capscomp  0=
         IF  2dup r@ cell+ char+ capscomp  0=          IF  2drop r>  EXIT  THEN
             IF  2drop r>  EXIT  THEN  THEN  
         r> @          r> @
  REPEAT  nip nip ;      REPEAT  THEN  nip nip ;
   : (find-samelen) ( u f83name1 -- u f83name2/0 )
       BEGIN  2dup cell+ c@ $1F and <> WHILE  @  dup 0= UNTIL  THEN ;
   
 \+has-hash [IF]  \+has-hash [IF]
   
Line 1294  is the start of the Forth code after DOE Line 1309  is the start of the Forth code after DOE
 MAKE_DOES_CF(xt, a_addr);  MAKE_DOES_CF(xt, a_addr);
 CACHE_FLUSH(xt,PFA(0));  CACHE_FLUSH(xt,PFA(0));
 :  :
     ['] :dodoes over ! cell+ ! ;      dodoes: over ! cell+ ! ;
   
 does-handler!   a_addr --       gforth  does_handler_store  does-handler!   a_addr --       gforth  does_handler_store
 ""creates a DOES>-handler at address a_addr. a_addr usually points  ""creates a DOES>-handler at address a_addr. a_addr usually points
Line 1927  lp -= sizeof(Float); Line 1942  lp -= sizeof(Float);
   
 up!     a_addr --       gforth  up_store  up!     a_addr --       gforth  up_store
 up0=up=(char *)a_addr;  up0=up=(char *)a_addr;
   :
    up ! ;
   Variable UP
Removed from v.1.62  
changed lines
  Added in v.1.63

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>