version 1.266, 2012/03/10 20:33:31
|
version 1.271, 2012/04/12 16:11:40
|
Line 1747 is the host operating system's expansion
|
Line 1747 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 1849 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 1864 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 1955 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 1993 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 2018 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 2307 CLOBBER_TOS_WORKAROUND_END;
|
Line 2325 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 2336 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 2359 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 2528 open-lib ( c_addr1 u1 -- u2 ) gforth ope
|
Line 2547 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; |