gforth/prim - diff

Return to prim CVS log

Up to [gforth] / gforth

Diff for /gforth/prim between versions 1.31 and 1.37

version 1.31, 1999/05/10 12:52:06	version 1.37, 1999/08/07 21:40:35
Line 445 n = rp[4];	Line 445 n = rp[4];
\ digit is high-level: 0/0%	\ digit is high-level: 0/0%

move c_from c_to ucount -- core	move c_from c_to ucount -- core
"" If @i{ucount}>0, copy the contents of @i{ucount} address units	""Copy the contents of @i{ucount} address units at @i{c-from} to
at @i{c-from} to @i{c-to}. @code{move} chooses its copy direction	@i{c-to}. @code{move} works correctly even if the two areas overlap.""
to avoid problems when @i{c-from}, @i{c-to} overlap.""
memmove(c_to,c_from,ucount);	memmove(c_to,c_from,ucount);
/* make an Ifdef for bsd and others? */	/* make an Ifdef for bsd and others? */
:	:
>r 2dup u< IF r> cmove> ELSE r> cmove THEN ;	>r 2dup u< IF r> cmove> ELSE r> cmove THEN ;

cmove c_from c_to u -- string	cmove c_from c_to u -- string
"" If @i{u}>0, copy the contents of @i{ucount} characters from	""Copy the contents of @i{ucount} characters from data space at
data space at @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}	@i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}
from low address to high address.""	from low address to high address; i.e., for overlapping areas it is
	safe if @i{c-to}=<@i{c-from}.""
while (u-- > 0)	while (u-- > 0)
c_to++ = c_from++;	c_to++ = c_from++;
:	:
bounds ?DO dup c@ I c! 1+ LOOP drop ;	bounds ?DO dup c@ I c! 1+ LOOP drop ;

cmove> c_from c_to u -- string c_move_up	cmove> c_from c_to u -- string c_move_up
"" If @i{u}>0, copy the contents of @i{ucount} characters from	""Copy the contents of @i{ucount} characters from data space at
data space at @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}	@i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}
from high address to low address.""	from high address to low address; i.e., for overlapping areas it is
	safe if @i{c-to}>=@i{c-from}.""
while (u-- > 0)	while (u-- > 0)
c_to[u] = c_from[u];	c_to[u] = c_from[u];
:	:
Line 487 the first string is smaller, @i{n} is -1	Line 488 the first string is smaller, @i{n} is -1
is 1. Currently this is based on the machine's character	is 1. Currently this is based on the machine's character
comparison. In the future, this may change to consider the current	comparison. In the future, this may change to consider the current
locale and its collation order.""	locale and its collation order.""
	#ifdef MEMCMP_AS_SUBROUTINE
	n = gforth_memcmp(c_addr1, c_addr2, u1<u2 ? u1 : u2);
	#else
n = memcmp(c_addr1, c_addr2, u1<u2 ? u1 : u2);	n = memcmp(c_addr1, c_addr2, u1<u2 ? u1 : u2);
	#endif
if (n==0)	if (n==0)
n = u1-u2;	n = u1-u2;
if (n<0)	if (n<0)
Line 504 else if (n>0)	Line 509 else if (n>0)
THEN ;	THEN ;

-text c_addr1 u c_addr2 -- n new dash_text	-text c_addr1 u c_addr2 -- n new dash_text
	#ifdef MEMCMP_AS_SUBROUTINE
	n = gforth_memcmp(c_addr1, c_addr2, u);
	#else
n = memcmp(c_addr1, c_addr2, u);	n = memcmp(c_addr1, c_addr2, u);
	#endif
if (n<0)	if (n<0)
n = -1;	n = -1;
else if (n>0)	else if (n>0)
Line 718 ud = (UDCell)u1 * (UDCell)u2;	Line 727 ud = (UDCell)u1 * (UDCell)u2;
and >r >r 2dup d+ swap r> + swap r> ;	and >r >r 2dup d+ swap r> + swap r> ;

um/mod ud u1 -- u2 u3 core u_m_slash_mod	um/mod ud u1 -- u2 u3 core u_m_slash_mod
	""ud=u3*u1+u2, u1>u2>=0""
#ifdef BUGGY_LONG_LONG	#ifdef BUGGY_LONG_LONG
UDCell r = umdiv(ud,u1);	UDCell r = umdiv(ud,u1);
u2=r.hi;	u2=r.hi;
Line 933 dcomparisons(du, ud1 ud2, d_u_, ud1, ud2	Line 943 dcomparisons(du, ud1 ud2, d_u_, ud1, ud2
\+	\+

within u1 u2 u3 -- f core-ext	within u1 u2 u3 -- f core-ext
	""u2=<u1<u3 or: u3=<u2 and u1 is not in [u3,u2). This works for
	unsigned and signed numbers (but not a mixture). Another way to think
	about this word is to consider the numbers as a circle (wrapping
	around from @code{max-u} to 0 for unsigned, and from @code{max-n} to
	min-n for signed numbers); now consider the range from u2 towards
	increasing numbers up to and excluding u3 (giving an empty range if
	u2=u3; if u1 is in this range, @code{within} returns true.""
f = FLAG(u1-u2 < u3-u2);	f = FLAG(u1-u2 < u3-u2);
:	:
over - >r - r> u< ;	over - >r - r> u< ;
Line 1257 while(a_addr != NULL)	Line 1274 while(a_addr != NULL)
f83name1=(struct F83Name *)(a_addr[1]);	f83name1=(struct F83Name *)(a_addr[1]);
a_addr=(Cell *)(a_addr[0]);	a_addr=(Cell *)(a_addr[0]);
if ((UCell)F83NAME_COUNT(f83name1)==u &&	if ((UCell)F83NAME_COUNT(f83name1)==u &&
	#ifdef MEMCMP_AS_SUBROUTINE
	gforth_memcmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
	#else
memcmp(c_addr, f83name1->name, u)== 0 /* or inline? */)	memcmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
	#endif
{	{
f83name2=f83name1;	f83name2=f83name1;
break;	break;
Line 1344 a_addr = PFA(xt);	Line 1365 a_addr = PFA(xt);
:	:
2 cells + ;	2 cells + ;

\+standardthreading	\ threading stuff is currently only interesting if we have a compiler
	\fhas? standardthreading has? compiler and [IF]

>code-address xt -- c_addr gforth to_code_address	>code-address xt -- c_addr gforth to_code_address
""@i{c-addr} is the code address of the word @i{xt}.""	""@i{c-addr} is the code address of the word @i{xt}.""
Line 1406 n=1;	Line 1428 n=1;
:	:
1 ;	1 ;

\+	\f[THEN]

key-file wfileid -- n gforth paren_key_file	key-file wfileid -- n gforth paren_key_file
#ifdef HAS_FILE	#ifdef HAS_FILE
Line 1672 wior = FILEIO(putc(c, (FILE *)wfileid)==	Line 1694 wior = FILEIO(putc(c, (FILE *)wfileid)==
if (wior)	if (wior)
clearerr((FILE *)wfileid);	clearerr((FILE *)wfileid);
#else	#else
putc(c, stdout);	PUTC(c);
#endif	#endif

\+file	\+file
Line 2169 UP=up=(char *)a_addr;	Line 2191 UP=up=(char *)a_addr;
:	:
up ! ;	up ! ;
Variable UP	Variable UP

	wcall u -- gforth
	IF_FTOS(fp[0]=FTOS);
	FP=fp;
	sp=(SYSCALL(Cell()(Cell , void *))u)(sp, &FP);
	fp=FP;
	IF_TOS(TOS=sp[0];)
	IF_FTOS(FTOS=fp[0]);

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.31
changed lines
	Added in v.1.37