version 1.56, 2000/08/17 12:46:57
|
version 1.63, 2000/09/23 15:46:58
|
Line 1
|
Line 1
|
\ Gforth primitives |
\ Gforth primitives |
|
|
\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 16
|
Line 16
|
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program; if not, write to the Free Software |
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
|
\ WARNING: This file is processed by m4. Make sure your identifiers |
\ WARNING: This file is processed by m4. Make sure your identifiers |
Line 1379 c_addr = (Address)CODE_ADDRESS(xt);
|
Line 1379 c_addr = (Address)CODE_ADDRESS(xt);
|
@ ; |
@ ; |
|
|
>does-code ( xt -- a_addr ) gforth to_does_code |
>does-code ( xt -- a_addr ) gforth to_does_code |
""If @i{xt} is the execution token of a defining-word-defined word, |
""If @i{xt} is the execution token of a child of a @code{DOES>} word, |
@i{a-addr} is the start of the Forth code after the @code{DOES>}; |
@i{a-addr} is the start of the Forth code after the @code{DOES>}; |
Otherwise @i{a-addr} is 0."" |
Otherwise @i{a-addr} is 0."" |
a_addr = (Cell *)DOES_CODE(xt); |
a_addr = (Cell *)DOES_CODE(xt); |
Line 1394 CACHE_FLUSH(xt,(size_t)PFA(0));
|
Line 1394 CACHE_FLUSH(xt,(size_t)PFA(0));
|
! ; |
! ; |
|
|
does-code! ( a_addr xt -- ) gforth does_code_store |
does-code! ( a_addr xt -- ) gforth does_code_store |
""Create a code field at @i{xt} for a defining-word-defined word; @i{a-addr} |
""Create a code field at @i{xt} for a child of a @code{DOES>}-word; |
is the start of the Forth code after @code{DOES>}."" |
@i{a-addr} is the start of the Forth code after @code{DOES>}."" |
MAKE_DOES_CF(xt, a_addr); |
MAKE_DOES_CF(xt, a_addr); |
CACHE_FLUSH(xt,(size_t)PFA(0)); |
CACHE_FLUSH(xt,(size_t)PFA(0)); |
: |
: |
dodoes: over ! cell+ ! ; |
dodoes: over ! cell+ ! ; |
|
|
does-handler! ( a_addr -- ) gforth does_handler_store |
does-handler! ( a_addr -- ) gforth does_handler_store |
""Create a @code{DOES>}-handler at address @i{a-addr}. Usually, @i{a-addr} points |
""Create a @code{DOES>}-handler at address @i{a-addr}. Normally, |
just behind a @code{DOES>}."" |
@i{a-addr} points just behind a @code{DOES>}."" |
MAKE_DOES_HANDLER(a_addr); |
MAKE_DOES_HANDLER(a_addr); |
CACHE_FLUSH((caddr_t)a_addr,DOES_HANDLER_SIZE); |
CACHE_FLUSH((caddr_t)a_addr,DOES_HANDLER_SIZE); |
: |
: |
Line 1647 if (wior)
|
Line 1647 if (wior)
|
clearerr((FILE *)wfileid); |
clearerr((FILE *)wfileid); |
|
|
read-line ( c_addr u1 wfileid -- u2 flag wior ) file read_line |
read-line ( c_addr u1 wfileid -- u2 flag wior ) file read_line |
#if 1 |
""this is only for backward compatibility"" |
Cell c; |
Cell c; |
flag=-1; |
flag=-1; |
for(u2=0; u2<u1; u2++) |
for(u2=0; u2<u1; u2++) |
Line 1666 for(u2=0; u2<u1; u2++)
|
Line 1666 for(u2=0; u2<u1; u2++)
|
c_addr[u2] = (Char)c; |
c_addr[u2] = (Char)c; |
} |
} |
wior=FILEIO(ferror((FILE *)wfileid)); |
wior=FILEIO(ferror((FILE *)wfileid)); |
#else |
|
if ((flag=FLAG(!feof((FILE *)wfileid) && |
|
fgets(c_addr,u1+1,(FILE *)wfileid) != NULL))) { |
|
wior=FILEIO(ferror((FILE *)wfileid)!=0); /* !! ior? */ |
|
if (wior) |
|
clearerr((FILE *)wfileid); |
|
u2 = strlen(c_addr); |
|
u2-=((u2>0) && (c_addr[u2-1]==NEWLINE)); |
|
} |
|
else { |
|
wior=0; |
|
u2=0; |
|
} |
|
#endif |
|
|
|
\+ |
\+ |
|
|
Line 2286 dsystem = timeval2us(&usage.ru_stime);
|
Line 2272 dsystem = timeval2us(&usage.ru_stime);
|
struct timeval time1; |
struct timeval time1; |
gettimeofday(&time1,NULL); |
gettimeofday(&time1,NULL); |
duser = timeval2us(&time1); |
duser = timeval2us(&time1); |
|
#ifndef BUGGY_LONG_LONG |
dsystem = (DCell)0; |
dsystem = (DCell)0; |
|
#else |
|
dsystem=(DCell){0,0}; |
|
#endif |
#endif |
#endif |
|
|
\+ |
\+ |
Line 2320 for (; ucount>0; ucount--) {
|
Line 2310 for (; ucount>0; ucount--) {
|
LOOP 2drop 2drop fdrop ; |
LOOP 2drop 2drop fdrop ; |
|
|
\+ |
\+ |
|
|
|
\+file |
|
|
|
(read-line) ( c_addr u1 wfileid -- u2 flag u3 wior ) file paren_read_line |
|
Cell c; |
|
flag=-1; |
|
u3=0; |
|
for(u2=0; u2<u1; u2++) |
|
{ |
|
c = getc((FILE *)wfileid); |
|
u3++; |
|
if (c=='\n') break; |
|
if (c=='\r') { |
|
if ((c = getc((FILE *)wfileid))!='\n') |
|
ungetc(c,(FILE *)wfileid); |
|
else |
|
u3++; |
|
break; |
|
} |
|
if (c==EOF) { |
|
flag=FLAG(u2!=0); |
|
break; |
|
} |
|
c_addr[u2] = (Char)c; |
|
} |
|
wior=FILEIO(ferror((FILE *)wfileid)); |
|
|
|
\+ |