Commit a7e8df65 authored by pazsan's avatar pazsan

cross.fs: Corrected bug on le machines

Minor changes on other files
parent 38a3f081
\ 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
......
......@@ -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;
......
......@@ -86,7 +86,7 @@
1e0 fasin 2e0 f* fconstant pi
: f2* 2e0 f* ;
: f2/ 2e0 f/ ;
: f2/ .5e0 f* ;
: 1/f 1e0 fswap f/ ;
......
......@@ -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?::
......
......@@ -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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment