Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
gforth
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Bernd Paysan
gforth
Commits
a7e8df65
Commit
a7e8df65
authored
Jan 24, 1995
by
pazsan
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
cross.fs: Corrected bug on le machines
Minor changes on other files
parent
38a3f081
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
59 additions
and
53 deletions
+59
-53
cross.fs
cross.fs
+11
-18
ecvt.c
ecvt.c
+4
-7
float.fs
float.fs
+1
-1
gforth.ds
gforth.ds
+6
-5
primitives
primitives
+37
-22
No files found.
cross.fs
View file @
a7e8df65
\
CROSS
.
FS
The
Cross
-
Compiler
06
oct92py
\
$
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
View file @
a7e8df65
...
...
@@ -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
View file @
a7e8df65
...
...
@@ -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
View file @
a7e8df65
...
...
@@ -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
View file @
a7e8df65
...
...
@@ -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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment