gforth/prim - diff

Return to prim CVS log

Up to [gforth] / gforth

Diff for /gforth/prim between versions 1.1 and 1.5

version 1.1, 1997/05/21 20:39:36	version 1.5, 1997/07/06 14:37:00
Line 171 else	Line 171 else
condbranch(?branch,f -- f83 question_branch,	condbranch(?branch,f -- f83 question_branch,
if (f==0) {	if (f==0) {
IF_TOS(TOS = sp[0]);	IF_TOS(TOS = sp[0]);
,)	,:
	0= dup \ !f !f
	r> dup @ \ !f !f IP branchoffset
	rot and + \ !f IP\|IP+branchoffset
	swap 0= cell and + \ IP''
	>r ;)

\ we don't need an lp_plus_store version of the ?dup-stuff, because it	\ we don't need an lp_plus_store version of the ?dup-stuff, because it
\ is only used in if's (yet)	\ is only used in if's (yet)
Line 404 else {	Line 409 else {

\+[THEN]	\+[THEN]

	\ don't make any assumptions where the return stack is!!
	\ implement this in machine code if it should run quickly!

i -- n core	i -- n core
n = *rp;	n = *rp;
:	:
rp@ cell+ @ ;	\ rp@ cell+ @ ;
	r> r> tuck >r >r ;

i' -- w gforth i_tick	i' -- w gforth i_tick
""loop end value""	""loop end value""
w = rp[1];	w = rp[1];
:	:
rp@ cell+ cell+ @ ;	\ rp@ cell+ cell+ @ ;
	r> r> r> dup itmp ! >r >r >r itmp @ ;
	variable itmp

j -- n core	j -- n core
n = rp[2];	n = rp[2];
:	:
rp@ cell+ cell+ cell+ @ ;	\ rp@ cell+ cell+ cell+ @ ;
	r> r> r> r> dup itmp ! >r >r >r >r itmp @ ;
	[IFUNDEF] itmp variable itmp [THEN]

k -- n gforth	k -- n gforth
n = rp[4];	n = rp[4];
:	:
rp@ [ 5 cells ] Literal + @ ;	\ rp@ [ 5 cells ] Literal + @ ;
	r> r> r> r> r> r> dup itmp ! >r >r >r >r >r >r itmp @ ;
	[IFUNDEF] itmp variable itmp [THEN]

\ digit is high-level: 0/0%	\ digit is high-level: 0/0%

Line 508 else if (n>0)	Line 523 else if (n>0)

-trailing c_addr u1 -- c_addr u2 string dash_trailing	-trailing c_addr u1 -- c_addr u2 string dash_trailing
u2 = u1;	u2 = u1;
while (c_addr[u2-1] == ' ')	while (u2>0 && c_addr[u2-1] == ' ')
u2--;	u2--;
:	:
BEGIN 1- 2dup + c@ bl = WHILE	BEGIN 1- 2dup + c@ bl = WHILE
Line 607 n2 = n1>>1;	Line 622 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/byte cell * 1- ] literal
0 DO 2* swap dup 2* >r U-HIGHBIT 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 694 u2 = ud%u1;	Line 709 u2 = ud%u1;
#endif	#endif
:	:
0 swap [ 8 cells 1 + ] literal 0	0 swap [ 8 cells 1 + ] literal 0
?DO >r /modstep r>	?DO /modstep
LOOP drop swap 1 rshift or swap ;	LOOP drop swap 1 rshift or swap ;
: /modstep ( ud c R: u -- ud-?u c R: u )	: /modstep ( ud c R: u -- ud-?u c R: u )
over I' u< 0= or IF I' - 1 ELSE 0 THEN d2*+ ;	>r over r@ u< 0= or IF r@ - 1 ELSE 0 THEN d2*+ r> ;
: d2*+ ( ud n -- ud+n c )	: d2*+ ( ud n -- ud+n c )
over MINI	over MINI
and >r >r 2dup d+ swap r> + swap r> ;	and >r >r 2dup d+ swap r> + swap r> ;
Line 1795 r2 = exp(r1);	Line 1810 r2 = exp(r1);
fexpm1 r1 -- r2 float-ext	fexpm1 r1 -- r2 float-ext
""@i{r2}=@i{e}**@i{r1}@minus{}1""	""@i{r2}=@i{e}**@i{r1}@minus{}1""
#ifdef HAVE_EXPM1	#ifdef HAVE_EXPM1
extern double expm1(double);	extern double
	#ifdef NeXT
	const
	#endif
	expm1(double);
r2 = expm1(r1);	r2 = expm1(r1);
#else	#else
r2 = exp(r1)-1.;	r2 = exp(r1)-1.;
Line 1807 r2 = log(r1);	Line 1826 r2 = log(r1);
flnp1 r1 -- r2 float-ext	flnp1 r1 -- r2 float-ext
""@i{r2}=ln(@i{r1}+1)""	""@i{r2}=ln(@i{r1}+1)""
#ifdef HAVE_LOG1P	#ifdef HAVE_LOG1P
extern double log1p(double);	extern double
	#ifdef NeXT
	const
	#endif
	log1p(double);
r2 = log1p(r1);	r2 = log1p(r1);
#else	#else
r2 = log(r1+1.);	r2 = log(r1+1.);

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

Removed from v.1.1
changed lines
	Added in v.1.5