cross.fs: Corrected bug on le machines

Minor changes on other files

cross.fs

 \ CROSS.FS     The Cross-Compiler                      06oct92py
-\ $Id: cross.fs,v 1.19 1995-01-19 17:47:59 pazsan Exp $
+\ $Id: cross.fs,v 1.20 1995-01-24 17:31:17 pazsan Exp $
 \ Idea and implementation: Bernd Paysan (py)
 \ Copyright 1992-94 by the GNU Forth Development Group
 
@@ -121,24 +121,17 @@ H
 
 >CROSS
 
-bigendian  0 pad ! -1 pad c! pad @ 0<
-= [IF]
-\   : bswap ; immediate 
-: T!  ( n addr -- )  >r s>d r> tcell bounds swap 1-
-  DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
-: T@  ( addr -- n )  >r 0 0 r> tcell bounds
-  DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
-
+bigendian
+[IF]
+   : T!  ( n addr -- )  >r s>d r> tcell bounds swap 1-
+     DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
+   : T@  ( addr -- n )  >r 0 0 r> tcell bounds
+     DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
 [ELSE]
-: T!  ( n addr -- )  >r s>d r> tcell bounds
-  DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
-: T@  ( addr -- n )  >r 0 0 r> tcell bounds swap 1-
-  DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;
-
-\   : bswap ( big / little -- little / big )  0
-\           cell 1- FOR  bits/byte lshift over
-\                        [ 1 bits/byte lshift 1- ] Literal and or
-\                        swap bits/byte rshift swap  NEXT  nip ;
+   : T!  ( n addr -- )  >r s>d r> tcell bounds
+     DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
+   : T@  ( addr -- n )  >r 0 0 r> tcell bounds swap 1-
+     DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;
 [THEN]
 
 \ Memory initialisation                                05dec92py

ecvt.c

@@ -19,14 +19,11 @@ char* ecvt(double x, int len, int* exp, int* sign)
      {
 	*sign = 0;
      }
-   
+
    if(x==0)
-     {
-	*exp=0;
-	return "0";
-     }
-   
-   *exp=(int)floor(log10(x));
+	*exp=-1;
+   else
+     *exp=(int)floor(log10(x));
    x = x / pow10((double)*exp);
    
    *exp += 1;

float.fs

@@ -86,7 +86,7 @@
 1e0 fasin 2e0 f* fconstant pi
 
 : f2*  2e0 f* ;
-: f2/  2e0 f/ ;
+: f2/  .5e0 f* ;
 : 1/f  1e0 fswap f/ ;
 
 

gforth.ds

@@ -801,11 +801,11 @@ Therefore we recommend avoiding using @code{@var{n} +LOOP} with negative
 @var{n}. One alternative is @code{@var{n} S+LOOP}, where the negative
 case behaves symmetrical to the positive case:
 
-@code{-2 0 ?DO  i .  -1 +LOOP}  prints @code{0 -1}
+@code{-2 0 ?DO  i .  -1 S+LOOP}  prints @code{0 -1}
 
-@code{-1 0 ?DO  i .  -1 +LOOP}  prints @code{0}
+@code{-1 0 ?DO  i .  -1 S+LOOP}  prints @code{0}
 
-@code{ 0 0 ?DO  i .  -1 +LOOP}  prints nothing
+@code{ 0 0 ?DO  i .  -1 S+LOOP}  prints nothing
 
 The loop is terminated when the border between @var{limit@minus{}sgn(n)} and
 @var{limit} is crossed. However, @code{S+LOOP} is not part of the ANS
@@ -885,7 +885,7 @@ The standard does not allow using @code{cs-pick} and @code{cs-roll} on
 every @code{?DO} etc. there is exactly one @code{UNLOOP} on any path
 through the definition (@code{LOOP} etc. compile an @code{UNLOOP} on the
 fall-through path). Also, you have to ensure that all @code{LEAVE}s are
-resolved (by using one of the loop-ending words or @code{UNDO}).
+resolved (by using one of the loop-ending words or @code{DONE}).
 
 Another group of control structure words are
 
@@ -1038,7 +1038,8 @@ locals are initialized with values from the data or FP stack.
 Currently there is no way to define locals with user-defined data
 structures, but we are working on it.
 
-GNU Forth allows defining locals everywhere in a colon definition. This poses the following questions:
+GNU Forth allows defining locals everywhere in a colon definition. This
+poses the following questions:
 
 @menu
 * Where are locals visible by name?::  

primitives

@@ -911,7 +911,7 @@ w2 = (Cell)fopen(cstr(c_addr, u, 1), fileattr[ntype]);
 wior =  FILEEXIST(w2 == NULL);
 
 create-file	c_addr u ntype -- w2 wior	file	create_file
-Cell	fd;
+int	fd;
 fd = creat(cstr(c_addr, u, 1), 0644);
 if (fd > -1) {
 #ifdef __osf__
@@ -1102,10 +1102,10 @@ else
 
 represent		r c_addr u -- n f1 f2	float
 char *sig;
-Cell flag;
-Cell decpt;
+int flag;
+int decpt;
 sig=ecvt(r, u, &decpt, &flag);
-n=decpt;
+n=(Cell)(r==0 ? 1 : decpt);
 f1=FLAG(flag!=0);
 f2=FLAG(isdigit(sig[0])!=0);
 memmove(c_addr,sig,u);
@@ -1115,33 +1115,33 @@ memmove(c_addr,sig,u);
 Float r;
 char *number=cstr(c_addr, u, 1);
 char *endconv;
-while(isspace(number[u-1])) u--;
-switch(number[u-1])
+while(isspace(number[--u]) && u>0);
+switch(number[u])
 {
-	case 'd':
-	case 'D':
-	case 'e':
-	case 'E': u--; break;
-	default: break;
+   case 'd':
+   case 'D':
+   case 'e':
+   case 'E':  break;
+   default :  u++; break;
 }
 number[u]='\0';
 r=strtod(number,&endconv);
 if((flag=FLAG(!(Cell)*endconv)))
 {
-	IF_FTOS(fp[0] = FTOS);
-	fp += -1;
-	FTOS = r;
+   IF_FTOS(fp[0] = FTOS);
+   fp += -1;
+   FTOS = r;
 }
 else if(*endconv=='d' || *endconv=='D')
 {
-	*endconv='E';
-	r=strtod(number,&endconv);
-	if((flag=FLAG(!(Cell)*endconv)))
-	{
-		IF_FTOS(fp[0] = FTOS);
-		fp += -1;
-		FTOS = r;
-	}
+   *endconv='E';
+   r=strtod(number,&endconv);
+   if((flag=FLAG(!(Cell)*endconv)))
+     {
+	IF_FTOS(fp[0] = FTOS);
+	fp += -1;
+	FTOS = r;
+     }
 }
 
 fabs		r1 -- r2	float-ext
@@ -1217,24 +1217,39 @@ r2 = sqrt(r1);
 
 ftan		r1 -- r2	float-ext
 r2 = tan(r1);
+:
+ fsincos f/ ;
 
 fsinh		r1 -- r2	float-ext
 r2 = sinh(r1);
+:
+ fexpm1 fdup fdup 1. d>f f+ f/ f+ f2/ ;
 
 fcosh		r1 -- r2	float-ext
 r2 = cosh(r1);
+:
+ fexp fdup 1/f f+ f2/ ;
 
 ftanh		r1 -- r2	float-ext
 r2 = tanh(r1);
+:
+ f2* fexpm1 fdup 2. d>f f+ f/ ;
 
 fasinh		r1 -- r2	float-ext
 r2 = asinh(r1);
+:
+ fdup fdup f* 1. d>f f+ fsqrt f/ fatanh ;
 
 facosh		r1 -- r2	float-ext
 r2 = acosh(r1);
+:
+ fdup fdup f* 1. d>f f- fsqrt f+ fln ;
 
 fatanh		r1 -- r2	float-ext
 r2 = atanh(r1);
+:
+ fdup f0< >r fabs 1. d>f fover f- f/  f2* flnp1 f2/
+ r> IF  fnegate  THEN ;
 
 \ The following words access machine/OS/installation-dependent ANSI
 \   figForth internals