| dup 0< IF drop -1 ELSE 0> IF 1 ELSE 0 THEN THEN ; |
dup 0< IF drop -1 ELSE 0> IF 1 ELSE 0 THEN THEN ; |
| |
|
| capscomp c_addr1 u c_addr2 -- n new |
capscomp c_addr1 u c_addr2 -- n new |
| Char c1, c2; |
n = memcasecmp(c_addr1, c_addr2, u); /* !! use something that works in all locales */ |
| for (;; u--, c_addr1++, c_addr2++) { |
if (n<0) |
| if (u == 0) { |
|
| n = 0; |
|
| break; |
|
| } |
|
| c1 = toupper(*c_addr1); |
|
| c2 = toupper(*c_addr2); |
|
| if (c1 != c2) { |
|
| if (c1 < c2) |
|
| n = -1; |
n = -1; |
| else |
else if (n>0) |
| n = 1; |
n = 1; |
| break; |
|
| } |
|
| } |
|
| : |
: |
| swap bounds |
swap bounds |
| ?DO dup c@ toupper I c@ toupper = WHILE 1+ LOOP drop 0 |
?DO dup c@ toupper I c@ toupper = WHILE 1+ LOOP drop 0 |
| (bye) n -- gforth paren_bye |
(bye) n -- gforth paren_bye |
| return (Label *)n; |
return (Label *)n; |
| |
|
| system c_addr u -- n gforth |
(system) c_addr u -- wretval wior gforth peren_system |
| int old_tp=terminal_prepped; |
int old_tp=terminal_prepped; |
| deprep_terminal(); |
deprep_terminal(); |
| n=system(cstr(c_addr,u,1)); /* ~ expansion on first part of string? */ |
wretval=system(cstr(c_addr,u,1)); /* ~ expansion on first part of string? */ |
| |
wior = IOR(wretval==-1 || (wretval==127 && errno != 0)); |
| if (old_tp) |
if (old_tp) |
| prep_terminal(); |
prep_terminal(); |
| |
|
| wfileid=(Cell)popen(cstr(c_addr,u,1),fileattr[ntype]); /* ~ expansion of 1st arg? */ |
wfileid=(Cell)popen(cstr(c_addr,u,1),fileattr[ntype]); /* ~ 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 */ |
| |
|
| close-pipe wfileid -- wior gforth close_pipe |
close-pipe wfileid -- wretval wior gforth close_pipe |
| wior = IOR(pclose((FILE *)wfileid)==-1); |
wretval = pclose((FILE *)wfileid); |
| |
wior = IOR(wretval==-1); |
| |
|
| 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; |
| ""Change the size of the allocated area at @i{a_addr1} to @i{u} |
""Change the size of the allocated area at @i{a_addr1} to @i{u} |
| address units, possibly moving the contents to a different |
address units, possibly moving the contents to a different |
| area. @i{a_addr2} is the address of the resulting area. If |
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{a_addr1} is 0, Gforth's (but not the standard) @code{resize} |
| @code{allocate}s @i{u} address units."" |
@code{allocate}s @i{u} address units."" |
| /* the following check is not necessary on most OSs, but it is needed |
/* the following check is not necessary on most OSs, but it is needed |
| on SunOS 4.1.2. */ |
on SunOS 4.1.2. */ |
| (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) |
| if (F83NAME_COUNT(f83name1)==u && |
if (F83NAME_COUNT(f83name1)==u && |
| strncasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */) |
memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */) |
| break; |
break; |
| f83name2=f83name1; |
f83name2=f83name1; |
| : |
: |
| f83name1=(F83Name *)(a_addr[1]); |
f83name1=(F83Name *)(a_addr[1]); |
| a_addr=(Cell *)(a_addr[0]); |
a_addr=(Cell *)(a_addr[0]); |
| if (F83NAME_COUNT(f83name1)==u && |
if (F83NAME_COUNT(f83name1)==u && |
| strncasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */) |
memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */) |
| { |
{ |
| f83name2=f83name1; |
f83name2=f83name1; |
| break; |
break; |
| |
|
| >does-code xt -- a_addr gforth to_does_code |
>does-code xt -- a_addr gforth to_does_code |
| ""If xt ist the execution token of a defining-word-defined word, |
""If xt ist the execution token of a defining-word-defined word, |
| a_addr is the start of the Forth code after the DOES>; Otherwise the |
a_addr is the start of the Forth code after the DOES>; |
| behaviour is undefined"" |
Otherwise a_addr is 0."" |
| /* !! there is currently no way to determine whether a word is |
|
| defining-word-defined */ |
|
| a_addr = (Cell *)DOES_CODE(xt); |
a_addr = (Cell *)DOES_CODE(xt); |
| |
|
| code-address! c_addr xt -- gforth code_address_store |
code-address! c_addr xt -- gforth code_address_store |
