### Diff for /gforth/prim between versions 1.32 and 1.46

version 1.32, 1999/05/15 20:00:21 version 1.46, 2000/05/31 14:37:40
Line 445  n = rp[4]; Line 445  n = rp[4];
\ digit is high-level: 0/0%  \ digit is high-level: 0/0%

move    c_from c_to ucount --           core  move    c_from c_to ucount --           core
"" If @i{ucount}>0, copy the contents of @i{ucount} address units  ""Copy the contents of @i{ucount} address units at @i{c-from} to
at @i{c-from} to @i{c-to}. @code{move} chooses its copy direction  @i{c-to}. @code{move} works correctly even if the two areas overlap.""
to avoid problems when @i{c-from}, @i{c-to} overlap.""
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 ;   >r 2dup u< IF r> cmove> ELSE r> cmove THEN ;

cmove   c_from c_to u --        string  cmove   c_from c_to u --        string  c_move
"" If @i{u}>0, copy the contents of @i{ucount} characters from  ""Copy the contents of @i{ucount} characters from data space at
data space at @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}  @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}
safe if @i{c-to}=<@i{c-from}.""
while (u-- > 0)  while (u-- > 0)
*c_to++ = *c_from++;    *c_to++ = *c_from++;
:  :
bounds ?DO  dup c@ I c! 1+  LOOP  drop ;   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
"" If @i{u}>0, copy the contents of @i{ucount} characters from  ""Copy the contents of @i{ucount} characters from data space at
data space at @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}  @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}
safe if @i{c-to}>=@i{c-from}.""
while (u-- > 0)  while (u-- > 0)
c_to[u] = c_from[u];    c_to[u] = c_from[u];
:  :
Line 487  the first string is smaller, @i{n} is -1 Line 488  the first string is smaller, @i{n} is -1
is 1. Currently this is based on the machine's character  is 1. Currently this is based on the machine's character
comparison. In the future, this may change to consider the current  comparison. In the future, this may change to consider the current
locale and its collation order.""  locale and its collation order.""
/* close ' to keep fontify happy */
if (n==0)  if (n==0)
n = u1-u2;    n = u1-u2;
Line 495  if (n<0) Line 497  if (n<0)
else if (n>0)  else if (n>0)
n = 1;    n = 1;
:  :
rot 2dup - >r min swap -text dup   rot 2dup swap - >r min swap -text dup
IF    rdrop   IF  rdrop  ELSE  drop r> sgn  THEN ;
ELSE  drop r@ 0>  : sgn ( n -- -1/0/1 )
IF    rdrop -1   dup 0= IF EXIT THEN  0< 2* 1+ ;
ELSE  r> 1 and
THEN
THEN ;

Line 513  else if (n>0) Line 512  else if (n>0)
swap bounds   swap bounds
?DO  dup c@ I c@ = WHILE  1+  LOOP  drop 0   ?DO  dup c@ I c@ = WHILE  1+  LOOP  drop 0
ELSE  c@ I c@ - unloop  THEN  -text-flag ;   ELSE  c@ I c@ - unloop  THEN  -text-flag ;
: -text-flag ( n -- -1/0/1 )  : sgn ( n -- -1/0/1 )
dup 0< IF  drop -1  ELSE  0>  1 and  THEN  ;   dup 0= IF EXIT THEN  0< 2* 1+ ;

toupper c1 -- c2        gforth  toupper c1 -- c2        gforth
""If @i{c1} is a lower-case character (in the current locale), @i{c2}  ""If @i{c1} is a lower-case character (in the current locale), @i{c2}
Line 767  d = d1-d2; Line 766  d = d1-d2;
:  :
dnegate d+ ;   dnegate d+ ;

dnegate d1 -- d2                double  dnegate d1 -- d2                double  d_negate
/* use dminus as alias */  /* use dminus as alias */
#ifdef BUGGY_LONG_LONG  #ifdef BUGGY_LONG_LONG
d2 = dnegate(d1);  d2 = dnegate(d1);
Line 806  w = w1|w2; Line 805  w = w1|w2;
:  :
invert swap invert and invert ;   invert swap invert and invert ;

xor     w1 w2 -- w              core  xor     w1 w2 -- w              core    x_or
w = w1^w2;  w = w1^w2;

invert  w1 -- w2                core  invert  w1 -- w2                core
Line 814  w2 = ~w1; Line 813  w2 = ~w1;
:  :
MAXU xor ;   MAXU xor ;

rshift  u1 n -- u2              core  rshift  u1 n -- u2              core    r_shift
u2 = u1>>n;    u2 = u1>>n;
:  :
0 ?DO 2/ MAXI and LOOP ;      0 ?DO 2/ MAXI and LOOP ;

lshift  u1 n -- u2              core  lshift  u1 n -- u2              core    l_shift
u2 = u1<<n;    u2 = u1<<n;
:  :
0 ?DO 2* LOOP ;      0 ?DO 2* LOOP ;
Line 835  f = FLAG(\$4==\$5); Line 834  f = FLAG(\$4==\$5);
] xor 0= [          ] xor 0= [
[THEN] ] ;      [THEN] ] ;

\$1<>    \$2 -- f         \$7      \$3different  \$1<>    \$2 -- f         \$7      \$3not_equals
f = FLAG(\$4!=\$5);  f = FLAG(\$4!=\$5);
:  :
[ char \$1x char 0 = [IF]      [ char \$1x char 0 = [IF]
Line 844  f = FLAG(\$4!=\$5); Line 843  f = FLAG(\$4!=\$5);
] xor 0<> [          ] xor 0<> [
[THEN] ] ;      [THEN] ] ;

\$1<     \$2 -- f         \$8      \$3less  \$1<     \$2 -- f         \$8      \$3less_than
f = FLAG(\$4<\$5);  f = FLAG(\$4<\$5);
:  :
[ char \$1x char 0 = [IF]      [ char \$1x char 0 = [IF]
Line 856  f = FLAG(\$4<\$5); Line 855  f = FLAG(\$4<\$5);
[THEN]          [THEN]
[THEN] ] ;      [THEN] ] ;

\$1>     \$2 -- f         \$9      \$3greater  \$1>     \$2 -- f         \$9      \$3greater_than
f = FLAG(\$4>\$5);  f = FLAG(\$4>\$5);
:  :
[ char \$1x char 0 = [IF] ] negate [ [ELSE] ] swap [ [THEN] ]      [ char \$1x char 0 = [IF] ] negate [ [ELSE] ] swap [ [THEN] ]
Line 888  f = FLAG(\$4.lo==\$5.lo && \$4.hi==\$5.hi); Line 887  f = FLAG(\$4.lo==\$5.lo && \$4.hi==\$5.hi);
f = FLAG(\$4==\$5);  f = FLAG(\$4==\$5);
#endif  #endif

\$1<>    \$2 -- f         \$7      \$3different  \$1<>    \$2 -- f         \$7      \$3not_equals
#ifdef BUGGY_LONG_LONG  #ifdef BUGGY_LONG_LONG
f = FLAG(\$4.lo!=\$5.lo || \$4.hi!=\$5.hi);  f = FLAG(\$4.lo!=\$5.lo || \$4.hi!=\$5.hi);
#else  #else
f = FLAG(\$4!=\$5);  f = FLAG(\$4!=\$5);
#endif  #endif

\$1<     \$2 -- f         \$8      \$3less  \$1<     \$2 -- f         \$8      \$3less_than
#ifdef BUGGY_LONG_LONG  #ifdef BUGGY_LONG_LONG
f = FLAG(\$4.hi==\$5.hi ? \$4.lo<\$5.lo : \$4.hi<\$5.hi);  f = FLAG(\$4.hi==\$5.hi ? \$4.lo<\$5.lo : \$4.hi<\$5.hi);
#else  #else
f = FLAG(\$4<\$5);  f = FLAG(\$4<\$5);
#endif  #endif

\$1>     \$2 -- f         \$9      \$3greater  \$1>     \$2 -- f         \$9      \$3greater_than
#ifdef BUGGY_LONG_LONG  #ifdef BUGGY_LONG_LONG
f = FLAG(\$4.hi==\$5.hi ? \$4.lo>\$5.lo : \$4.hi>\$5.hi);  f = FLAG(\$4.hi==\$5.hi ? \$4.lo>\$5.lo : \$4.hi>\$5.hi);
#else  #else
Line 1025  swap w1 w2 -- w2 w1  core Line 1024  swap w1 w2 -- w2 w1  core
>r (swap) ! r> (swap) @ ;   >r (swap) ! r> (swap) @ ;
Variable (swap)  Variable (swap)

dup     w -- w w                core  dup     w -- w w                core    dupe
:  :
sp@ @ ;   sp@ @ ;

[ 1 floats 1- ] Literal + [ -1 floats ] Literal and ;   [ 1 floats 1- ] Literal + [ -1 floats ] Literal and ;

>body           xt -- a_addr    core    to_body  >body           xt -- a_addr    core    to_body
"" Get the address of the body of the word represented by @i{xt} (the address
of the word's data field).""
:  :
2 cells + ;      2 cells + ;

\+standardthreading  \ threading stuff is currently only interesting if we have a compiler
\fhas? standardthreading has? compiler and [IF]

Line 1414  n=1; Line 1416  n=1;
:  :
1 ;   1 ;

\+  \f[THEN]

key-file        wfileid -- n            gforth  paren_key_file  key-file        wfileid -- n            gforth  paren_key_file
#ifdef HAS_FILE  #ifdef HAS_FILE
is the host operating system's expansion of that environment variable. If the  is the host operating system's expansion of that environment variable. If the
environment variable does not exist, @i{c-addr2 u2} specifies a string 0 characters  environment variable does not exist, @i{c-addr2 u2} specifies a string 0 characters
in length.""  in length.""
/* close ' to keep fontify happy */

Line 1495  wretval = pclose((FILE *)wfileid); Line 1498  wretval = pclose((FILE *)wfileid);
wior = IOR(wretval==-1);  wior = IOR(wretval==-1);

time&date       -- nsec nmin nhour nday nmonth nyear    facility-ext    time_and_date  time&date       -- nsec nmin nhour nday nmonth nyear    facility-ext    time_and_date
""Report the current time of day. Seconds, minutes and hours are numbered from 0.
Months are numbered from 1.""
struct timeval time1;  struct timeval time1;
struct timezone zone1;  struct timezone zone1;
struct tm *ltime;  struct tm *ltime;
Line 1508  nmin  =ltime->tm_min; Line 1513  nmin  =ltime->tm_min;
nsec  =ltime->tm_sec;  nsec  =ltime->tm_sec;

ms      n --    facility-ext  ms      n --    facility-ext
""Wait at least @i{n} milli-second.""
struct timeval timeout;  struct timeval timeout;
timeout.tv_sec=n/1000;  timeout.tv_sec=n/1000;
timeout.tv_usec=1000*(n%1000);  timeout.tv_usec=1000*(n%1000);
Line 1541  I/O result code. If @i{a-addr1} is 0, Gf Line 1547  I/O result code. If @i{a-addr1} is 0, Gf
/* the following check is not necessary on most OSs, but it is needed  /* the following check is not necessary on most OSs, but it is needed
on SunOS 4.1.2. */     on SunOS 4.1.2. */
/* close ' to keep fontify happy */
else  else
Line 1632  if (wior) Line 1639  if (wior)
clearerr((FILE *)wfileid);    clearerr((FILE *)wfileid);

/*  #if 1
Cell c;  Cell c;
flag=-1;  flag=-1;
for(u2=0; u2<u1; u2++)  for(u2=0; u2<u1; u2++)
{  {
*c_addr++ = (Char)(c = getc((FILE *)wfileid));     c = getc((FILE *)wfileid);
if(c=='\n') break;     if (c=='\n') break;
if(c==EOF)     if (c=='\r') {
{       if ((c = getc((FILE *)wfileid))!='\n')
ungetc(c,(FILE *)wfileid);
break;
}
if (c==EOF) {
flag=FLAG(u2!=0);          flag=FLAG(u2!=0);
break;          break;
}       }
}  }
wior=FILEIO(ferror((FILE *)wfileid));  wior=FILEIO(ferror((FILE *)wfileid));
*/  #else
if ((flag=FLAG(!feof((FILE *)wfileid) &&  if ((flag=FLAG(!feof((FILE *)wfileid) &&
wior=FILEIO(ferror((FILE *)wfileid)!=0); /* !! ior? */    wior=FILEIO(ferror((FILE *)wfileid)!=0); /* !! ior? */
Line 1659  else { Line 1671  else {
wior=0;    wior=0;
u2=0;    u2=0;
}  }
#endif

\+  \+
\+file

write-file      c_addr u1 wfileid -- wior       file    write_file  write-file      c_addr u1 wfileid -- wior       file    write_file
/* !! fwrite does not guarantee enough */  /* !! fwrite does not guarantee enough */
#ifdef HAS_FILE
{  {
UCell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid);    UCell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid);
wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));    wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));
if (wior)    if (wior)
clearerr((FILE *)wfileid);      clearerr((FILE *)wfileid);
}  }
#else
#endif

emit-file       c wfileid -- wior       gforth  emit_file  emit-file       c wfileid -- wior       gforth  emit_file
#ifdef HAS_FILE  #ifdef HAS_FILE
Line 1680  wior = FILEIO(putc(c, (FILE *)wfileid)== Line 1694  wior = FILEIO(putc(c, (FILE *)wfileid)==
if (wior)  if (wior)
clearerr((FILE *)wfileid);    clearerr((FILE *)wfileid);
#else  #else
putc(c, stdout);  PUTC(c);
#endif  #endif

\+file  \+file
Line 1790  f**  r1 r2 -- r3 float-ext f_star_star Line 1804  f**  r1 r2 -- r3 float-ext f_star_star
""@i{r3} is @i{r1} raised to the @i{r2}th power.""  ""@i{r3} is @i{r1} raised to the @i{r2}th power.""
r3 = pow(r1,r2);  r3 = pow(r1,r2);

fnegate         r1 -- r2        float  fnegate         r1 -- r2        float   f_negate
r2 = - r1;  r2 = - r1;

fdrop           r --            float  fdrop           r --            float   f_drop

fdup            r -- r r        float  fdup            r -- r r        float   f_dupe

fswap           r1 r2 -- r2 r1  float  fswap           r1 r2 -- r2 r1  float   f_swap

fover           r1 r2 -- r1 r2 r1       float  fover           r1 r2 -- r1 r2 r1       float   f_over

frot            r1 r2 r3 -- r2 r3 r1    float  frot            r1 r2 r3 -- r2 r3 r1    float   f_rote

fnip            r1 r2 -- r2     gforth  fnip            r1 r2 -- r2     gforth  f_nip

ftuck           r1 r2 -- r2 r1 r2       gforth  ftuck           r1 r2 -- r2 r1 r2       gforth  f_tuck

"" Increment @i{f-addr1} by the number of address units corresponding to the size of  "" Increment @i{f-addr1} by the number of address units corresponding to the size of
Line 1821  floor  r1 -- r2 float Line 1835  floor  r1 -- r2 float
/* !! unclear wording */  /* !! unclear wording */
r2 = floor(r1);  r2 = floor(r1);

fround          r1 -- r2        float  fround          r1 -- r2        float   f_round
""Round to the nearest integral value.""  ""Round to the nearest integral value.""
/* !! unclear wording */  /* !! unclear wording */
#ifdef HAVE_RINT  #ifdef HAVE_RINT
Line 1831  r2 = floor(r1+0.5); Line 1845  r2 = floor(r1+0.5);
/* !! This is not quite true to the rounding rules given in the standard */  /* !! This is not quite true to the rounding rules given in the standard */
#endif  #endif

fmax            r1 r2 -- r3     float  fmax            r1 r2 -- r3     float   f_max
if (r1<r2)  if (r1<r2)
r3 = r2;    r3 = r2;
else  else
r3 = r1;    r3 = r1;

fmin            r1 r2 -- r3     float  fmin            r1 r2 -- r3     float   f_min
if (r1<r2)  if (r1<r2)
r3 = r1;    r3 = r1;
else  else
Line 1859  internal floating-point representation. Line 1873  internal floating-point representation.
represents a valid floating-point number @i{r} is placed  represents a valid floating-point number @i{r} is placed
on the floating-point stack and @i{flag} is true. Otherwise,  on the floating-point stack and @i{flag} is true. Otherwise,
@i{flag} is false. A string of blanks is a special case  @i{flag} is false. A string of blanks is a special case
and represents the flotaing-point number 0.""  and represents the floating-point number 0.""
/* real signature: c_addr u -- r t / f */  /* real signature: c_addr u -- r t / f */
Float r;  Float r;
char *endconv;  char *endconv;
int sign = 0;
if(number[0]=='-') {
sign = 1;
number++;
u--;
}
while(isspace((unsigned)(number[--u])) && u>0);  while(isspace((unsigned)(number[--u])) && u>0);
switch(number[u])  switch(number[u])
{  {
Line 1879  if((flag=FLAG(!(Cell)*endconv))) Line 1899  if((flag=FLAG(!(Cell)*endconv)))
{  {
IF_FTOS(fp[0] = FTOS);     IF_FTOS(fp[0] = FTOS);
fp += -1;     fp += -1;
FTOS = r;     FTOS = sign ? -r : r;
}  }
else if(*endconv=='d' || *endconv=='D')  else if(*endconv=='d' || *endconv=='D')
{  {
Line 1889  else if(*endconv=='d' || *endconv=='D') Line 1909  else if(*endconv=='d' || *endconv=='D')
{       {
IF_FTOS(fp[0] = FTOS);          IF_FTOS(fp[0] = FTOS);
fp += -1;          fp += -1;
FTOS = r;          FTOS = sign ? -r : r;
}       }
}  }

fabs            r1 -- r2        float-ext  fabs            r1 -- r2        float-ext       f_abs
r2 = fabs(r1);  r2 = fabs(r1);

facos           r1 -- r2        float-ext  facos           r1 -- r2        float-ext       f_a_cos
r2 = acos(r1);  r2 = acos(r1);

fasin           r1 -- r2        float-ext  fasin           r1 -- r2        float-ext       f_a_sine
r2 = asin(r1);  r2 = asin(r1);

fatan           r1 -- r2        float-ext  fatan           r1 -- r2        float-ext       f_a_tan
r2 = atan(r1);  r2 = atan(r1);

fatan2          r1 r2 -- r3     float-ext  fatan2          r1 r2 -- r3     float-ext       f_a_tan_two
""@i{r1/r2}=tan(@i{r3}). ANS Forth does not require, but probably  ""@i{r1/r2}=tan(@i{r3}). ANS Forth does not require, but probably
intends this to be the inverse of @code{fsincos}. In gforth it is.""  intends this to be the inverse of @code{fsincos}. In gforth it is.""
r3 = atan2(r1,r2);  r3 = atan2(r1,r2);

fcos            r1 -- r2        float-ext  fcos            r1 -- r2        float-ext       f_cos
r2 = cos(r1);  r2 = cos(r1);

fexp            r1 -- r2        float-ext  fexp            r1 -- r2        float-ext       f_e_x_p
r2 = exp(r1);  r2 = exp(r1);

fexpm1          r1 -- r2        float-ext  fexpm1          r1 -- r2        float-ext       f_e_x_p_m_one
""@i{r2}=@i{e}**@i{r1}@minus{}1""  ""@i{r2}=@i{e}**@i{r1}@minus{}1""
#ifdef HAVE_EXPM1  #ifdef HAVE_EXPM1
extern double  extern double
Line 1929  r2 = expm1(r1); Line 1949  r2 = expm1(r1);
r2 = exp(r1)-1.;  r2 = exp(r1)-1.;
#endif  #endif

fln             r1 -- r2        float-ext  fln             r1 -- r2        float-ext       f_l_n
r2 = log(r1);  r2 = log(r1);

flnp1           r1 -- r2        float-ext  flnp1           r1 -- r2        float-ext       f_l_n_p_one
""@i{r2}=ln(@i{r1}+1)""  ""@i{r2}=ln(@i{r1}+1)""
#ifdef HAVE_LOG1P  #ifdef HAVE_LOG1P
extern double  extern double
Line 1945  r2 = log1p(r1); Line 1965  r2 = log1p(r1);
r2 = log(r1+1.);  r2 = log(r1+1.);
#endif  #endif

flog            r1 -- r2        float-ext  flog            r1 -- r2        float-ext       f_log
""The decimal logarithm.""  ""The decimal logarithm.""
r2 = log10(r1);  r2 = log10(r1);

falog           r1 -- r2        float-ext  falog           r1 -- r2        float-ext       f_a_log
""@i{r2}=10**@i{r1}""  ""@i{r2}=10**@i{r1}""
extern double pow10(double);  extern double pow10(double);
r2 = pow10(r1);  r2 = pow10(r1);

fsin            r1 -- r2        float-ext  fsin            r1 -- r2        float-ext       f_sine
r2 = sin(r1);  r2 = sin(r1);

fsincos         r1 -- r2 r3     float-ext  fsincos         r1 -- r2 r3     float-ext       f_sine_cos
""@i{r2}=sin(@i{r1}), @i{r3}=cos(@i{r1})""  ""@i{r2}=sin(@i{r1}), @i{r3}=cos(@i{r1})""
r2 = sin(r1);  r2 = sin(r1);
r3 = cos(r1);  r3 = cos(r1);

fsqrt           r1 -- r2        float-ext  fsqrt           r1 -- r2        float-ext       f_square_root
r2 = sqrt(r1);  r2 = sqrt(r1);

ftan            r1 -- r2        float-ext  ftan            r1 -- r2        float-ext       f_tan
r2 = tan(r1);  r2 = tan(r1);
:  :
fsincos f/ ;   fsincos f/ ;

fsinh           r1 -- r2        float-ext  fsinh           r1 -- r2        float-ext       f_cinch
r2 = sinh(r1);  r2 = sinh(r1);
:  :
fexpm1 fdup fdup 1. d>f f+ f/ f+ f2/ ;   fexpm1 fdup fdup 1. d>f f+ f/ f+ f2/ ;

fcosh           r1 -- r2        float-ext  fcosh           r1 -- r2        float-ext       f_cosh
r2 = cosh(r1);  r2 = cosh(r1);
:  :
fexp fdup 1/f f+ f2/ ;   fexp fdup 1/f f+ f2/ ;

ftanh           r1 -- r2        float-ext  ftanh           r1 -- r2        float-ext       f_tan_h
r2 = tanh(r1);  r2 = tanh(r1);
:  :
f2* fexpm1 fdup 2. d>f f+ f/ ;   f2* fexpm1 fdup 2. d>f f+ f/ ;

fasinh          r1 -- r2        float-ext  fasinh          r1 -- r2        float-ext       f_a_cinch
r2 = asinh(r1);  r2 = asinh(r1);
:  :
fdup fdup f* 1. d>f f+ fsqrt f/ fatanh ;   fdup fdup f* 1. d>f f+ fsqrt f/ fatanh ;

facosh          r1 -- r2        float-ext  facosh          r1 -- r2        float-ext       f_a_cosh
r2 = acosh(r1);  r2 = acosh(r1);
:  :
fdup fdup f* 1. d>f f- fsqrt f+ fln ;   fdup fdup f* 1. d>f f- fsqrt f+ fln ;

fatanh          r1 -- r2        float-ext  fatanh          r1 -- r2        float-ext       f_a_tan_h
r2 = atanh(r1);  r2 = atanh(r1);
:  :
fdup f0< >r fabs 1. d>f fover f- f/  f2* flnp1 f2/   fdup f0< >r fabs 1. d>f fover f- f/  f2* flnp1 f2/
Line 2137  rret = (SYSCALL(Float(*)(argdlist(\$1)))u Line 2157  rret = (SYSCALL(Float(*)(argdlist(\$1)))u

')  ')

\ close ' to keep fontify happy

open-lib        c_addr1 u1 -- u2        gforth  open_lib  open-lib        c_addr1 u1 -- u2        gforth  open_lib
#if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)  #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
:  :
up ! ;   up ! ;
Variable UP  Variable UP

wcall   u --    gforth
IF_FTOS(fp[0]=FTOS);
FP=fp;
sp=(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP);
fp=FP;
IF_TOS(TOS=sp[0];)
IF_FTOS(FTOS=fp[0]);

\+file

open-dir        c_addr u -- wdirid wior gforth  open_dir
wior =  IOR(wdirid == 0);

struct dirent * dent;
wior = 0;
flag = -1;
if(dent == NULL) {
u2 = 0;
flag = 0;
} else {
u2 = strlen(dent->d_name);
if(u2 > u1)
u2 = u1;
}

close-dir       wdirid -- wior  gforth  close_dir
wior = IOR(closedir((DIR *)wdirid));

char * string = cstr(c_addr1, u1, 1);
char * pattern = cstr(c_addr2, u2, 0);
flag = FLAG(!fnmatch(pattern, string, 0));

\+

""String containing the newline sequence of the host OS""
char newline[] = {
#ifdef unix
'\n'
#else
'\r','\n'
#endif
};