version 1.47, 2000/07/14 08:55:15
|
version 1.51, 2000/08/08 12:37:05
|
Line 36
|
Line 36
|
\ be separated by at least one empty line |
\ be separated by at least one empty line |
\ |
\ |
\ Both pronounciation and stack items (in the stack effect) must |
\ Both pronounciation and stack items (in the stack effect) must |
\ conform to the C name syntax or the C compiler will complain. |
\ conform to the C identifier syntax or the C compiler will complain. |
\ |
\ If you don't have a pronounciation field, the Forth name is used, |
|
\ and has to conform to the C identifier syntax. |
\ |
\ |
\ These specifications are automatically translated into C-code for the |
\ These specifications are automatically translated into C-code for the |
\ interpreter and into some other files. I hope that your C compiler has |
\ interpreter and into some other files. I hope that your C compiler has |
Line 510 else if (n>0)
|
Line 511 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 sgn ; |
: sgn ( n -- -1/0/1 ) |
: sgn ( n -- -1/0/1 ) |
dup 0= IF EXIT THEN 0< 2* 1+ ; |
dup 0= IF EXIT THEN 0< 2* 1+ ; |
|
|
Line 532 else if (n>0)
|
Line 533 else if (n>0)
|
?DO dup c@ I c@ <> |
?DO dup c@ I c@ <> |
IF dup c@ toupper I c@ toupper = |
IF dup c@ toupper I c@ toupper = |
ELSE true THEN WHILE 1+ LOOP drop 0 |
ELSE true THEN WHILE 1+ LOOP drop 0 |
ELSE c@ toupper I c@ toupper - unloop THEN -text-flag ; |
ELSE c@ toupper I c@ toupper - unloop THEN sgn ; |
|
|
-trailing ( c_addr u1 -- c_addr u2 ) string dash_trailing |
-trailing ( c_addr u1 -- c_addr u2 ) string dash_trailing |
""Adjust the string specified by @i{c-addr, u1} to remove all trailing |
""Adjust the string specified by @i{c-addr, u1} to remove all trailing |
Line 1503 struct timeval time1;
|
Line 1504 struct timeval time1;
|
struct timezone zone1; |
struct timezone zone1; |
struct tm *ltime; |
struct tm *ltime; |
gettimeofday(&time1,&zone1); |
gettimeofday(&time1,&zone1); |
|
/* !! Single Unix specification: |
|
If tzp is not a null pointer, the behaviour is unspecified. */ |
ltime=localtime((time_t *)&time1.tv_sec); |
ltime=localtime((time_t *)&time1.tv_sec); |
nyear =ltime->tm_year+1900; |
nyear =ltime->tm_year+1900; |
nmonth=ltime->tm_mon+1; |
nmonth=ltime->tm_mon+1; |
Line 1584 wior = IOR(fclose((FILE *)wfileid)==EOF)
|
Line 1587 wior = IOR(fclose((FILE *)wfileid)==EOF)
|
|
|
open-file ( c_addr u ntype -- wfileid wior ) file open_file |
open-file ( c_addr u ntype -- wfileid wior ) file open_file |
wfileid = (Cell)fopen(tilde_cstr(c_addr, u, 1), fileattr[ntype]); |
wfileid = (Cell)fopen(tilde_cstr(c_addr, u, 1), fileattr[ntype]); |
#if defined(GO32) && defined(MSDOS) |
|
if(wfileid && !(ntype & 1)) |
|
setbuf((FILE*)wfileid, NULL); |
|
#endif |
|
wior = IOR(wfileid == 0); |
wior = IOR(wfileid == 0); |
|
|
create-file ( c_addr u ntype -- wfileid wior ) file create_file |
create-file ( c_addr u ntype -- wfileid wior ) file create_file |
Line 1595 Cell fd;
|
Line 1594 Cell fd;
|
fd = open(tilde_cstr(c_addr, u, 1), O_CREAT|O_TRUNC|ufileattr[ntype], 0666); |
fd = open(tilde_cstr(c_addr, u, 1), O_CREAT|O_TRUNC|ufileattr[ntype], 0666); |
if (fd != -1) { |
if (fd != -1) { |
wfileid = (Cell)fdopen(fd, fileattr[ntype]); |
wfileid = (Cell)fdopen(fd, fileattr[ntype]); |
#if defined(GO32) && defined(MSDOS) |
|
if(wfileid && !(ntype & 1)) |
|
setbuf((FILE*)wfileid, NULL); |
|
#endif |
|
wior = IOR(wfileid == 0); |
wior = IOR(wfileid == 0); |
} else { |
} else { |
wfileid = 0; |
wfileid = 0; |
Line 2248 char newline[] = {
|
Line 2243 char newline[] = {
|
}; |
}; |
c_addr=newline; |
c_addr=newline; |
u=sizeof(newline); |
u=sizeof(newline); |
|
: |
|
"newline count ; |
|
Create "newline 1 c, $0A c, |
|
|
|
utime ( -- dtime ) gforth |
|
""Report the current time in microseconds since some epoch."" |
|
struct timeval time1; |
|
gettimeofday(&time1,NULL); |
|
dtime = timeval2us(&time1); |
|
|
|
cputime ( -- duser dsystem ) gforth |
|
""duser and dsystem are the respective user- and system-level CPU |
|
times used since the start of the Forth system (excluding child |
|
processes), in microseconds (the granularity may be much larger, |
|
however). On platforms without the getrusage call, it reports elapsed |
|
time (since some epoch) for duser and 0 for dsystem."" |
|
#ifdef HAVE_GETRUSAGE |
|
struct rusage usage; |
|
getrusage(RUSAGE_SELF, &usage); |
|
duser = timeval2us(&usage.ru_utime); |
|
dsystem = timeval2us(&usage.ru_stime); |
|
#else |
|
struct timeval time1; |
|
gettimeofday(&time1,NULL); |
|
duser = timeval2us(&time1); |
|
dsystem = (DCell)0; |
|
#endif |
|
|
|
v* ( f_addr1 nstride1 f_addr2 nstride2 ucount -- r ) gforth v_star |
|
""dot-product: r=v1*v2. The first element of v1 is at f_addr1, the |
|
next at f_addr1+nstride1 and so on (similar for v2). Both vectors have |
|
ucount elements."" |
|
for (r=0.; ucount>0; ucount--) { |
|
r += *f_addr1 * *f_addr2; |
|
f_addr1 = (Float *)(((Address)f_addr1)+nstride1); |
|
f_addr2 = (Float *)(((Address)f_addr2)+nstride2); |
|
} |
|
|
|
faxpy ( ra f_x nstridex f_y nstridey ucount -- ) gforth |
|
""vy=ra*vx+vy"" |
|
for (; ucount>0; ucount--) { |
|
*f_y += ra * *f_x; |
|
f_x = (Float *)(((Address)f_x)+nstridex); |
|
f_y = (Float *)(((Address)f_y)+nstridey); |
|
} |