Commit b966b024 authored by Bernd Paysan's avatar Bernd Paysan
Browse files

float.fs: Added f~ (f-proximate) 

wordsets.fs: Added missing float words
Added 16 bit and 64 bit support in cross.fs
Fixed some bugs which asume sizeof(int)=sizeof(Cell)
parent a713facd

Makefile.in

+31 −2
Original line number Diff line number Diff line
@@ -49,13 +49,14 @@ FORTH_SRC = add.fs assert.fs ansi.fs blocks.fs bufio.fs checkans.fs \ 
	colorize.fs cross.fs debug.fs debugging.fs doskey.fs ds2texi.fs \

	dumpimage.fs environ.fs errore.fs etags.fs extend.fs filedump.fs \

	float.fs glocals.fs glosgen.fs gray.fs hash.fs history.fs \

	kernal.fs locals-test.fs look.fs mach32b.fs mach32l.fs main.fs \

	kernal.fs locals-test.fs look.fs main.fs \

 	mach16b.fs mach16l.fs mach32b.fs mach32l.fs mach64b.fs mach64l.fs \

	other.fs prims2x.fs random.fs search-order.fs see.fs sieve.fs \

	startup.fs struct.fs tools.fs toolsext.fs tt.fs vars.fs vt100.fs \

	vt100key.fs wordinfo.fs wordsets.fs



SOURCES	= Makefile.in configure.in configure config.sub  config.guess \

	INSTALL README ToDo BUGS model gforth.ds \

	INSTALL README ToDo BUGS model gforth.ds install-sh \

	primitives engine.c main.c io.c \

	m68k.h mips.h 386.h hppa.h cache.c sparc.h 32bit.h \

	getopt.c getopt1.c getopt.h \
@@ -136,6 +137,20 @@ gforth: $(OBJECTS) 
		$(GCC) $(LDFLAGS) $(OBJECTS) $(LDLIBS) -o $@

		@MAKE_EXE@



kernl16l.fi:	main.fs search-order.fs cross.fs aliases.fs vars.fs add.fs \

		errore.fs kernal.fs extend.fs tools.fs toolsext.fs \

		mach16l.fs $(FORTH_GEN)

		-$(CP) kernl16l.fi kernl16l.fi~

		$(FORTH) -e 's" mach16l.fs"' main.fs

		@LINK_KERNL16L@



kernl16b.fi:	main.fs search-order.fs cross.fs aliases.fs vars.fs add.fs \

		errore.fs kernal.fs extend.fs tools.fs toolsext.fs \

		mach16b.fs $(FORTH_GEN)

		-$(CP) kernl16b.fi kernl16b.fi~

		$(FORTH) -e 's" mach16b.fs"' main.fs

		@LINK_KERNL16B@



kernl32l.fi:	main.fs search-order.fs cross.fs aliases.fs vars.fs add.fs \

		errore.fs kernal.fs extend.fs tools.fs toolsext.fs \

		mach32l.fs $(FORTH_GEN)
@@ -150,6 +165,20 @@ kernl32b.fi: main.fs search-order.fs cross.fs aliases.fs vars.fs add.fs \ 
		$(FORTH) -e 's" mach32b.fs"' main.fs

		@LINK_KERNL32B@



kernl64l.fi:	main.fs search-order.fs cross.fs aliases.fs vars.fs add.fs \

		errore.fs kernal.fs extend.fs tools.fs toolsext.fs \

		mach64l.fs $(FORTH_GEN)

		-$(CP) kernl64l.fi kernl64l.fi~

		$(FORTH) -e 's" mach64l.fs"' main.fs

		@LINK_KERNL64L@



kernl64b.fi:	main.fs search-order.fs cross.fs aliases.fs vars.fs add.fs \

		errore.fs kernal.fs extend.fs tools.fs toolsext.fs \

		mach64b.fs $(FORTH_GEN)

		-$(CP) kernl64b.fi kernl64b.fi~

		$(FORTH) -e 's" mach64b.fs"' main.fs

		@LINK_KERNL64B@



engine.s:	engine.c primitives.i prim_labels.i machine.h $(INCLUDES)

		$(GCC) $(CFLAGS) $(ENGINE_FLAGS) -S engine.c

configure

+25 −10
Original line number Diff line number Diff line
@@ -490,6 +490,8 @@ case "$host_cpu" in 
	hppa*)

		mach_h=hppa

		LIBOBJS="cache.o"

		LDFLAGS="-Xlinker -N"

		LIBS="-L/lib/pa1.1/ $LIBS"

		;;

	sparc*)

		mach_h=sparc
@@ -504,6 +506,7 @@ case "$host_cpu" in 
		;;

	mips*)

		mach_h=mips

		LDFLAGS="-Xlinker -N"

		#!! link text and data segment into the same 256M region!

		#!! does cacheflush work on OSs other than Ultrix?

		;;
@@ -520,10 +523,18 @@ esac 
MAKE_EXE=""





LINK_KERNL16L=""



LINK_KERNL16B=""



LINK_KERNL32L=""



LINK_KERNL32B=""



LINK_KERNL64L=""



LINK_KERNL64B=""



#if test $host_os=dos

#then

#  echo Configuring for DOS!!!
@@ -540,7 +551,7 @@ else 
  ac_cv_cross=yes

else

cat > conftest.$ac_ext <<EOF

#line 544 "configure"

#line 555 "configure"

#include "confdefs.h"

main(){return(0);}

EOF
@@ -564,7 +575,7 @@ else 
    { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }

else

cat > conftest.$ac_ext <<EOF

#line 568 "configure"

#line 579 "configure"

#include "confdefs.h"

main () {

  /* Are we little or big endian?  From Harbison&Steele.  */
@@ -597,10 +608,10 @@ fi 


if test $ac_cv_c_bigendian = yes; then

  bytesex=b

  KERNAL="kernl32b.fi kernl32l.fi"

  KERNAL="kernl16b.fi kernl16l.fi kernl32b.fi kernl32l.fi kernl64b.fi kernl64l.fi"

else

  bytesex=l

  KERNAL="kernl32l.fi kernl32b.fi"

  KERNAL="kernl16l.fi kernl16b.fi kernl32l.fi kernl32b.fi kernl64l.fi kernl64b.fi"

fi



echo $ac_n "checking whether ln -s works""... $ac_c" 1>&4
@@ -682,7 +693,7 @@ else 
  ac_save_LIBS="$LIBS"

LIBS="$LIBS -lm "

cat > conftest.$ac_ext <<EOF

#line 686 "configure"

#line 697 "configure"

#include "confdefs.h"



int main() { return 0; }
@@ -722,7 +733,7 @@ else 
  ac_cv_func_memcmp=no

else

cat > conftest.$ac_ext <<EOF

#line 726 "configure"

#line 737 "configure"

#include "confdefs.h"



main()
@@ -751,7 +762,7 @@ if eval "test \"`echo '${'ac_cv_func_$ac_func'+set}'`\" = set"; then 
  echo $ac_n "(cached) $ac_c" 1>&4

else

  cat > conftest.$ac_ext <<EOF

#line 755 "configure"

#line 766 "configure"

#include "confdefs.h"

#include <ctype.h> /* Arbitrary system header to define __stub macros. */

/* Override any gcc2 internal prototype to avoid an error.  */
@@ -796,7 +807,7 @@ if eval "test \"`echo '${'ac_cv_func_getopt_long'+set}'`\" = set"; then 
  echo $ac_n "(cached) $ac_c" 1>&4

else

  cat > conftest.$ac_ext <<EOF

#line 800 "configure"

#line 811 "configure"

#include "confdefs.h"

#include <ctype.h> /* Arbitrary system header to define __stub macros. */

/* Override any gcc2 internal prototype to avoid an error.  */
@@ -842,7 +853,7 @@ if eval "test \"`echo '${'ac_cv_func_$ac_func'+set}'`\" = set"; then 
  echo $ac_n "(cached) $ac_c" 1>&4

else

  cat > conftest.$ac_ext <<EOF

#line 846 "configure"

#line 857 "configure"

#include "confdefs.h"

#include <ctype.h> /* Arbitrary system header to define __stub macros. */

/* Override any gcc2 internal prototype to avoid an error.  */
@@ -891,7 +902,7 @@ if eval "test \"`echo '${'ac_cv_func_$ac_func'+set}'`\" = set"; then 
  echo $ac_n "(cached) $ac_c" 1>&4

else

  cat > conftest.$ac_ext <<EOF

#line 895 "configure"

#line 906 "configure"

#include "confdefs.h"

#include <ctype.h> /* Arbitrary system header to define __stub macros. */

/* Override any gcc2 internal prototype to avoid an error.  */
@@ -1047,8 +1058,12 @@ s%@host_cpu@%$host_cpu%g 
s%@host_vendor@%$host_vendor%g

s%@host_os@%$host_os%g

s%@MAKE_EXE@%$MAKE_EXE%g

s%@LINK_KERNL16L@%$LINK_KERNL16L%g

s%@LINK_KERNL16B@%$LINK_KERNL16B%g

s%@LINK_KERNL32L@%$LINK_KERNL32L%g

s%@LINK_KERNL32B@%$LINK_KERNL32B%g

s%@LINK_KERNL64L@%$LINK_KERNL64L%g

s%@LINK_KERNL64B@%$LINK_KERNL64B%g

s%@KERNAL@%$KERNAL%g

s%@LN_S@%$LN_S%g

s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g

configure.in

+13 −2
Original line number Diff line number Diff line
@@ -27,6 +27,8 @@ case "$host_cpu" in 
	hppa*)

		mach_h=hppa

		LIBOBJS="cache.o"

		LDFLAGS="-Xlinker -N"

		LIBS="-L/lib/pa1.1/"

		;;

	sparc*)

		mach_h=sparc
@@ -41,6 +43,7 @@ case "$host_cpu" in 
		;;

	mips*)

		mach_h=mips

		LDFLAGS="-Xlinker -N"

		#!! link text and data segment into the same 256M region!

		#!! does cacheflush work on OSs other than Ultrix?

		;;
@@ -58,10 +61,18 @@ AC_SUBST(MAKE_EXE) 
MAKE_EXE=""



dnl copy commands for systems that don't have links

AC_SUBST(LINK_KERNL16L)

LINK_KERNL16L=""

AC_SUBST(LINK_KERNL16B)

LINK_KERNL16B=""

AC_SUBST(LINK_KERNL32L)

LINK_KERNL32L=""

AC_SUBST(LINK_KERNL32B)

LINK_KERNL32B=""

AC_SUBST(LINK_KERNL64L)

LINK_KERNL64L=""

AC_SUBST(LINK_KERNL64B)

LINK_KERNL64B=""



#if test $host_os=dos

#then
@@ -76,10 +87,10 @@ AC_SUBST(KERNAL) 
dnl ac_cv_c_bigendian is an undocumented variable of autoconf-2.1

if test $ac_cv_c_bigendian = yes; then

  bytesex=b

  KERNAL="kernl32b.fi kernl32l.fi"

  KERNAL="kernl16b.fi kernl16l.fi kernl32b.fi kernl32l.fi kernl64b.fi kernl64l.fi"

else

  bytesex=l

  KERNAL="kernl32l.fi kernl32b.fi"

  KERNAL="kernl16l.fi kernl16b.fi kernl32l.fi kernl32b.fi kernl64l.fi kernl64b.fi"

fi



dnl Checks for programs.

cross.fs

+39 −15
Original line number Diff line number Diff line 
\ CROSS.FS     The Cross-Compiler                      06oct92py

\ $Id: cross.fs,v 1.18 1994-12-15 12:35:12 pazsan Exp $

\ $Id: cross.fs,v 1.19 1995-01-19 17:47:59 pazsan Exp $

\ Idea and implementation: Bernd Paysan (py)

\ Copyright 1992-94 by the GNU Forth Development Group
@@ -86,17 +86,28 @@ Variable tdp 


included



\ Create additional parameters                         19jan95py



T

cell               Constant tcell

cell<<             Constant tcell<<

cell>bit           Constant tcell>bit

bits/byte          Constant tbits/byte

float              Constant tfloat

1 bits/byte lshift Constant maxbyte

H



>TARGET



\ Byte ordering and cell size                          06oct92py



: cell+         cell + ;

: cells         cell<< lshift ;

: cell+         tcell + ;

: cells         tcell<< lshift ;

: chars         ;

: floats	float * ;

: floats	tfloat * ;

    

>CROSS

: cell/         cell<< rshift ;

: cell/         tcell<< rshift ;

>TARGET

20 CONSTANT bl

-1 Constant NIL
@@ -111,11 +122,23 @@ included 
>CROSS



bigendian  0 pad ! -1 pad c! pad @ 0<

= [IF]   : bswap ; immediate 

[ELSE]   : 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 ;

= [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 ;



[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 ;

[THEN]



\ Memory initialisation                                05dec92py
@@ -164,8 +187,8 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, 8 c, 4 c, 2 c, 1 c, 
>CROSS

: >image ( taddr -- absaddr )  image @ + ;

>TARGET

: @  ( taddr -- w )     >image @ bswap ;

: !  ( w taddr -- )     >r bswap r> >image ! ;

: @  ( taddr -- w )     >image t@ ;

: !  ( w taddr -- )     >image t! ;

: c@ ( taddr -- char )  >image c@ ;

: c! ( char taddr -- )  >image c! ;

: 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;
@@ -547,10 +570,10 @@ Variable tup 0 tup ! 
Variable tudp 0 tudp !

: u,  ( n -- udp )

  tup @ tudp @ + T  ! H

  tudp @ dup cell+ tudp ! ;

  tudp @ dup T cell+ H tudp ! ;

: au, ( n -- udp )

  tup @ tudp @ + T A! H

  tudp @ dup cell+ tudp ! ;

  tudp @ dup T cell+ H tudp ! ;

>TARGET



Build: T 0 u, , H ;
@@ -751,8 +774,9 @@ bigendian Constant bigendian 
: * * ;         : / / ;

: dup dup ;     : over over ;

: swap swap ;   : rot rot ;

: drop drop ;

: drop drop ;   : =   = ;

: lshift lshift ; : 2/ 2/ ;

: . . ;

cell constant cell



\ include bug5.fs

float.fs

+5 −0
Original line number Diff line number Diff line
@@ -103,5 +103,10 @@ 
\ : facosh   fdup fdup f* 1e0 f- fsqrt f+ fln ;

\ : fasinh   fdup fdup f* 1e0 f+ fsqrt f/ fatanh ;



: f~ ( f1 f2 f3 -- flag )  fdup f0= IF  fdrop f= EXIT  THEN

  fdup f0>   IF  frot frot f- fabs fswap

           ELSE  fnegate frot frot fover fabs fover fabs f+ frot frot

                 f- fabs frot frot f*  THEN  f< ;



: f.s  ." <" fdepth 0 .r ." > " fdepth 0 max maxdepth-.s @ min dup 0 

  ?DO  dup i - 1- floats fp@ + f@ f.  LOOP  drop ;