--- gforth/prim 2008/05/05 13:37:20 1.227 +++ gforth/prim 2008/10/06 21:21:20 1.236 @@ -1,6 +1,6 @@ \ Gforth primitives -\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -1674,7 +1674,7 @@ supported on your machine (take a look a your machine has a separate instruction cache. In such cases, @code{flush-icache} does nothing instead of flushing the instruction cache."" -FLUSH_ICACHE(c_addr,u); +FLUSH_ICACHE((caddr_t)c_addr,u); (bye) ( n -- ) gforth paren_bye SUPER_END; @@ -1777,11 +1777,21 @@ access the stack itself. The stack point variables @code{gforth_SP} and @code{gforth_FP}."" /* This is a first attempt at support for calls to C. This may change in the future */ +IF_fpTOS(fp[0]=fpTOS); gforth_FP=fp; gforth_SP=sp; +gforth_RP=rp; +gforth_LP=lp; +#ifdef HAS_LINKBACK ((void (*)())w)(); +#else +((void (*)(void *))w)(gforth_pointers); +#endif sp=gforth_SP; fp=gforth_FP; +rp=gforth_RP; +lp=gforth_LP; +IF_fpTOS(fpTOS=fp[0]); \+ \+file @@ -1919,7 +1929,7 @@ Return an error if this is not possible" wior = IOR(chdir(tilde_cstr(c_addr, u, 1))); get-dir ( c_addr1 u1 -- c_addr2 u2 ) gforth get_dir -""Store the current directory in the buffer specified by @{c-addr1, u1}. +""Store the current directory in the buffer specified by @i{c-addr1, u1}. If the buffer size is not sufficient, return 0 0"" c_addr2 = (Char *)getcwd((char *)c_addr1, u1); if(c_addr2 != NULL) { @@ -1928,6 +1938,10 @@ if(c_addr2 != NULL) { u2 = 0; } +=mkdir ( c_addr u wmode -- wior ) gforth equals_mkdir +""Create directory @i{c-addr u} with mode @i{wmode}."" +wior = IOR(mkdir(tilde_cstr(c_addr,u,1),wmode)); + \+ newline ( -- c_addr u ) gforth @@ -2393,16 +2407,16 @@ r = fp[u]; \g syslib open-lib ( c_addr1 u1 -- u2 ) gforth open_lib -#if 1 -u2 = (UCell)lt_dlopen(cstr(c_addr1, u1, 1)); +#ifdef HAVE_LIBLTDL +u2 = (UCell)lt_dlopen(tilde_cstr(c_addr1, u1, 1)); #elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) #ifndef RTLD_GLOBAL #define RTLD_GLOBAL 0 #endif -u2=(UCell) dlopen(cstr(c_addr1, u1, 1), RTLD_GLOBAL | RTLD_LAZY); +u2=(UCell) dlopen(tilde_cstr(c_addr1, u1, 1), RTLD_GLOBAL | RTLD_LAZY); #else # ifdef _WIN32 -u2 = (Cell) GetModuleHandle(cstr(c_addr1, u1, 1)); +u2 = (Cell) GetModuleHandle(tilde_cstr(c_addr1, u1, 1)); # else #warning Define open-lib! u2 = 0; @@ -2410,7 +2424,7 @@ u2 = 0; #endif lib-sym ( c_addr1 u1 u2 -- u3 ) gforth lib_sym -#if 1 +#ifdef HAVE_LIBLTDL u3 = (UCell) lt_dlsym((lt_dlhandle)u2, cstr(c_addr1, u1, 1)); #elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) u3 = (UCell) dlsym((void*)u2,cstr(c_addr1, u1, 1)); @@ -2453,8 +2467,14 @@ l! ( w c_addr -- ) gforth l_store *(Tetrabyte*)(c_addr) = w; lib-error ( -- c_addr u ) gforth lib_error -c_addr = lt_dlerror(); -u = (c_addr == NULL) ? 0 : strlen(c_addr); +""Error message for last failed @code{open-lib} or @code{lib-sym}."" +#ifdef HAVE_LIBLTDL +c_addr = (Char *)lt_dlerror(); +u = (c_addr == NULL) ? 0 : strlen((char *)c_addr); +#else +c_addr = "libltdl is not configured"; +u = strlen(c_addr); +#endif \+ \g peephole