version 1.181, 2005/12/04 13:46:12
|
version 1.189, 2006/02/19 17:27:12
|
Line 1
|
Line 1
|
\ Gforth primitives |
\ Gforth primitives |
|
|
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 719 c2 = toupper(c1);
|
Line 719 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 - ; |
|
|
|
capscompare ( c_addr1 u1 c_addr2 u2 -- n ) string |
|
""Compare two strings lexicographically. If they are equal, @i{n} is 0; if |
|
the first string is smaller, @i{n} is -1; if the first string is larger, @i{n} |
|
is 1. Currently this is based on the machine's character |
|
comparison. In the future, this may change to consider the current |
|
locale and its collation order."" |
|
/* close ' to keep fontify happy */ |
|
n = capscompare(c_addr1, u1, c_addr2, u2); |
|
|
/string ( c_addr1 u1 n -- c_addr2 u2 ) string slash_string |
/string ( c_addr1 u1 n -- c_addr2 u2 ) string slash_string |
""Adjust the string specified by @i{c-addr1, u1} to remove @i{n} |
""Adjust the string specified by @i{c-addr1, u1} to remove @i{n} |
characters from the start of the string."" |
characters from the start of the string."" |
Line 873 division by 2 (note that @code{/} not ne
|
Line 882 division by 2 (note that @code{/} not ne
|
n2 = n1>>1; |
n2 = n1>>1; |
: |
: |
dup MINI and IF 1 ELSE 0 THEN |
dup MINI and IF 1 ELSE 0 THEN |
[ bits/byte cell * 1- ] literal |
[ bits/char cell * 1- ] literal |
0 DO 2* swap dup 2* >r MINI and |
0 DO 2* swap dup 2* >r MINI and |
IF 1 ELSE 0 THEN or r> swap |
IF 1 ELSE 0 THEN or r> swap |
LOOP nip ; |
LOOP nip ; |
Line 1229 useraddr ( #u -- a_addr ) new
|
Line 1238 useraddr ( #u -- a_addr ) new
|
a_addr = (Cell *)(up+u); |
a_addr = (Cell *)(up+u); |
|
|
up! ( a_addr -- ) gforth up_store |
up! ( a_addr -- ) gforth up_store |
UP=up=(char *)a_addr; |
gforth_UP=up=(char *)a_addr; |
: |
: |
up ! ; |
up ! ; |
Variable UP |
Variable UP |
Line 1672 with the window size.""
|
Line 1681 with the window size.""
|
urows=rows; |
urows=rows; |
ucols=cols; |
ucols=cols; |
|
|
|
wcwidth ( u -- n ) gforth |
|
""The number of fixed-width characters per unicode character u"" |
|
n = wcwidth(u); |
|
|
flush-icache ( c_addr u -- ) gforth flush_icache |
flush-icache ( c_addr u -- ) gforth flush_icache |
""Make sure that the instruction cache of the processor (if there is |
""Make sure that the instruction cache of the processor (if there is |
one) does not contain stale data at @i{c-addr} and @i{u} bytes |
one) does not contain stale data at @i{c-addr} and @i{u} bytes |
Line 1788 access the stack itself. The stack point
|
Line 1801 access the stack itself. The stack point
|
variables @code{SP} and @code{FP}."" |
variables @code{SP} and @code{FP}."" |
/* This is a first attempt at support for calls to C. This may change in |
/* This is a first attempt at support for calls to C. This may change in |
the future */ |
the future */ |
FP=fp; |
gforth_FP=fp; |
SP=sp; |
gforth_SP=sp; |
((void (*)())w)(); |
((void (*)())w)(); |
sp=SP; |
sp=gforth_SP; |
fp=FP; |
fp=gforth_FP; |
|
|
\+ |
\+ |
\+file |
\+file |
Line 2440 u3 = 0;
|
Line 2453 u3 = 0;
|
#endif |
#endif |
|
|
wcall ( ... u -- ... ) gforth |
wcall ( ... u -- ... ) gforth |
FP=fp; |
gforth_FP=fp; |
sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP); |
sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &gforth_FP); |
fp=FP; |
fp=gforth_FP; |
|
|
w@ ( a_addr -- u ) gforth wfetch |
uw@ ( c_addr -- u ) gforth u_w_fetch |
u = *(UWyde*)(a_addr); |
""@i{u} is the zero-extended 16-bit value stored at @i{c_addr}."" |
|
u = *(UWyde*)(c_addr); |
wx@ ( a_addr -- u ) gforth wxfetch |
|
u = *(Wyde*)(a_addr); |
sw@ ( c_addr -- n ) gforth s_w_fetch |
|
""@i{n} is the sign-extended 16-bit value stored at @i{c_addr}."" |
w! ( u a_addr -- ) gforth wstore |
n = *(Wyde*)(c_addr); |
*(Wyde*)(a_addr) = u; |
|
|
w! ( w c_addr -- ) gforth w_store |
t@ ( a_addr -- u ) gforth tfetch |
""Store the bottom 16 bits of @i{w} at @i{c_addr}."" |
u = *(UTetrabyte*)(a_addr); |
*(Wyde*)(c_addr) = w; |
|
|
tx@ ( a_addr -- u ) gforth txfetch |
ul@ ( c_addr -- u ) gforth u_l_fetch |
u = *(Tetrabyte*)(a_addr); |
""@i{u} is the zero-extended 32-bit value stored at @i{c_addr}."" |
|
u = *(UTetrabyte*)(c_addr); |
t! ( u a_addr -- ) gforth tstore |
|
*(Tetrabyte*)(a_addr) = u; |
sl@ ( c_addr -- n ) gforth s_l_fetch |
|
""@i{n} is the sign-extended 32-bit value stored at @i{c_addr}."" |
|
n = *(Tetrabyte*)(c_addr); |
|
|
|
l! ( w c_addr -- ) gforth l_store |
|
""Store the bottom 32 bits of @i{w} at @i{c_addr}."" |
|
*(Tetrabyte*)(c_addr) = w; |
|
|
\+FFCALL |
\+FFCALL |
|
|
Line 2565 REST_REGS
|
Line 2584 REST_REGS
|
c_addr = prv; |
c_addr = prv; |
|
|
alloc-callback ( a_ip -- c_addr ) gforth alloc_callback |
alloc-callback ( a_ip -- c_addr ) gforth alloc_callback |
c_addr = (char *)alloc_callback(engine_callback, (Xt *)a_ip); |
c_addr = (char *)alloc_callback(gforth_callback, (Xt *)a_ip); |
|
|
va-start-void ( -- ) gforth va_start_void |
va-start-void ( -- ) gforth va_start_void |
va_start_void(clist); |
va_start_void(clist); |
Line 2657 ffi-prep-cif ( a_atypes n a_rtype a_cif
|
Line 2676 ffi-prep-cif ( a_atypes n a_rtype a_cif
|
w = ffi_prep_cif(a_cif, FFI_DEFAULT_ABI, n, a_rtype, a_atypes); |
w = ffi_prep_cif(a_cif, FFI_DEFAULT_ABI, n, a_rtype, a_atypes); |
|
|
ffi-call ( a_avalues a_rvalue a_ip a_cif -- ) gforth ffi_call |
ffi-call ( a_avalues a_rvalue a_ip a_cif -- ) gforth ffi_call |
|
SAVE_REGS |
ffi_call(a_cif, a_ip, a_rvalue, a_avalues); |
ffi_call(a_cif, a_ip, a_rvalue, a_avalues); |
|
REST_REGS |
|
|
ffi-prep-closure ( a_ip a_cif a_closure -- w ) gforth ffi_prep_closure |
ffi-prep-closure ( a_ip a_cif a_closure -- w ) gforth ffi_prep_closure |
w = ffi_prep_closure(a_closure, a_cif, ffi_callback, a_ip); |
w = ffi_prep_closure(a_closure, a_cif, gforth_callback, a_ip); |
|
|
ffi-2@ ( a_addr -- d ) gforth ffi_2fetch |
ffi-2@ ( a_addr -- d ) gforth ffi_2fetch |
#ifdef BUGGY_LONG_LONG |
#ifdef BUGGY_LONG_LONG |