[gforth] / gforth / Attic / primitives  

gforth: gforth/Attic/primitives

Diff for /gforth/Attic/primitives between version 1.17 and 1.18

version 1.17, Thu Sep 8 17:20:10 1994 UTC version 1.18, Mon Sep 12 19:00:35 1994 UTC
Line 70 
Line 70 
   
 noop    --              fig  noop    --              fig
 ;  ;
   :
    ;
   
 lit     -- w            fig  lit     -- w            fig
 w = (Cell)*ip++;  w = (Cell)*ip++;
Line 88 
Line 90 
 branch  --              fig  branch  --              fig
 branch:  branch:
 ip = (Xt *)(((int)ip)+(int)*ip);  ip = (Xt *)(((int)ip)+(int)*ip);
   :
    r> dup @ + >r ;
   
 \ condbranch(forthname,restline,code)  \ condbranch(forthname,restline,code)
 \ this is non-syntactical: code must open a brace that is close by the macro  \ this is non-syntactical: code must open a brace that is close by the macro
Line 128 
Line 132 
 /* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */  /* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */
 /* dependent upon two's complement arithmetic */  /* dependent upon two's complement arithmetic */
 int olddiff = index-rp[1];  int olddiff = index-rp[1];
 #ifndef undefined  #ifdef undefined
 if ((olddiff^(olddiff+n))>=0   /* the limit is not crossed */  if ((olddiff^(olddiff+n))>=0   /* the limit is not crossed */
     || (olddiff^n)>=0          /* it is a wrap-around effect */) {      || (olddiff^n)>=0          /* it is a wrap-around effect */) {
 #else  #else
 #ifndef MAXINT  #ifndef MAXINT
 #define MAXINT ((1<<(8*sizeof(Cell)-1))-1)  #define MAXINT ((1<<(8*sizeof(Cell)-1))-1)
 #endif  #endif
 if(((olddiff^MAXINT) >= n) ? ((olddiff+n) >= 0) : ((olddiff+n) < 0)) {  if(((olddiff^MAXINT) >= n) ^ ((olddiff+n) < 0)) {
 #endif  #endif
 #ifdef i386  #ifdef i386
     *rp += n;      *rp += n;
Line 168 
Line 172 
   
 unloop          --      core  unloop          --      core
 rp += 2;  rp += 2;
   :
    r> rdrop rdrop >r ;
   
 (for)   ncount --               cmFORTH         paren_for  (for)   ncount --               cmFORTH         paren_for
 /* or (for) = >r -- collides with unloop! */  /* or (for) = >r -- collides with unloop! */
 *--rp = 0;  *--rp = 0;
 *--rp = ncount;  *--rp = ncount;
   :
    r> swap 0 >r >r >r ;
   
 (do)    nlimit nstart --                fig             paren_do  (do)    nlimit nstart --                fig             paren_do
 /* or do it in high-level? 0.09/0.23% */  /* or do it in high-level? 0.09/0.23% */
Line 219 
Line 227 
   
 cr      --              fig  cr      --              fig
 puts("");  puts("");
   :
    $0A emit ;
   
 move    c_from c_to ucount --           core  move    c_from c_to ucount --           core
 memmove(c_to,c_from,ucount);  memmove(c_to,c_from,ucount);
 /* make an Ifdef for bsd and others? */  /* make an Ifdef for bsd and others? */
   :
    >r 2dup u< IF r> cmove> ELSE r> cmove THEN ;
   
 cmove   c_from c_to u --        string  cmove   c_from c_to u --        string
 while (u-- > 0)  while (u-- > 0)
   *c_to++ = *c_from++;    *c_to++ = *c_from++;
   :
    bounds ?DO  dup c@ I c! 1+  LOOP  drop ;
   
 cmove>  c_from c_to u --        string  c_move_up  cmove>  c_from c_to u --        string  c_move_up
 while (u-- > 0)  while (u-- > 0)
   c_to[u] = c_from[u];    c_to[u] = c_from[u];
   :
    dup 0= IF  drop 2drop exit  THEN
    rot over + -rot bounds swap 1-
    DO  1- dup c@ I c!  -1 +LOOP  drop ;
   
 fill    c_addr u c --   core  fill    c_addr u c --   core
 memset(c_addr,c,u);  memset(c_addr,c,u);
   :
    -rot bounds
    ?DO  dup I c!  LOOP  drop ;
   
 compare         c_addr1 u1 c_addr2 u2 -- n      string  compare         c_addr1 u1 c_addr2 u2 -- n      string
 n = memcmp(c_addr1, c_addr2, u1<u2 ? u1 : u2);  n = memcmp(c_addr1, c_addr2, u1<u2 ? u1 : u2);
Line 243 
Line 264 
   n = -1;    n = -1;
 else if (n>0)  else if (n>0)
   n = 1;    n = 1;
   :
    rot 2dup - >r min swap -text dup
    IF    rdrop
    ELSE  drop r@ 0>
          IF    rdrop -1
          ELSE  r> 1 and
          THEN
    THEN ;
   
 -text           c_addr1 u c_addr2 -- n  new     dash_text  -text           c_addr1 u c_addr2 -- n  new     dash_text
 n = memcmp(c_addr1, c_addr2, u);  n = memcmp(c_addr1, c_addr2, u);
Line 250 
Line 279 
   n = -1;    n = -1;
 else if (n>0)  else if (n>0)
   n = 1;    n = 1;
   :
    swap bounds
    ?DO  dup c@ I c@ = WHILE  1+  LOOP  drop 0
    ELSE  c@ I c@ - unloop  THEN  -text-flag ;
   : -text-flag ( n -- -1/0/1 )
    dup 0< IF  drop -1  ELSE  0>  IF  1  ELSE  0  THEN  THEN  ;
   
 capscomp        c_addr1 u c_addr2 -- n  new  capscomp        c_addr1 u c_addr2 -- n  new
 Char c1, c2;  Char c1, c2;
Line 268 
Line 303 
     break;      break;
   }    }
 }  }
   :
    swap bounds
    ?DO  dup c@ toupper I c@ toupper = WHILE  1+  LOOP  drop 0
    ELSE  c@ toupper I c@ toupper - unloop  THEN  -text-flag ;
   
 -trailing       c_addr u1 -- c_addr u2          string  dash_trailing  -trailing       c_addr u1 -- c_addr u2          string  dash_trailing
 u2 = u1;  u2 = u1;
 while (c_addr[u2-1] == ' ')  while (c_addr[u2-1] == ' ')
   u2--;    u2--;
   :
    BEGIN  1- 2dup + c@ bl =  WHILE
           dup  0= UNTIL  ELSE  1+  THEN ;
   
 /string         c_addr1 u1 n -- c_addr2 u2      string  slash_string  /string         c_addr1 u1 n -- c_addr2 u2      string  slash_string
 c_addr2 = c_addr1+n;  c_addr2 = c_addr1+n;
 u2 = u1-n;  u2 = u1-n;
   :
    tuck - >r + r> dup 0< IF  - 0  THEN ;
   
 +       n1 n2 -- n              core,fig        plus  +       n1 n2 -- n              core,fig        plus
 n = n1+n2;  n = n1+n2;
   
 -       n1 n2 -- n              core,fig        minus  -       n1 n2 -- n              core,fig        minus
 n = n1-n2;  n = n1-n2;
   :
    negate + ;
   
 negate  n1 -- n2                core,fig  negate  n1 -- n2                core,fig
 /* use minus as alias */  /* use minus as alias */
 n2 = -n1;  n2 = -n1;
   :
    invert 1+ ;
   
 1+      n1 -- n2                core            one_plus  1+      n1 -- n2                core            one_plus
 n2 = n1+1;  n2 = n1+1;
   :
    1 + ;
   
 1-      n1 -- n2                core            one_minus  1-      n1 -- n2                core            one_minus
 n2 = n1-1;  n2 = n1-1;
   :
    1 - ;
   
 max     n1 n2 -- n      core  max     n1 n2 -- n      core
 if (n1<n2)  if (n1<n2)
Line 300 
Line 352 
 else  else
   n = n1;    n = n1;
 :  :
  2dup < if   2dup < IF swap THEN drop ;
   swap drop  
  else  
   drop  
  endif ;  
   
 min     n1 n2 -- n      core  min     n1 n2 -- n      core
 if (n1<n2)  if (n1<n2)
   n = n1;    n = n1;
 else  else
   n = n2;    n = n2;
   :
    2dup > IF swap THEN drop ;
   
 abs     n1 -- n2        core  abs     n1 -- n2        core
 if (n1<0)  if (n1<0)
   n2 = -n1;    n2 = -n1;
 else  else
   n2 = n1;    n2 = n1;
   :
    dup 0< IF negate THEN ;
   
 *       n1 n2 -- n              core,fig        star  *       n1 n2 -- n              core,fig        star
 n = n1*n2;  n = n1*n2;
   :
    um* drop ;
   
 /       n1 n2 -- n              core,fig        slash  /       n1 n2 -- n              core,fig        slash
 n = n1/n2;  n = n1/n2;
   :
    /mod nip ;
   
 mod     n1 n2 -- n              core  mod     n1 n2 -- n              core
 n = n1%n2;  n = n1%n2;
   :
    /mod drop ;
   
 /mod    n1 n2 -- n3 n4          core            slash_mod  /mod    n1 n2 -- n3 n4          core            slash_mod
 n4 = n1/n2;  n4 = n1/n2;
 n3 = n1%n2; /* !! is this correct? look into C standard! */  n3 = n1%n2; /* !! is this correct? look into C standard! */
   :
    >r s>d r> fm/mod ;
   
 2*      n1 -- n2                core            two_star  2*      n1 -- n2                core            two_star
 n2 = 2*n1;  n2 = 2*n1;
   :
    dup + ;
   
 2/      n1 -- n2                core            two_slash  2/      n1 -- n2                core            two_slash
 /* !! is this still correct? */  /* !! is this still correct? */
Line 359 
Line 421 
   n3++;    n3++;
   n2-=n1;    n2-=n1;
 }  }
   :
    over >r dup >r abs -rot
    dabs rot um/mod
    r> 0< IF       negate       THEN
    r> 0< IF  swap negate swap  THEN ;
   
 m*      n1 n2 -- d              core    m_star  m*      n1 n2 -- d              core    m_star
 d = (DCell)n1 * (DCell)n2;  d = (DCell)n1 * (DCell)n2;
   :
    2dup      0< and >r
    2dup swap 0< and >r
    um* r> - r> - ;
   
 um*     u1 u2 -- ud             core    u_m_star  um*     u1 u2 -- ud             core    u_m_star
 /* use u* as alias */  /* use u* as alias */
Line 373 
Line 444 
   
 m+      d1 n -- d2              double          m_plus  m+      d1 n -- d2              double          m_plus
 d2 = d1+n;  d2 = d1+n;
   :
    s>d d+ ;
   
 d+      d1 d2 -- d              double,fig      d_plus  d+      d1 d2 -- d              double,fig      d_plus
 d = d1+d2;  d = d1+d2;
   :
    >r swap >r over 2/ over 2/ + >r over 1 and over 1 and + 2/
    r> + >r + r> 0< r> r> + swap - ;
   
 d-      d1 d2 -- d              double          d_minus  d-      d1 d2 -- d              double          d_minus
 d = d1-d2;  d = d1-d2;
   :
    dnegate d+ ;
   
 dnegate d1 -- d2                double  dnegate d1 -- d2                double
 /* use dminus as alias */  /* use dminus as alias */
 d2 = -d1;  d2 = -d1;
   :
    invert swap negate tuck 0= - ;
   
 dmax    d1 d2 -- d      double  dmax    d1 d2 -- d      double
 if (d1<d2)  if (d1<d2)
   d = d2;    d = d2;
 else  else
   d = d1;    d = d1;
   :
    2over 2over d> IF  2swap  THEN 2drop ;
   
 dmin    d1 d2 -- d      double  dmin    d1 d2 -- d      double
 if (d1<d2)  if (d1<d2)
   d = d1;    d = d1;
 else  else
   d = d2;    d = d2;
   :
    2over 2over d< IF  2swap  THEN 2drop ;
   
 dabs    d1 -- d2        double  dabs    d1 -- d2        double
 if (d1<0)  if (d1<0)
   d2 = -d1;    d2 = -d1;
 else  else
   d2 = d1;    d2 = d1;
   :
    dup 0< IF dnegate THEN ;
   
 d2*     d1 -- d2                double          d_two_star  d2*     d1 -- d2                double          d_two_star
 d2 = 2*d1;  d2 = 2*d1;
   :
    2dup d+ ;
   
 d2/     d1 -- d2                double          d_two_slash  d2/     d1 -- d2                double          d_two_slash
 /* !! is this still correct? */  /* !! is this still correct? */
 d2 = d1>>1;  d2 = d1>>1;
   :
    dup 1 and >r 2/ swap 2/ [ 1 8 cells 1- lshift 1- ] Literal and
    r> IF  [ 1 8 cells 1- lshift ] Literal + THEN  swap ;
   
 d>s     d -- n                  double          d_to_s  d>s     d -- n                  double          d_to_s
 /* make this an alias for drop? */  /* make this an alias for drop? */
 n = d;  n = d;
   :
    drop ;
   
 and     w1 w2 -- w              core,fig  and     w1 w2 -- w              core,fig
 w = w1&w2;  w = w1&w2;
Line 424 
Line 517 
   
 invert  w1 -- w2                core  invert  w1 -- w2                core
 w2 = ~w1;  w2 = ~w1;
   :
    -1 xor ;
   
 rshift  u1 n -- u2              core  rshift  u1 n -- u2              core
   u2 = u1>>n;    u2 = u1>>n;
Line 463 
Line 558 
   
 within  u1 u2 u3 -- f           core-ext  within  u1 u2 u3 -- f           core-ext
 f = FLAG(u1-u2 < u3-u2);  f = FLAG(u1-u2 < u3-u2);
   :
    over - >r - r> u< ;
   
 sp@     -- a_addr               fig             spat  sp@     -- a_addr               fig             spat
 a_addr = sp+1;  a_addr = sp+1;
Line 529 
Line 626 
 rot     w1 w2 w3 -- w2 w3 w1    core    rote  rot     w1 w2 w3 -- w2 w3 w1    core    rote
   
 -rot    w1 w2 w3 -- w3 w1 w2    fig     not_rote  -rot    w1 w2 w3 -- w3 w1 w2    fig     not_rote
   :
    rot rot ;
   
 nip     w1 w2 -- w2             core-ext  nip     w1 w2 -- w2             core-ext
   :
    swap drop ;
   
 tuck    w1 w2 -- w2 w1 w2       core-ext  tuck    w1 w2 -- w2 w1 w2       core-ext
   :
    swap over ;
   
 ?dup    w -- w                  core    question_dupe  ?dup    w -- w                  core    question_dupe
 if (w!=0) {  if (w!=0) {
Line 541 
Line 644 
   *--sp = w;    *--sp = w;
 #endif  #endif
 }  }
   :
    dup IF dup THEN ;
   
 pick    u -- w                  core-ext  pick    u -- w                  core-ext
 w = sp[u+1];  w = sp[u+1];
   :
    1+ cells sp@ + @ ;
   
 2drop   w1 w2 --                core    two_drop  2drop   w1 w2 --                core    two_drop
   :
    drop drop ;
   
 2dup    w1 w2 -- w1 w2 w1 w2    core    two_dupe  2dup    w1 w2 -- w1 w2 w1 w2    core    two_dupe
   :
    over over ;
   
 2over   w1 w2 w3 w4 -- w1 w2 w3 w4 w1 w2        core    two_over  2over   w1 w2 w3 w4 -- w1 w2 w3 w4 w1 w2        core    two_over
   :
    3 pick 3 pick ;
   
 2swap   w1 w2 w3 w4 -- w3 w4 w1 w2      core    two_swap  2swap   w1 w2 w3 w4 -- w3 w4 w1 w2      core    two_swap
   :
    >r -rot r> -rot ;
   
 2rot    w1 w2 w3 w4 w5 w6 -- w3 w4 w5 w6 w1 w2  double  two_rote  2rot    w1 w2 w3 w4 w5 w6 -- w3 w4 w5 w6 w1 w2  double  two_rote
   :
    >r >r 2swap r> r> 2swap ;
   
 \ toggle is high-level: 0.11/0.42%  \ toggle is high-level: 0.11/0.42%
   
Line 575 
Line 692 
 2!      w1 w2 a_addr --         core    two_store  2!      w1 w2 a_addr --         core    two_store
 a_addr[0] = w2;  a_addr[0] = w2;
 a_addr[1] = w1;  a_addr[1] = w1;
   :
    tuck ! cell+ ! ;
   
 2@      a_addr -- w1 w2         core    two_fetch  2@      a_addr -- w1 w2         core    two_fetch
 w2 = a_addr[0];  w2 = a_addr[0];
 w1 = a_addr[1];  w1 = a_addr[1];
   :
    dup cell+ @ swap @ ;
   
 d!      d a_addr --             double  d_store  d!      d a_addr --             double  d_store
 /* !! alignment problems on some machines */  /* !! alignment problems on some machines */
Line 589 
Line 710 
   
 cell+   a_addr1 -- a_addr2      core    cell_plus  cell+   a_addr1 -- a_addr2      core    cell_plus
 a_addr2 = a_addr1+1;  a_addr2 = a_addr1+1;
   :
    [ cell ] Literal + ;
   
 cells   n1 -- n2                core  cells   n1 -- n2                core
 n2 = n1 * sizeof(Cell);  n2 = n1 * sizeof(Cell);
   :
    [ cell ]
    [ 2/ dup ] [IF] 2* [THEN]
    [ 2/ dup ] [IF] 2* [THEN]
    [ 2/ dup ] [IF] 2* [THEN]
    [ 2/ dup ] [IF] 2* [THEN]
    [ drop ] ;
   
 char+   c_addr1 -- c_addr2      core    care_plus  char+   c_addr1 -- c_addr2      core    care_plus
 c_addr2 = c_addr1+1;  c_addr2 = c_addr1+1;
   :
    1+ ;
   
 chars   n1 -- n2                core    cares  chars   n1 -- n2                core    cares
 n2 = n1 * sizeof(Char);  n2 = n1 * sizeof(Char);
   :
    ;
   
 count   c_addr1 -- c_addr2 u    core  count   c_addr1 -- c_addr2 u    core
 u = *c_addr1;  u = *c_addr1;
 c_addr2 = c_addr1+1;  c_addr2 = c_addr1+1;
   :
    dup 1+ swap c@ ;
   
 (bye)   n --    toolkit-ext     paren_bye  (bye)   n --    toolkit-ext     paren_bye
 deprep_terminal();  
 return (Label *)n;  return (Label *)n;
   
 system  c_addr u -- n   own  system  c_addr u -- n   own
Line 658 
Line 793 
       strncasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */)        strncasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
     break;      break;
 f83name2=f83name1;  f83name2=f83name1;
   :
    BEGIN  dup  WHILE
           >r dup r@ cell+ c@ $1F and =
           IF  2dup r@ cell+ char+ capscomp  0=
               IF  2drop r>  EXIT  THEN  THEN
           r> @
    REPEAT  nip nip ;
   
 (hashfind)      c_addr u a_addr -- f83name2     new     paren_hashfind  (hashfind)      c_addr u a_addr -- f83name2     new     paren_hashfind
 F83Name *f83name1;  F83Name *f83name1;
Line 673 
Line 815 
         break;          break;
      }       }
 }  }
   :
    BEGIN  dup  WHILE
           2@ >r >r dup r@ cell+ c@ $1F and =
           IF  2dup r@ cell+ char+ capscomp 0=
               IF  2drop r> rdrop  EXIT  THEN  THEN
           rdrop r>
    REPEAT nip nip ;
   
 (hashkey)       c_addr u1 -- u2         new     paren_hashkey  (hashkey)       c_addr u1 -- u2         new     paren_hashkey
 u2=0;  u2=0;
 while(u1--)  while(u1--)
    u2+=(int)toupper(*c_addr++);     u2+=(int)toupper(*c_addr++);
   :
    0 -rot bounds ?DO  I c@ toupper +  LOOP ;
   
 (hashkey1)      c_addr u ubits -- ukey          new     paren_hashkey1  (hashkey1)      c_addr u ubits -- ukey          new     paren_hashkey1
 ""ukey is the hash key for the string c_addr u fitting in ubits bits""  ""ukey is the hash key for the string c_addr u fitting in ubits bits""
Line 693 
Line 844 
     ukey = ((((ukey<<rot) | (ukey>>(ubits-rot)))      ukey = ((((ukey<<rot) | (ukey>>(ubits-rot)))
              ^ toupper(*cp))               ^ toupper(*cp))
             & ((1<<ubits)-1));              & ((1<<ubits)-1));
   :
    dup rot-values + c@ over 1 swap lshift 1- >r
    tuck - 2swap r> 0 2swap bounds
    ?DO  dup 4 pick lshift swap 3 pick rshift or
         I c@ toupper xor
         over and  LOOP
    nip nip nip ;
   Create rot-values
     5 c, 0 c, 1 c, 2 c, 3 c,  4 c, 5 c, 5 c, 5 c, 5 c,
     3 c, 5 c, 5 c, 5 c, 5 c,  7 c, 5 c, 5 c, 5 c, 5 c,
     7 c, 5 c, 5 c, 5 c, 5 c,  6 c, 5 c, 5 c, 5 c, 5 c,
     7 c, 5 c, 5 c,
   
 (parse-white)   c_addr1 u1 -- c_addr2 u2        new     paren_parse_white  (parse-white)   c_addr1 u1 -- c_addr2 u2        new     paren_parse_white
 /* use !isgraph instead of isspace? */  /* use !isgraph instead of isspace? */
Line 708 
Line 871 
   c_addr2 = c_addr1;    c_addr2 = c_addr1;
   u2 = 0;    u2 = 0;
 }  }
   :
    BEGIN  dup  WHILE  over c@ bl <=  WHILE  1 /string
    REPEAT  THEN  2dup
    BEGIN  dup  WHILE  over c@ bl >   WHILE  1 /string
    REPEAT  THEN  nip - ;
   
 close-file      wfileid -- wior file    close_file  close-file      wfileid -- wior file    close_file
 wior = FILEIO(fclose((FILE *)wfileid)==EOF);  wior = FILEIO(fclose((FILE *)wfileid)==EOF);
Line 950 
Line 1118 
   
 fexpm1          r1 -- r2        float-ext  fexpm1          r1 -- r2        float-ext
 r2 =  r2 =
 #ifdef expm1  #ifdef HAS_EXPM1
         expm1(r1);          expm1(r1);
 #else  #else
         exp(r1)-1;          exp(r1)-1;
Line 961 
Line 1129 
   
 flnp1           r1 -- r2        float-ext  flnp1           r1 -- r2        float-ext
 r2 =  r2 =
 #ifdef log1p  #ifdef HAS_LOG1P
         log1p(r1);          log1p(r1);
 #else  #else
         log(r1+1);          log(r1+1);
Line 1034 
Line 1202 
 w = *(Cell *)(lp+(int)(*ip++));  w = *(Cell *)(lp+(int)(*ip++));
   
 @local0 -- w    new     fetch_local_zero  @local0 -- w    new     fetch_local_zero
 w = *(Cell *)(lp+0);  w = *(Cell *)(lp+0*sizeof(Cell));
   
 @local4 -- w    new     fetch_local_four  @local1 -- w    new     fetch_local_four
 w = *(Cell *)(lp+4);  w = *(Cell *)(lp+1*sizeof(Cell));
   
 @local8 -- w    new     fetch_local_eight  @local2 -- w    new     fetch_local_eight
 w = *(Cell *)(lp+8);  w = *(Cell *)(lp+2*sizeof(Cell));
   
 @local12        -- w    new     fetch_local_twelve  @local3 -- w    new     fetch_local_twelve
 w = *(Cell *)(lp+12);  w = *(Cell *)(lp+3*sizeof(Cell));
   
 f@local#        -- r    new     f_fetch_local_number  f@local#        -- r    new     f_fetch_local_number
 r = *(Float *)(lp+(int)(*ip++));  r = *(Float *)(lp+(int)(*ip++));
   
 f@local0        -- r    new     f_fetch_local_zero  f@local0        -- r    new     f_fetch_local_zero
 r = *(Float *)(lp+0);  r = *(Float *)(lp+0*sizeof(Float));
   
 f@local8        -- r    new     f_fetch_local_eight  f@local1        -- r    new     f_fetch_local_eight
 r = *(Float *)(lp+8);  r = *(Float *)(lp+1*sizeof(Float));
   
 laddr#          -- c_addr       new     laddr_number  laddr#          -- c_addr       new     laddr_number
 /* this can also be used to implement lp@ */  /* this can also be used to implement lp@ */
Line 1064 
Line 1232 
 stack""  stack""
 lp += (int)(*ip++);  lp += (int)(*ip++);
   
 -4lp+!  --      new     minus_four_lp_plus_store  lp-     --      new     minus_four_lp_plus_store
 lp += -4;  lp += -sizeof(Cell);
   
 8lp+!   --      new     eight_lp_plus_store  lp+     --      new     eight_lp_plus_store
 lp += 8;  lp += sizeof(Float);
   
 16lp+!  --      new     sixteen_lp_plus_store  lp+2    --      new     sixteen_lp_plus_store
 lp += 16;  lp += 2*sizeof(Float);
   
 lp!     c_addr --       new     lp_store  lp!     c_addr --       new     lp_store
 lp = (Address)c_addr;  lp = (Address)c_addr;
Line 1085 
Line 1253 
 *(Float *)lp = r;  *(Float *)lp = r;
   
 up!     a_addr --       new     up_store  up!     a_addr --       new     up_store
 up=(char *)a_addr;  up0=up=(char *)a_addr;
 up0=(char *)a_addr;  

Generate output suitable for use with a patch program
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help