version 1.266, 2012/03/10 20:33:31
|
version 1.274, 2012/07/23 13:27:47
|
Line 1734 cache.""
|
Line 1734 cache.""
|
FLUSH_ICACHE((caddr_t)c_addr,u); |
FLUSH_ICACHE((caddr_t)c_addr,u); |
|
|
(bye) ( n -- ) gforth paren_bye |
(bye) ( n -- ) gforth paren_bye |
|
gforth_FP=fp; |
|
gforth_SP=sp; |
|
gforth_RP=rp; |
|
gforth_LP=lp; |
SUPER_END; |
SUPER_END; |
return (Label *)n; |
return (Label *)n; |
|
|
Line 1747 is the host operating system's expansion
|
Line 1751 is the host operating system's expansion
|
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 */ |
/* close ' to keep fontify happy */ |
c_addr2 = (Char *)getenv(cstr(c_addr1,u1,1)); |
char * string = cstr(c_addr1,u1); |
|
c_addr2 = (Char *)getenv(string); |
u2 = (c_addr2 == NULL ? 0 : strlen((char *)c_addr2)); |
u2 = (c_addr2 == NULL ? 0 : strlen((char *)c_addr2)); |
|
free(string); |
|
|
open-pipe ( c_addr u wfam -- wfileid wior ) gforth open_pipe |
open-pipe ( c_addr u wfam -- wfileid wior ) gforth open_pipe |
|
char * string = cstr(c_addr,u); |
fflush(stdout); |
fflush(stdout); |
wfileid=(Cell)popen(cstr(c_addr,u,1),pfileattr[wfam]); /* ~ expansion of 1st arg? */ |
wfileid=(Cell)popen(string,pfileattr[wfam]); /* ~ expansion of 1st arg? */ |
wior = IOR(wfileid==0); /* !! the man page says that errno is not set reliably */ |
wior = IOR(wfileid==0); /* !! the man page says that errno is not set reliably */ |
|
free(string); |
|
|
close-pipe ( wfileid -- wretval wior ) gforth close_pipe |
close-pipe ( wfileid -- wretval wior ) gforth close_pipe |
wretval = pclose((FILE *)wfileid); |
wretval = pclose((FILE *)wfileid); |
Line 1845 gforth_LP=lp;
|
Line 1853 gforth_LP=lp;
|
#ifdef HAS_LINKBACK |
#ifdef HAS_LINKBACK |
((void (*)())w)(); |
((void (*)())w)(); |
#else |
#else |
((void (*)(void *))w)(gforth_pointers); |
((void (*)(void *))w)(&gforth_pointers); |
#endif |
#endif |
sp=gforth_SP; |
sp=gforth_SP; |
fp=gforth_FP; |
fp=gforth_FP; |
Line 1860 close-file ( wfileid -- wior ) file clo
|
Line 1868 close-file ( wfileid -- wior ) file clo
|
wior = IOR(fclose((FILE *)wfileid)==EOF); |
wior = IOR(fclose((FILE *)wfileid)==EOF); |
|
|
open-file ( c_addr u wfam -- wfileid wior ) file open_file |
open-file ( c_addr u wfam -- wfileid wior ) file open_file |
wfileid = opencreate_file(tilde_cstr(c_addr,u,1), wfam, 0, &wior); |
char * string = tilde_cstr(c_addr,u); |
|
wfileid = opencreate_file(string, wfam, 0, &wior); |
|
free(string); |
|
|
create-file ( c_addr u wfam -- wfileid wior ) file create_file |
create-file ( c_addr u wfam -- wfileid wior ) file create_file |
wfileid = opencreate_file(tilde_cstr(c_addr,u,1), wfam, O_CREAT|O_TRUNC, &wior); |
char * string = tilde_cstr(c_addr,u); |
|
wfileid = opencreate_file(string, wfam, O_CREAT|O_TRUNC, &wior); |
|
free(string); |
|
|
delete-file ( c_addr u -- wior ) file delete_file |
delete-file ( c_addr u -- wior ) file delete_file |
wior = IOR(unlink(tilde_cstr(c_addr, u, 1))==-1); |
char * string = tilde_cstr(c_addr,u); |
|
wior = IOR(unlink(string)==-1); |
|
free(string); |
|
|
rename-file ( c_addr1 u1 c_addr2 u2 -- wior ) file-ext rename_file |
rename-file ( c_addr1 u1 c_addr2 u2 -- wior ) file-ext rename_file |
""Rename file @i{c_addr1 u1} to new name @i{c_addr2 u2}"" |
""Rename file @i{c_addr1 u1} to new name @i{c_addr2 u2}"" |
Line 1945 flag = FLAG(feof((FILE *) wfileid));
|
Line 1959 flag = FLAG(feof((FILE *) wfileid));
|
open-dir ( c_addr u -- wdirid wior ) gforth open_dir |
open-dir ( c_addr u -- wdirid wior ) gforth open_dir |
""Open the directory specified by @i{c-addr, u} |
""Open the directory specified by @i{c-addr, u} |
and return @i{dir-id} for futher access to it."" |
and return @i{dir-id} for futher access to it."" |
wdirid = (Cell)opendir(tilde_cstr(c_addr, u, 1)); |
char * string = tilde_cstr(c_addr,u); |
|
wdirid = (Cell)opendir(string); |
wior = IOR(wdirid == 0); |
wior = IOR(wdirid == 0); |
|
free(string); |
|
|
read-dir ( c_addr u1 wdirid -- u2 flag wior ) gforth read_dir |
read-dir ( c_addr u1 wdirid -- u2 flag wior ) gforth read_dir |
""Attempt to read the next entry from the directory specified |
""Attempt to read the next entry from the directory specified |
Line 1981 close-dir ( wdirid -- wior ) gforth clos
|
Line 1997 close-dir ( wdirid -- wior ) gforth clos
|
wior = IOR(closedir((DIR *)wdirid)); |
wior = IOR(closedir((DIR *)wdirid)); |
|
|
filename-match ( c_addr1 u1 c_addr2 u2 -- flag ) gforth match_file |
filename-match ( c_addr1 u1 c_addr2 u2 -- flag ) gforth match_file |
char * string = cstr(c_addr1, u1, 1); |
char * string = cstr(c_addr1, u1); |
char * pattern = cstr(c_addr2, u2, 0); |
char * pattern = cstr(c_addr2, u2); |
flag = FLAG(!fnmatch(pattern, string, 0)); |
flag = FLAG(!fnmatch(pattern, string, 0)); |
|
free(string); |
|
free(pattern); |
|
|
set-dir ( c_addr u -- wior ) gforth set_dir |
set-dir ( c_addr u -- wior ) gforth set_dir |
""Change the current directory to @i{c-addr, u}. |
""Change the current directory to @i{c-addr, u}. |
Return an error if this is not possible"" |
Return an error if this is not possible"" |
wior = IOR(chdir(tilde_cstr(c_addr, u, 1))); |
char * string = tilde_cstr(c_addr, u); |
|
wior = IOR(chdir(string)); |
|
free(string); |
|
|
get-dir ( c_addr1 u1 -- c_addr2 u2 ) gforth get_dir |
get-dir ( c_addr1 u1 -- c_addr2 u2 ) gforth get_dir |
""Store the current directory in the buffer specified by @i{c-addr1, u1}. |
""Store the current directory in the buffer specified by @i{c-addr1, u1}. |
Line 2002 if(c_addr2 != NULL) {
|
Line 2022 if(c_addr2 != NULL) {
|
|
|
=mkdir ( c_addr u wmode -- wior ) gforth equals_mkdir |
=mkdir ( c_addr u wmode -- wior ) gforth equals_mkdir |
""Create directory @i{c-addr u} with mode @i{wmode}."" |
""Create directory @i{c-addr u} with mode @i{wmode}."" |
wior = IOR(mkdir(tilde_cstr(c_addr,u,1),wmode)); |
char * string = tilde_cstr(c_addr,u); |
|
wior = IOR(mkdir(string,wmode)); |
|
free(string); |
|
|
\+ |
\+ |
|
|
newline ( -- c_addr u ) gforth |
newline ( -- c_addr u ) gforth |
""String containing the newline sequence of the host OS"" |
""String containing the newline sequence of the host OS"" |
char newline[] = { |
static const char newline[] = { |
#if DIRSEP=='/' |
#if DIRSEP=='/' |
/* Unix */ |
/* Unix */ |
'\n' |
'\n' |
Line 2244 representation. If the string represents
|
Line 2266 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; |
flag = to_float(c_addr, u, &r); |
flag = to_float(c_addr, u, &r, '.'); |
if (flag) { |
if (flag) { |
fp--; |
fp--; |
fp[0]=r; |
fp[0]=r; |
Line 2307 CLOBBER_TOS_WORKAROUND_END;
|
Line 2329 CLOBBER_TOS_WORKAROUND_END;
|
|
|
flnp1 ( r1 -- r2 ) float-ext f_l_n_p_one |
flnp1 ( r1 -- r2 ) float-ext f_l_n_p_one |
""@i{r2}=ln(@i{r1}+1)"" |
""@i{r2}=ln(@i{r1}+1)"" |
|
CLOBBER_TOS_WORKAROUND_START; |
#ifdef HAVE_LOG1P |
#ifdef HAVE_LOG1P |
extern double |
extern double |
#ifdef NeXT |
#ifdef NeXT |
Line 2317 r2 = log1p(r1);
|
Line 2340 r2 = log1p(r1);
|
#else |
#else |
r2 = log(r1+1.); |
r2 = log(r1+1.); |
#endif |
#endif |
|
CLOBBER_TOS_WORKAROUND_END; |
|
|
flog ( r1 -- r2 ) float-ext f_log |
flog ( r1 -- r2 ) float-ext f_log |
""The decimal logarithm."" |
""The decimal logarithm."" |
Line 2339 CLOBBER_TOS_WORKAROUND_END;
|
Line 2363 CLOBBER_TOS_WORKAROUND_END;
|
fsincos ( r1 -- r2 r3 ) float-ext f_sine_cos |
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})"" |
CLOBBER_TOS_WORKAROUND_START; |
CLOBBER_TOS_WORKAROUND_START; |
r2 = sin(r1); |
sincos(r1, &r2, &r3); |
r3 = cos(r1); |
|
CLOBBER_TOS_WORKAROUND_END; |
CLOBBER_TOS_WORKAROUND_END; |
|
|
fsqrt ( r1 -- r2 ) float-ext f_square_root |
fsqrt ( r1 -- r2 ) float-ext f_square_root |
Line 2438 faxpy(ra, f_x, nstridex, f_y, nstridey,
|
Line 2461 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; |
|
} |
|
|
\+ |
\+ |
|
|
\ The following words access machine/OS/installation-dependent |
\ The following words access machine/OS/installation-dependent |
Line 2528 open-lib ( c_addr1 u1 -- u2 ) gforth ope
|
Line 2565 open-lib ( c_addr1 u1 -- u2 ) gforth ope
|
u2 = gforth_dlopen(c_addr1, u1); |
u2 = gforth_dlopen(c_addr1, u1); |
|
|
lib-sym ( c_addr1 u1 u2 -- u3 ) gforth lib_sym |
lib-sym ( c_addr1 u1 u2 -- u3 ) gforth lib_sym |
|
char * string = cstr(c_addr1, u1); |
#ifdef HAVE_LIBLTDL |
#ifdef HAVE_LIBLTDL |
u3 = (UCell) lt_dlsym((lt_dlhandle)u2, cstr(c_addr1, u1, 1)); |
u3 = (UCell) lt_dlsym((lt_dlhandle)u2, string); |
#elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) |
#elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) |
u3 = (UCell) dlsym((void*)u2,cstr(c_addr1, u1, 1)); |
u3 = (UCell) dlsym((void*)u2,string); |
#else |
#else |
# ifdef _WIN32 |
# ifdef _WIN32 |
u3 = (Cell) GetProcAddress((HMODULE)u2, cstr(c_addr1, u1, 1)); |
u3 = (Cell) GetProcAddress((HMODULE)u2, string); |
# else |
# else |
#warning Define lib-sym! |
#warning Define lib-sym! |
u3 = 0; |
u3 = 0; |
# endif |
# endif |
#endif |
#endif |
|
free(string); |
|
|
wcall ( ... u -- ... ) gforth |
wcall ( ... u -- ... ) gforth |
gforth_FP=fp; |
gforth_FP=fp; |
Line 2758 ip=IP;
|
Line 2797 ip=IP;
|
SUPER_END; |
SUPER_END; |
VM_JUMP(EXEC1((Xt)a_addr)); |
VM_JUMP(EXEC1((Xt)a_addr)); |
|
|
|
\+objects |
|
\g object_pointer |
|
|
|
>o ( c_addr -- r:c_old ) new to_o |
|
c_old = op; |
|
op = c_addr; |
|
|
|
o> ( r:c_addr -- ) new o_restore |
|
op = c_addr; |
|
|
|
o#+ ( #w -- c_addr ) new o_lit_plus |
|
c_addr = op + w; |
|
|
|
\+ |
\g static_super |
\g static_super |
|
|
ifdef(`STACK_CACHE_FILE', |
ifdef(`STACK_CACHE_FILE', |