version 1.35, 1995/02/22 18:40:17
|
version 1.36, 1995/04/06 16:56:13
|
Line 786 static char* mode[2]={"r","w"};
|
Line 786 static char* mode[2]={"r","w"};
|
wfileid=(Cell)popen(cstr(c_addr,u,1),mode[n]); |
wfileid=(Cell)popen(cstr(c_addr,u,1),mode[n]); |
|
|
pclose wfileid -- wior own |
pclose wfileid -- wior own |
wior=pclose((FILE *)wfileid); |
wior=pclose((FILE *)wfileid); /* !! what to do with the result */ |
|
|
time&date -- nsec nmin nhour nday nmonth nyear facility-ext time_and_date |
time&date -- nsec nmin nhour nday nmonth nyear facility-ext time_and_date |
struct timeval time1; |
struct timeval time1; |
Line 809 timeout.tv_usec=1000*(n%1000);
|
Line 809 timeout.tv_usec=1000*(n%1000);
|
|
|
allocate u -- a_addr wior memory |
allocate u -- a_addr wior memory |
a_addr = (Cell *)malloc(u); |
a_addr = (Cell *)malloc(u); |
wior = a_addr==NULL; /* !! Define a return code */ |
wior = IOR(a_addr==NULL); |
|
|
free a_addr -- wior memory |
free a_addr -- wior memory |
free(a_addr); |
free(a_addr); |
wior = 0; |
wior = 0; |
|
|
resize a_addr1 u -- a_addr2 wior memory |
resize a_addr1 u -- a_addr2 wior memory |
a_addr2 = realloc(a_addr1, u); |
""Change the size of the allocated area at @i{a_addr1} to @i{u} |
wior = a_addr2==NULL; /* !! Define a return code */ |
address units, possibly moving the contents to a different |
|
area. @i{a_addr2} is the address of the resulting area. If |
|
@code{a_addr2} is 0, gforth's (but not the standard) @code{resize} |
|
@code{allocate}s @i{u} address units."" |
|
/* the following check is not necessary on most OSs, but it is needed |
|
on SunOS 4.1.2. */ |
|
if (a_addr1==NULL) |
|
a_addr2 = (Cell *)malloc(u); |
|
else |
|
a_addr2 = (Cell *)realloc(a_addr1, u); |
|
wior = IOR(a_addr2==NULL); /* !! Define a return code */ |
|
|
(f83find) c_addr u f83name1 -- f83name2 new paren_f83find |
(f83find) c_addr u f83name1 -- f83name2 new paren_f83find |
for (; f83name1 != NULL; f83name1 = f83name1->next) |
for (; f83name1 != NULL; f83name1 = f83name1->next) |
Line 909 else {
|
Line 919 else {
|
BEGIN dup WHILE over c@ bl > WHILE 1 /string |
BEGIN dup WHILE over c@ bl > WHILE 1 /string |
REPEAT THEN nip - ; |
REPEAT THEN nip - ; |
|
|
close-file wfileid -- wior file close_file |
close-file wfileid -- wior file close_file |
wior = FILEIO(fclose((FILE *)wfileid)==EOF); |
wior = IOR(fclose((FILE *)wfileid)==EOF); |
|
|
open-file c_addr u ntype -- w2 wior file open_file |
open-file c_addr u ntype -- w2 wior file open_file |
w2 = (Cell)fopen(cstr(c_addr, u, 1), fileattr[ntype]); |
w2 = (Cell)fopen(cstr(c_addr, u, 1), fileattr[ntype]); |
wior = FILEEXIST(w2 == NULL); |
wior = IOR(w2 == NULL); |
|
|
create-file c_addr u ntype -- w2 wior file create_file |
create-file c_addr u ntype -- w2 wior file create_file |
Cell fd; |
Cell fd; |
fd = open(cstr(c_addr, u, 1), O_CREAT|O_RDWR|O_TRUNC, 0666); |
fd = open(cstr(c_addr, u, 1), O_CREAT|O_RDWR|O_TRUNC, 0666); |
if (fd > -1) { |
if (fd != -1) { |
w2 = (Cell)fdopen(fd, fileattr[ntype]); |
w2 = (Cell)fdopen(fd, fileattr[ntype]); |
assert(w2 != NULL); |
wior = IOR(w2==NULL); |
wior = 0; |
|
} else { |
} else { |
assert(fd == -1); |
|
wior = FILEIO(fd); |
|
w2 = 0; |
w2 = 0; |
|
wior = IOR(1); |
} |
} |
|
|
delete-file c_addr u -- wior file delete_file |
delete-file c_addr u -- wior file delete_file |
wior = FILEEXIST(unlink(cstr(c_addr, u, 1))); |
wior = IOR(unlink(cstr(c_addr, u, 1))==-1); |
|
|
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 |
char *s1=cstr(c_addr2, u2, 1); |
char *s1=cstr(c_addr2, u2, 1); |
wior = FILEEXIST(rename(cstr(c_addr1, u1, 0), s1)); |
wior = IOR(rename(cstr(c_addr1, u1, 0), s1)==-1); |
|
|
file-position wfileid -- ud wior file file_position |
file-position wfileid -- ud wior file file_position |
/* !! use tell and lseek? */ |
/* !! use tell and lseek? */ |
ud = ftell((FILE *)wfileid); |
ud = ftell((FILE *)wfileid); |
wior = 0; /* !! or wior = FLAG(ud<0) */ |
wior = IOR(ud==-1); |
|
|
reposition-file ud wfileid -- wior file reposition_file |
reposition-file ud wfileid -- wior file reposition_file |
wior = FILEIO(fseek((FILE *)wfileid, (long)ud, SEEK_SET)); |
wior = IOR(fseek((FILE *)wfileid, (long)ud, SEEK_SET)==-1); |
|
|
file-size wfileid -- ud wior file file_size |
file-size wfileid -- ud wior file file_size |
struct stat buf; |
struct stat buf; |
wior = FILEEXIST(fstat(fileno((FILE *)wfileid), &buf)); |
wior = IOR(fstat(fileno((FILE *)wfileid), &buf)==-1); |
ud = buf.st_size; |
ud = buf.st_size; |
|
|
resize-file ud wfileid -- wior file resize_file |
resize-file ud wfileid -- wior file resize_file |
wior = FILEIO(ftruncate(fileno((FILE *)wfileid), (Cell)ud)); |
wior = IOR(ftruncate(fileno((FILE *)wfileid), (Cell)ud)==-1); |
|
|
read-file c_addr u1 wfileid -- u2 wior file read_file |
read-file c_addr u1 wfileid -- u2 wior file read_file |
/* !! fread does not guarantee enough */ |
/* !! fread does not guarantee enough */ |
u2 = fread(c_addr, sizeof(Char), u1, (FILE *)wfileid); |
u2 = fread(c_addr, sizeof(Char), u1, (FILE *)wfileid); |
wior = FILEIO(u2<u1 && ferror((FILE *)wfileid)); |
wior = FILEIO(u2<u1 && ferror((FILE *)wfileid)); |
/* !! who performs clearerr((FILE *)wfileid); ? */ |
/* !! is the value of ferror errno-compatible? */ |
|
if (wior) |
|
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 |
/* |
/* |
Line 976 wior=FILEIO(ferror((FILE *)wfileid));
|
Line 986 wior=FILEIO(ferror((FILE *)wfileid));
|
*/ |
*/ |
if ((flag=FLAG(!feof((FILE *)wfileid) && |
if ((flag=FLAG(!feof((FILE *)wfileid) && |
fgets(c_addr,u1+1,(FILE *)wfileid) != NULL))) { |
fgets(c_addr,u1+1,(FILE *)wfileid) != NULL))) { |
wior=FILEIO(ferror((FILE *)wfileid)); |
wior=FILEIO(ferror((FILE *)wfileid)); /* !! ior? */ |
|
if (wior) |
|
clearerr((FILE *)wfileid); |
u2 = strlen(c_addr); |
u2 = strlen(c_addr); |
u2-=((u2>0) && (c_addr[u2-1]==NEWLINE)); |
u2-=((u2>0) && (c_addr[u2-1]==NEWLINE)); |
} |
} |
Line 990 write-file c_addr u1 wfileid -- wior fil
|
Line 1002 write-file c_addr u1 wfileid -- wior fil
|
{ |
{ |
Cell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid); |
Cell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid); |
wior = FILEIO(u2<u1 && ferror((FILE *)wfileid)); |
wior = FILEIO(u2<u1 && ferror((FILE *)wfileid)); |
|
if (wior) |
|
clearerr((FILE *)wfileid); |
} |
} |
|
|
flush-file wfileid -- wior file-ext flush_file |
flush-file wfileid -- wior file-ext flush_file |
wior = FILEIO(fflush((FILE *) wfileid)); |
wior = IOR(fflush((FILE *) wfileid)==EOF); |
|
|
comparisons(f, r1 r2, f_, r1, r2, new, new, float, new) |
comparisons(f, r1 r2, f_, r1, r2, new, new, float, new) |
comparisons(f0, r, f_zero_, r, 0., float, new, float, new) |
comparisons(f0, r, f_zero_, r, 0., float, new, float, new) |
Line 1359 lp -= sizeof(Float);
|
Line 1373 lp -= sizeof(Float);
|
|
|
up! a_addr -- new up_store |
up! a_addr -- new up_store |
up0=up=(char *)a_addr; |
up0=up=(char *)a_addr; |
|
|
|
call-c w -- new call_c |
|
""Call the C function pointed to by @i{w}. The C function has to |
|
access the stack itself. The stack pointers are exported in the gloabl |
|
variables @code{SP} and @code{FP}."" |
|
/* This is a first attempt at support for calls to C. This may change in |
|
the future */ |
|
IF_FTOS(fp[0]=FTOS); |
|
FP=fp; |
|
SP=sp; |
|
((void (*)())w)(); |
|
sp=SP; |
|
fp=FP; |
|
IF_TOS(TOS=sp[0]); |
|
IF_FTOS(FTOS=fp[0]); |
|
|
|
strerror n -- c_addr u new |
|
c_addr = strerror(n); |
|
u = strlen(c_addr); |