version 1.251, 2010/07/05 18:46:19
|
version 1.261, 2011/12/02 21:59:09
|
Line 1
|
Line 1
|
\ Gforth primitives |
\ Gforth primitives |
|
|
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009,2010 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 612 SET_IP((Xt *)a_target);
|
Line 612 SET_IP((Xt *)a_target);
|
cell+ |
cell+ |
THEN >r ; |
THEN >r ; |
|
|
|
(try1) ( ... a_oldhandler a_recovery -- R:a_recovery R:a_sp R:f_fp R:c_lp R:a_oldhandler a_newhandler ) gforth paren_try1 |
|
a_sp = sp-1; |
|
f_fp = fp; |
|
c_lp = lp; |
|
a_newhandler = rp-5; |
|
|
|
(throw1) ( ... wball a_handler -- ... wball ) gforth paren_throw1 |
|
rp = a_handler; |
|
lp = (Address)rp[1]; |
|
fp = (Float *)rp[2]; |
|
sp = (Cell *)rp[3]; |
|
#ifndef NO_IP |
|
ip=IP; |
|
#endif |
|
SUPER_END; |
|
VM_JUMP(EXEC1(*(Xt *)rp[4])); |
|
|
|
|
\+ |
\+ |
|
|
\ don't make any assumptions where the return stack is!! |
\ don't make any assumptions where the return stack is!! |
Line 1786 if (a_addr1==NULL)
|
Line 1804 if (a_addr1==NULL)
|
else |
else |
a_addr2 = (Cell *)realloc(a_addr1, u); |
a_addr2 = (Cell *)realloc(a_addr1, u); |
wior = IOR(a_addr2==NULL); /* !! Define a return code */ |
wior = IOR(a_addr2==NULL); /* !! Define a return code */ |
|
if (a_addr2==NULL) |
|
a_addr2 = a_addr1; |
|
|
strerror ( n -- c_addr u ) gforth |
strerror ( n -- c_addr u ) gforth |
c_addr = (Char *)strerror(n); |
c_addr = (Char *)strerror(n); |
Line 2013 duser = timeval2us(&time1);
|
Line 2033 duser = timeval2us(&time1);
|
dsystem = DZERO; |
dsystem = DZERO; |
#endif |
#endif |
|
|
|
ntime ( -- dtime ) gforth |
|
""Report the current time in nanoseconds since some epoch."" |
|
#ifdef HAVE_CLOCK_GETTIME |
|
struct timespec time1; |
|
clock_gettime(CLOCK_REALTIME,&time1); |
|
dtime = timespec2ns(&time1); |
|
#else |
|
struct timeval time1; |
|
gettimeofday(&time1,NULL); |
|
dtime = timeval2us(&time1) * 1000LL; |
|
#endif |
|
|
\+ |
\+ |
|
|
\+floating |
\+floating |
Line 2492 c_addr = "libltdl is not configured";
|
Line 2524 c_addr = "libltdl is not configured";
|
u = strlen(c_addr); |
u = strlen(c_addr); |
#endif |
#endif |
|
|
\ w!be ( w c_addr -- ) gforth w_store_be |
be-w! ( w c_addr -- ) gforth w_store_be |
\ ""Store the bottom 16 bits of @i{w} at @i{c_addr} in big endian format."" |
""Store the bottom 16 bits of @i{w} at @i{c_addr} in big endian format."" |
\ *(Wyde*)(c_addr) = htobe16(w); |
c_addr[0] = w >> 8; |
\ |
c_addr[1] = w; |
\ l!be ( w c_addr -- ) gforth l_store_be |
|
\ ""Store the bottom 32 bits of @i{w} at @i{c_addr} in big endian format."" |
be-l! ( w c_addr -- ) gforth l_store_be |
\ *(Tetrabyte*)(c_addr) = htobe32(w); |
""Store the bottom 32 bits of @i{w} at @i{c_addr} in big endian format."" |
\ |
c_addr[0] = w >> 24; |
\ x!be ( w c_addr -- ) gforth x_store_be |
c_addr[1] = w >> 16; |
\ ""Store the bottom 64 bits of @i{w} at @i{c_addr} in big endian format."" |
c_addr[2] = w >> 8; |
\ *(Octabyte*)(c_addr) = htobe64(w); |
c_addr[3] = w; |
\ |
|
\ w!le ( w c_addr -- ) gforth w_store_le |
le-w! ( w c_addr -- ) gforth w_store_le |
\ ""Store the bottom 16 bits of @i{w} at @i{c_addr} in big endian format."" |
""Store the bottom 16 bits of @i{w} at @i{c_addr} in big endian format."" |
\ *(Wyde*)(c_addr) = htole16(w); |
c_addr[1] = w >> 8; |
\ |
c_addr[0] = w; |
\ l!le ( w c_addr -- ) gforth l_store_le |
|
\ ""Store the bottom 32 bits of @i{w} at @i{c_addr} in big endian format."" |
le-l! ( w c_addr -- ) gforth l_store_le |
\ *(Tetrabyte*)(c_addr) = htole32(w); |
""Store the bottom 32 bits of @i{w} at @i{c_addr} in big endian format."" |
\ |
c_addr[3] = w >> 24; |
\ x!le ( w c_addr -- ) gforth x_store_le |
c_addr[2] = w >> 16; |
\ ""Store the bottom 64 bits of @i{w} at @i{c_addr} in big endian format."" |
c_addr[1] = w >> 8; |
\ *(Octabyte*)(c_addr) = htole64(w); |
c_addr[0] = w; |
\ |
|
\ w@be ( c_addr -- u ) gforth w_fetch_be |
be-uw@ ( c_addr -- u ) gforth w_fetch_be |
\ ""@i{u} is the zero-extended 16-bit big endian value stored at @i{c_addr}."" |
""@i{u} is the zero-extended 16-bit big endian value stored at @i{c_addr}."" |
\ u = be16toh(*(UWyde*)(c_addr)); |
u = (c_addr[0] << 8) | (c_addr[1]); |
\ |
|
\ l@be ( c_addr -- u ) gforth l_fetch_be |
be-ul@ ( c_addr -- u ) gforth l_fetch_be |
\ ""@i{u} is the zero-extended 32-bit big endian value stored at @i{c_addr}."" |
""@i{u} is the zero-extended 32-bit big endian value stored at @i{c_addr}."" |
\ u = be32toh(*(UTetrabyte*)(c_addr)); |
u = (c_addr[0] << 24) | (c_addr[1] << 16) | (c_addr[2] << 8) | (c_addr[3]); |
\ |
|
\ x@be ( c_addr -- u ) gforth x_fetch_be |
le-uw@ ( c_addr -- u ) gforth w_fetch_le |
\ ""@i{u} is the zero-extended 64-bit big endian value stored at @i{c_addr}."" |
""@i{u} is the zero-extended 16-bit little endian value stored at @i{c_addr}."" |
\ u = be64toh(*(UOctabyte*)(c_addr)); |
u = (c_addr[1] << 8) | (c_addr[0]); |
\ |
|
\ w@le ( c_addr -- u ) gforth w_fetch_le |
le-ul@ ( c_addr -- u ) gforth l_fetch_le |
\ ""@i{u} is the zero-extended 16-bit little endian value stored at @i{c_addr}."" |
""@i{u} is the zero-extended 32-bit little endian value stored at @i{c_addr}."" |
\ u = le16toh(*(UWyde*)(c_addr)); |
u = (c_addr[3] << 24) | (c_addr[2] << 16) | (c_addr[1] << 8) | (c_addr[0]); |
\ |
|
\ l@le ( c_addr -- u ) gforth l_fetch_le |
\+64bit |
\ ""@i{u} is the zero-extended 32-bit little endian value stored at @i{c_addr}."" |
|
\ u = le32toh(*(UTetrabyte*)(c_addr)); |
x! ( w c_addr -- ) gforth x_store |
\ |
""Store the bottom 64 bits of @i{w} at 64-bit-aligned @i{c_addr}."" |
\ x@le ( c_addr -- u ) gforth x_fetch_le |
*(UOctabyte *)c_addr = w; |
\ ""@i{u} is the zero-extended 64-bit little endian value stored at @i{c_addr}."" |
|
\ u = le64toh(*(UOctabyte*)(c_addr)); |
ux@ ( c_addr -- u ) gforth u_x_fetch |
|
""@i{u} is the zero-extended 64-bit value stored at 64-bit-aligned @i{c_addr}."" |
|
u = *(UOctabyte *)c_addr; |
|
|
|
sx@ ( c_addr -- n ) gforth s_x_fetch |
|
""@i{u} is the sign-extended 64-bit value stored at 64-bit-aligned @i{c_addr}."" |
|
n = *(Octabyte *)c_addr; |
|
|
|
be-x! ( w c_addr -- ) gforth b_e_x_store |
|
""Store the bottom 64 bits of @i{w} at @i{c_addr} in big endian format."" |
|
c_addr[0] = w >> 56; |
|
c_addr[1] = w >> 48; |
|
c_addr[2] = w >> 40; |
|
c_addr[3] = w >> 32; |
|
c_addr[4] = w >> 24; |
|
c_addr[5] = w >> 16; |
|
c_addr[6] = w >> 8; |
|
c_addr[7] = w; |
|
|
|
le-x! ( w c_addr -- ) gforth l_e_x_store |
|
""Store the bottom 64 bits of @i{w} at @i{c_addr} in big endian format."" |
|
c_addr[7] = w >> 56; |
|
c_addr[6] = w >> 48; |
|
c_addr[5] = w >> 40; |
|
c_addr[4] = w >> 32; |
|
c_addr[3] = w >> 24; |
|
c_addr[2] = w >> 16; |
|
c_addr[1] = w >> 8; |
|
c_addr[0] = w; |
|
|
|
be-ux@ ( c_addr -- u ) gforth b_e_u_x_fetch |
|
""@i{u} is the zero-extended 64-bit big endian value stored at @i{c_addr}."" |
|
u = (((Cell)(c_addr[0]) << 56) | |
|
((Cell)(c_addr[1]) << 48) | |
|
((Cell)(c_addr[2]) << 40) | |
|
((Cell)(c_addr[3]) << 32) | |
|
((Cell)(c_addr[4]) << 24) | |
|
((Cell)(c_addr[5]) << 16) | |
|
((Cell)(c_addr[6]) << 8) | |
|
((Cell)(c_addr[7]))); |
|
|
|
le-ux@ ( c_addr -- u ) gforth l_e_u_x_fetch |
|
""@i{u} is the zero-extended 64-bit little endian value stored at @i{c_addr}."" |
|
u = (((Cell)(c_addr[7]) << 56) | |
|
((Cell)(c_addr[6]) << 48) | |
|
((Cell)(c_addr[5]) << 40) | |
|
((Cell)(c_addr[4]) << 32) | |
|
((Cell)(c_addr[3]) << 24) | |
|
((Cell)(c_addr[2]) << 16) | |
|
((Cell)(c_addr[1]) << 8) | |
|
((Cell)(c_addr[0]))); |
|
|
\+ |
\+ |
|
\+ |
\g peephole |
\g peephole |
|
|
\+peephole |
\+peephole |