gforth: gforth/prim

Diff for /gforth/prim between version 1.51 and 1.52

-version 1.51, Tue Aug  8 12:37:05 2000 UTC
+version 1.52, Wed Aug  9 20:04:06 2000 UTC
  Line 445
  Line 445
  Line 445
  \ digit is high-level: 0/0%
  move    ( c_from c_to ucount -- )               core
- ""Copy the contents of @i{ucount} address units at @i{c-from} to
+ ""Copy the contents of @i{ucount} aus at @i{c-from} to
  @i{c-to}. @code{move} works correctly even if the two areas overlap.""
+ /* !! note that the standard specifies addr, not c-addr */
  memmove(c_to,c_from,ucount);
  /* make an Ifdef for bsd and others? */
  :
- Line 475
+ Line 476
  Line 475
  Line 476
   DO  1- dup c@ I c!  -1 +LOOP  drop ;
  fill    ( c_addr u c -- )       core
- "" If @i{u}>0, store character @i{c} in each of @i{u} consecutive
+ ""Store @i{c} in @i{u} chars starting at @i{c-addr}.""
- @code{char} addresses in memory, starting at address @i{c-addr}.""
  memset(c_addr,c,u);
  :
   -rot bounds
  Line 600
  Line 600
  Line 600
  :
 dup > IF swap THEN drop ;
- abs     ( n1 -- n2 )    core
+ abs     ( n -- u )      core
- if (n1<0)
+ if (n<0)
-   n2 = -n1;
+   u = -n;
  else
-   n2 = n1;
+   u = n;
  :
   dup 0< IF negate THEN ;
  Line 630
  Line 630
  Line 630
   >r s>d r> fm/mod ;
 *      ( n1 -- n2 )            core            two_star
+ ""Shift left by 1; also works on unsigned numbers""
  n2 = 2*n1;
  :
   dup + ;
 /      ( n1 -- n2 )            core            two_slash
- /* !! is this still correct? */
+ ""Arithmetic shift right by 1.  For signed numbers this is a floored
+ division by 2 (note that @code{/} not necessarily floors).""
  n2 = n1>>1;
  :
   dup MINI and IF 1 ELSE 0 THEN
- Line 777
+ Line 779
  Line 777
  Line 779
   invert swap negate tuck 0= - ;
  d2*     ( d1 -- d2 )            double          d_two_star
+ ""Shift left by 1; also works on unsigned numbers""
  #ifdef BUGGY_LONG_LONG
  d2.lo = d1.lo<<1;
  d2.hi = (d1.hi<<1) | (d1.lo>>(CELL_BITS-1));
- Line 787
+ Line 790
  Line 787
  Line 790
 dup d+ ;
  d2/     ( d1 -- d2 )            double          d_two_slash
+ ""Arithmetic shift right by 1.  For signed numbers this is a floored
+ division by 2.""
  #ifdef BUGGY_LONG_LONG
  d2.hi = d1.hi>>1;
  d2.lo= (d1.lo>>1) | (d1.hi<<(CELL_BITS-1));
- Line 939
+ Line 944
  Line 939
  Line 944
  around from @code{max-u} to 0 for unsigned, and from @code{max-n} to
  min-n for signed numbers); now consider the range from u2 towards
  increasing numbers up to and excluding u3 (giving an empty range if
- u2=u3; if u1 is in this range, @code{within} returns true.""
+ u2=u3); if u1 is in this range, @code{within} returns true.""
  f = FLAG(u1-u2 < u3-u2);
  :
   over - >r - r> u< ;
- Line 972
+ Line 977
  Line 972
  Line 977
  SET_IP((Xt *)(*rp++));
  >r      ( w -- )                core    to_r
+ ""@code{( R: -- w )}""
  *--rp = w;
  :
   (>r) ;
  : (>r)  rp@ cell+ @ rp@ ! rp@ cell+ ! ;
  r>      ( -- w )                core    r_from
+ ""@code{( R: w -- )}""
  w = *rp++;
  :
   rp@ cell+ @ rp@ @ rp@ cell+ ! (rdrop) rp@ ! ;
  Create (rdrop) ' ;s A,
  rdrop   ( -- )          gforth
+ ""@code{( R: w -- )}""
  rp++;
  :
   r> r> drop >r ;
 >r     ( w1 w2 -- )    core-ext        two_to_r
+ ""@code{( R: -- w1 w2 )}""
  *--rp = w1;
  *--rp = w2;
  :
   swap r> swap >r swap >r >r ;
 r>     ( -- w1 w2 )    core-ext        two_r_from
+ ""@code{( R: w1 w2 -- )}""
  w2 = *rp++;
  w1 = *rp++;
  :
   r> r> swap r> swap >r swap ;
 r@     ( -- w1 w2 )    core-ext        two_r_fetch
+ ""@code{( R: w1 w2 -- w1 w2 )}""
  w2 = rp[0];
  w1 = rp[1];
  :
   i' j ;
 rdrop  ( -- )          gforth  two_r_drop
+ ""@code{( R: w1 w2 -- )}""
  rp+=2;
  :
   r> r> drop r> drop >r ;
- Line 1050
+ Line 1062
  Line 1050
  Line 1062
   swap over ;
  ?dup    ( w -- w )                      core    question_dupe
+ ""Actually the stack effect is: @code{( w -- 0 | w w )}.  It performs a
+ @code{dup} if w is nonzero.""
  if (w!=0) {
    IF_TOS(*sp-- = w;)
  #ifndef USE_TOS
- Line 1060
+ Line 1074
  Line 1060
  Line 1074
   dup IF dup THEN ;
  pick    ( u -- w )                      core-ext
+ ""Actually the stack effect is @code{ x0 ... xu u -- x0 ... xu x0 }.""
  w = sp[u+1];
  :
 + cells sp@ + @ ;
- Line 1095
+ Line 1110
  Line 1095
  Line 1110
  \ toggle is high-level: 0.11/0.42%
  @       ( a_addr -- w )         core    fetch
- "" Read from the cell at address @i{a-addr}, and return its contents, @i{w}.""
+ ""@i{w} is the cell stored at @i{a_addr}.""
  w = *a_addr;
  !       ( w a_addr -- )         core    store
- "" Write the value @i{w} to the cell at address @i{a-addr}.""
+ ""Store @i{w} into the cell at @i{a-addr}.""
  *a_addr = w;
  +!      ( n a_addr -- )         core    plus_store
- "" Add @i{n} to the value stored in the cell at address @i{a-addr}.""
+ ""Add @i{n} to the cell at @i{a-addr}.""
  *a_addr += n;
  :
   tuck @ + swap ! ;
  c@      ( c_addr -- c )         core    c_fetch
- "" Read from the char at address @i{c-addr}, and return its contents, @i{c}.""
+ ""@i{c} is the char stored at @i{c_addr}.""
  c = *c_addr;
  :
  [ bigendian [IF] ]
- Line 1135
+ Line 1150
  Line 1135
  Line 1150
  : 8>> 2/ 2/ 2/ 2/  2/ 2/ 2/ 2/ ;
  c!      ( c c_addr -- )         core    c_store
- "" Write the value @i{c} to the char at address @i{c-addr}.""
+ ""Store @i{c} into the char at @i{c-addr}.""
  *c_addr = c;
  :
  [ bigendian [IF] ]
- Line 1165
+ Line 1180
  Line 1165
  Line 1180
  : 8<< 2* 2* 2* 2*  2* 2* 2* 2* ;
 !      ( w1 w2 a_addr -- )             core    two_store
- "" Write the value @i{w1, w2} to the double at address @i{a-addr}.""
+ ""Store @i{w2} into the cell at @i{c-addr} and @i{w1} into the next cell.""
  a_addr[0] = w2;
  a_addr[1] = w1;
  :
   tuck ! cell+ ! ;
 @      ( a_addr -- w1 w2 )             core    two_fetch
- "" Read from the double at address @i{a-addr}, and return its contents, @i{w1, w2}.""
+ ""@i{w2} is the content of the cell stored at @i{a-addr}, @i{w1} is
+ the content of the next cell.""
  w2 = a_addr[0];
  w1 = a_addr[1];
  :
   dup cell+ @ swap @ ;
  cell+   ( a_addr1 -- a_addr2 )  core    cell_plus
- "" Increment @i{a-addr1} by the number of address units corresponding to the size of
+ ""@code{1 cells +}""
- one cell, to give @i{a-addr2}.""
  a_addr2 = a_addr1+1;
  :
   cell + ;
  cells   ( n1 -- n2 )            core
- "" @i{n2} is the number of address units corresponding to @i{n1} cells.""
+ "" @i{n2} is the number of address units of @i{n1} cells.""
  n2 = n1 * sizeof(Cell);
  :
   [ cell
- Line 1197
+ Line 1212
  Line 1197
  Line 1212
   drop ] ;
  char+   ( c_addr1 -- c_addr2 )  core    char_plus
- "" Increment @i{c-addr1} by the number of address units corresponding to the size of
+ ""@code{1 chars +}.""
- one char, to give @i{c-addr2}.""
  c_addr2 = c_addr1 + 1;
  :
 + ;
- Line 1526
+ Line 1540
  Line 1526
  Line 1540
  contents of the data space is undefined. If the allocation is successful,
  @i{a-addr} is the start address of the allocated region and @i{wior}
  is 0. If the allocation fails, @i{a-addr} is undefined and @i{wior}
- is an implementation-defined I/O result code.""
+ is a non-zero I/O result code.""
  a_addr = (Cell *)malloc(u?u:1);
  wior = IOR(a_addr==NULL);
  free    ( a_addr -- wior )              memory
  ""Return the region of data space starting at @i{a-addr} to the system.
- The regon must originally have been obtained using @code{allocate} or
+ The region must originally have been obtained using @code{allocate} or
  @code{resize}. If the operational is successful, @i{wior} is 0.
- If the operation fails, @i{wior} is an implementation-defined
+ If the operation fails, @i{wior} is a non-zero I/O result code.""
- I/O result code.""
  free(a_addr);
  wior = 0;
- Line 1543
+ Line 1556
  Line 1543
  Line 1556
  ""Change the size of the allocated area at @i{a-addr1} to @i{u}
  address units, possibly moving the contents to a different
  area. @i{a-addr2} is the address of the resulting area.
- If the operational is successful, @i{wior} is 0.
+ If the operation is successful, @i{wior} is 0.
- If the operation fails, @i{wior} is an implementation-defined
+ If the operation fails, @i{wior} is a non-zero
  I/O result code. If @i{a-addr1} is 0, Gforth's (but not the Standard)
  @code{resize} @code{allocate}s @i{u} address units.""
  /* the following check is not necessary on most OSs, but it is needed
- Line 1743
+ Line 1756
  Line 1743
  Line 1756
  #endif
  f!      ( r f_addr -- ) float   f_store
- "" Store the floating-point value @i{r} to address @i{f-addr}.""
+ ""Store @i{r} into the float at address @i{f-addr}.""
  *f_addr = r;
  f@      ( f_addr -- r ) float   f_fetch
- "" Fetch floating-point value @i{r} from address @i{f-addr}.""
+ ""@i{r} is the float at address @i{f-addr}.""
  r = *f_addr;
  df@     ( df_addr -- r )        float-ext       d_f_fetch
- Line 1759
+ Line 1772
  Line 1759
  Line 1772
  #endif
  df!     ( r df_addr -- )        float-ext       d_f_store
- "" Store the double-precision IEEE floating-point value @i{r} to the address @i{df-addr}.""
+ ""Store @i{r} as double-precision IEEE floating-point value to the
+ address @i{df-addr}.""
  #ifdef IEEE_FP
  *df_addr = r;
  #else
- Line 1775
+ Line 1789
  Line 1775
  Line 1789
  #endif
  sf!     ( r sf_addr -- )        float-ext       s_f_store
- "" Store the single-precision IEEE floating-point value @i{r} to the address @i{sf-addr}.""
+ ""Store @i{r} as single-precision IEEE floating-point value to the
+ address @i{sf-addr}.""
  #ifdef IEEE_FP
  *sf_addr = r;
  #else
- Line 1816
+ Line 1831
  Line 1816
  Line 1831
  ftuck   ( r1 r2 -- r2 r1 r2 )   gforth  f_tuck
  float+  ( f_addr1 -- f_addr2 )  float   float_plus
- "" Increment @i{f-addr1} by the number of address units corresponding to the size of
+ ""@code{1 floats +}.""
- one floating-point number, to give @i{f-addr2}.""
  f_addr2 = f_addr1+1;
  floats  ( n1 -- n2 )    float
- ""@i{n2} is the number of address units corresponding to @i{n1} floating-point numbers.""
+ ""@i{n2} is the number of address units of @i{n1} floats.""
  n2 = n1*sizeof(Float);
  floor   ( r1 -- r2 )    float
- Line 2016
+ Line 2030
  Line 2016
  Line 2030
   r> IF  fnegate  THEN ;
  sfloats ( n1 -- n2 )    float-ext       s_floats
- ""@i{n2} is the number of address units corresponding to @i{n1}
+ ""@i{n2} is the number of address units of @i{n1}
  single-precision IEEE floating-point numbers.""
  n2 = n1*sizeof(SFloat);
  dfloats ( n1 -- n2 )    float-ext       d_floats
- ""@i{n2} is the number of address units corresponding to @i{n1}
+ ""@i{n2} is the number of address units of @i{n1}
  double-precision IEEE floating-point numbers.""
  n2 = n1*sizeof(DFloat);
- Line 2113
+ Line 2127
  Line 2113
  Line 2127
  *(Float *)lp = r;
  fpick   ( u -- r )              gforth
+ ""Actually the stack effect is @code{ r0 ... ru u -- r0 ... ru r0 }.""
  r = fp[u+1]; /* +1, because update of fp happens before this fragment */
  :
   floats fp@ + f@ ;

-Generate output suitable for use with a patch program
+Legend:



Removed from v.1.51
 


changed lines


 
Added in v.1.52
 Legend:



Removed from v.1.51
 


changed lines


 
Added in v.1.52
-Removed from v.1.51
+Added in v.1.52

CVS Admin

gforth: gforth/prim

Diff for /gforth/prim between version 1.51 and 1.52

ViewCVS and CVS Help