### Diff for /gforth/prim between versions 1.271 and 1.279

version 1.271, 2012/04/12 16:11:40 version 1.279, 2012/10/08 22:45:19
Line 1109  if (u1<u2) Line 1109  if (u1<u2)
else  else
u = u1;    u = u1;
:  :
2dup u< IF swap THEN drop ;   2dup u> select ;

umin    ( u1 u2 -- u )  core  umin    ( u1 u2 -- u )  core
if (u1<u2)  if (u1<u2)
Line 1117  if (u1<u2) Line 1117  if (u1<u2)
else  else
u = u2;    u = u2;
:  :
2dup u> IF swap THEN drop ;   2dup u< select ;

mux   ( u1 u2 u3 -- u )    gforth
""multiplex @i{u1} for 1 bits in @i{u3}, @i{u2} for 0 bits in @i{u3} into @i{u}""
u = (u3 & u1) | (~u3 & u2);
:
tuck and >r invert and r> ;

select ( u1 u2 f -- u )    gforth
""select @i{u1} if @i{f} is true, @i{u2} if false.""
u = f ? u1 : u2;
:
IF swap THEN nip ;

\g compare  \g compare

:  :
dup 1+ swap c@ ;   dup 1+ swap c@ ;

cell/ ( n1 -- n2 )      gforth cell_divide
""@i{n2} is the number of cells that fit into @i{n1}""
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 ] ;

\g compiler  \g compiler

Line 1700  wfileid = (Cell)stderr; Line 1723  wfileid = (Cell)stderr;

\+os  \+os

form    ( -- urows ucols )      gforth  (form)  ( -- urows ucols )      gforth  paren_form
""The number of lines and columns in the terminal. These numbers may  ""The number of lines and columns in the terminal. These numbers may
change with the window size.  Note that it depends on the OS whether  change with the window size.  Note that it depends on the OS whether
this reflects the actual size and changes with the window size  this reflects the actual size and changes with the window size

(bye)   ( n -- )        gforth  paren_bye  (bye)   ( n -- )        gforth  paren_bye
SUPER_END;  SUPER_END;
gforth_FP=fp;
gforth_SP=sp;
gforth_RP=rp;
gforth_LP=lp;
return (Label *)n;  return (Label *)n;

(system)        ( c_addr u -- wretval wior )    gforth  paren_system  (system)        ( c_addr u -- wretval wior )    gforth  paren_system
Line 2075  clock_gettime(CLOCK_REALTIME,&time1); Line 2102  clock_gettime(CLOCK_REALTIME,&time1);
#else  #else
struct timeval time2;  struct timeval time2;
gettimeofday(&time2,NULL);  gettimeofday(&time2,NULL);
time1.tv_sec = time2.tv_sec;1  time1.tv_sec = time2.tv_sec;
time1.tv_nsec = time2.tv_usec*1000;  time1.tv_nsec = time2.tv_usec*1000;
#endif  #endif
dtime = timespec2ns(&time1);  dtime = timespec2ns(&time1);
Line 2262  representation. If the string represents Line 2289  representation. If the string represents
true. Otherwise, @i{flag} is false. A string of blanks is a special  true. Otherwise, @i{flag} is false. A string of blanks is a special
case and represents the floating-point number 0.""  case and represents the floating-point number 0.""
Float r;  Float r;
if (flag) {  if (flag) {
fp--;    fp--;
fp[0]=r;    fp[0]=r;
Line 2457  faxpy(ra, f_x, nstridex, f_y, nstridey, Line 2484  faxpy(ra, f_x, nstridex, f_y, nstridey,
fdup dup f@ f* over + 2swap dup f@ f+ dup f! over + 2swap       fdup dup f@ f* over + 2swap dup f@ f+ dup f! over + 2swap
LOOP 2drop 2drop fdrop ;   LOOP 2drop 2drop fdrop ;

>float1 ( c_addr u c -- f:... flag )    gforth  to_float1
""Actual stack effect: ( c_addr u c -- r t | f ).  Attempt to convert the
character string @i{c-addr u} to internal floating-point
representation. If the string represents a valid floating-point number
@i{r} is placed on the floating-point stack and @i{flag} is
true. Otherwise, @i{flag} is false. A string of blanks is a special
case and represents the floating-point number 0.""
Float r;
flag = to_float(c_addr, u, &r, c);
if (flag) {
fp--;
fp[0]=r;
}

float/ ( n1 -- n2 )     gforth  float_divide
n2 = n1 / sizeof(Float);

dfloat/ ( n1 -- n2 )    gforth  sfloat_divide
n2 = n1 / sizeof(DFloat);

sfloat/ ( n1 -- n2 )    gforth  dfloat_divide
n2 = n1 / sizeof(SFloat);

\+  \+

\ The following words access machine/OS/installation-dependent  \ The following words access machine/OS/installation-dependent
Line 2779  ip=IP; Line 2829  ip=IP;
SUPER_END;  SUPER_END;

\+objects
\g object_pointer

>o ( c_addr -- r:c_old )        new     to_o
c_old = op;

o> ( r:c_addr -- )              new     o_restore