version 1.22, 1999/02/03 00:10:21
|
version 1.24, 1999/02/16 06:32:30
|
Line 141 goto branch;
|
Line 141 goto branch;
|
|
|
branch -- gforth |
branch -- gforth |
branch: |
branch: |
ip = (Xt *)(((Cell)IP)+(Cell)NEXT_INST); |
SET_IP((Xt *)(((Cell)IP)+(Cell)NEXT_INST)); |
NEXT_P0; |
|
: |
: |
r> dup @ + >r ; |
r> dup @ + >r ; |
|
|
Line 150 NEXT_P0;
|
Line 149 NEXT_P0;
|
\ this is non-syntactical: code must open a brace that is closed by the macro |
\ this is non-syntactical: code must open a brace that is closed by the macro |
define(condbranch, |
define(condbranch, |
$1 $2 |
$1 $2 |
$3 ip = (Xt *)(((Cell)IP)+(Cell)NEXT_INST); |
$3 SET_IP((Xt *)(((Cell)IP)+(Cell)NEXT_INST)); |
NEXT_P0; |
|
NEXT; |
NEXT; |
} |
} |
else |
else |
Line 189 if (f==0) {
|
Line 187 if (f==0) {
|
if (f==0) { |
if (f==0) { |
sp++; |
sp++; |
IF_TOS(TOS = sp[0]); |
IF_TOS(TOS = sp[0]); |
ip = (Xt *)(((Cell)IP)+(Cell)NEXT_INST); |
SET_IP((Xt *)(((Cell)IP)+(Cell)NEXT_INST)); |
NEXT_P0; |
|
NEXT; |
NEXT; |
} |
} |
else |
else |
Line 204 few cycles in that case, but is easy to
|
Line 201 few cycles in that case, but is easy to
|
invocation */ |
invocation */ |
if (f!=0) { |
if (f!=0) { |
sp--; |
sp--; |
ip = (Xt *)(((Cell)IP)+(Cell)NEXT_INST); |
SET_IP((Xt *)(((Cell)IP)+(Cell)NEXT_INST)); |
NEXT_P0; |
|
NEXT; |
NEXT; |
} |
} |
else |
else |
Line 516 else if (n>0)
|
Line 512 else if (n>0)
|
dup 0< IF drop -1 ELSE 0> 1 and THEN ; |
dup 0< IF drop -1 ELSE 0> 1 and THEN ; |
|
|
toupper c1 -- c2 gforth |
toupper c1 -- c2 gforth |
|
""For a character a-z, convert to the equivalent upper-case |
|
character. All other characters are unchanged."" |
c2 = toupper(c1); |
c2 = toupper(c1); |
: |
: |
dup [char] a - [ char z char a - 1 + ] Literal u< bl and - ; |
dup [char] a - [ char z char a - 1 + ] Literal u< bl and - ; |
Line 955 fp = f_addr;
|
Line 953 fp = f_addr;
|
|
|
;s -- gforth semis |
;s -- gforth semis |
""The primitive compiled by @code{EXIT}."" |
""The primitive compiled by @code{EXIT}."" |
ip = (Xt *)(*rp++); |
SET_IP((Xt *)(*rp++)); |
NEXT_P0; |
|
|
|
>r w -- core to_r |
>r w -- core to_r |
*--rp = w; |
*--rp = w; |
Line 1447 if (old_tp)
|
Line 1444 if (old_tp)
|
#endif |
#endif |
|
|
getenv c_addr1 u1 -- c_addr2 u2 gforth |
getenv c_addr1 u1 -- c_addr2 u2 gforth |
|
""The string c-addr1 u1 specifies an environment variable. The string c-addr2 u2 |
|
is the host operating system's expansion of that environment variable. If the |
|
environment variable does not exist, c-addr2 u2 specifies a string 0 characters |
|
in length."" |
c_addr2 = getenv(cstr(c_addr1,u1,1)); |
c_addr2 = getenv(cstr(c_addr1,u1,1)); |
u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2)); |
u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2)); |
|
|