Mega-Patch; lots of changes

Makefile.in

@@ -31,8 +31,8 @@
 # ------------- gforth version
 
 VERSION_MAJOR=0
-VERSION_MINOR=3
-VERSION_RELEASE=1
+VERSION_MINOR=4
+VERSION_RELEASE=0
 VERSION	=$(VERSION_MAJOR).$(VERSION_MINOR).$(VERSION_RELEASE)
 DOSVERSION=$(VERSION_MAJOR)$(VERSION_MINOR)$(VERSION_RELEASE)
 
@@ -131,12 +131,30 @@ KERN_SRC = \
 	kernel/vars.fs \
 	kernel/accept.fs \
 	kernel/basics.fs \
-	kernel/interp.fs \
+	kernel/int.fs \
+	kernel/comp.fs \
 	kernel/io.fs \
 	kernel/license.fs \
 	kernel/nio.fs \
 	kernel/saccept.fs
 
+EC_SRC = \
+	asm/00-readme \
+	asm/bitmask.fs \
+	asm/numref.fs \
+	asm/basic.fs \
+	asm/generic.fs \
+	asm/target.fs \
+	ec/00-readme \
+	ec/crossdoc.fd \
+	ec/mirror.fs \
+	ec/mirrors.fs \
+	ec/shex.fs \
+	ec/builttag.fs \
+	ec/dotx.fs \
+	ec/mirrored.fs \
+	ec/nesting.fs
+
 GFORTH_FI_SRC = \
 	assert.fs \
 	blocked.fb \
@@ -171,7 +189,7 @@ GFORTH_FI_SRC = \
 	sieve.fs \
 	add.fs
 
-FORTH_SRC = $(KERN_SRC) $(GFORTH_FI_SRC) \
+FORTH_SRC = $(KERN_SRC) $(GFORTH_FI_SRC) $(EC_SRC) \
 	ans-report.fs ansi.fs answords.fs \
 	code.fs colorize.fs comp-i.fs \
 	doskey.fs ds2texi.fs \
@@ -213,7 +231,30 @@ ARCHS =	arch/generic/machine.h \
 	arch/misc/prim.fs \
 	arch/misc/sim.fs \
 	arch/misc/sokoban.fs \
-	arch/misc/tt.fs
+	arch/misc/tt.fs \
+	arch/6502/asm.fs \
+	arch/6502/prim.fs \
+	arch/6502/mach.fs \
+	arch/6502/zero.fs \
+	arch/6502/softuart.fs \
+	arch/6502/cold.fs \
+	arch/8086/asm.fs \
+	arch/8086/mach.fs \
+	arch/8086/mach.sh \
+	arch/8086/prim.fs \
+	arch/avr/asm.fs \
+	arch/c165/asm.fs \
+	arch/c165/mach.fs \
+	arch/c165/prim.fs \
+	arch/h8/asm.fs \
+	arch/shboom/asm.fs \
+	arch/shboom/compiler.fs \
+	arch/shboom/dis.fs \
+	arch/shboom/mach.fs \
+	arch/shboom/prim.fs \
+	arch/shboom/dis2.fs \
+	arch/shboom/sh.p \
+	arch/shboom/doers.fs
 
 SOURCES	= CVS compat Makefile.in engine/Makefile.in gforthmi \
 	configure.in configure config.sub config.guess \
@@ -445,7 +486,7 @@ check test:	gforth gforth.fi
 		$(FORTH) test/other.fs -e bye
 		$(FORTH) code.fs test/checkans.fs -e bye
 		@echo 'Expect no differences'
-		$(FORTH) -m 100000 prims2x.fs -e "s\" $(srcdir)/prim.b\"' output-c process-file bye"| diff -c - $(srcdir)/engine/prim.i
+		$(FORTHK) -m 100000 prims2x.fs -e "s\" $(srcdir)/prim.b\"' output-c process-file bye"| diff -c - $(srcdir)/engine/prim.i
 
 bench:		gforth gforth.fi
 		@echo 'Each benchmark takes about 30s on a 486-66 (gcc-2.6.3 -DFORCE_REG)'
@@ -556,10 +597,10 @@ kernel/prim.fs:	prim.b prims2x.fs kernel/prim0.fs
 		$(RM) $@-
 
 engine:		engine/prim_lab.i engine/prim.i engine/version.h FORCE
-		bash makein.bsh engine engine
+		$(MAKE) -C engine engine
 
 engine_ditc:	engine/prim_lab.i engine/prim.i engine/version.h FORCE
-		bash makein.bsh engine engine_ditc
+		$(MAKE) -C engine engine_ditc
 
 gforth:		engine
 		-$(CP) gforth gforth~
@@ -570,6 +611,14 @@ gforth-ditc:	engine_ditc
 		$(GCC) $(LDFLAGS) $(OBJECTS_DITC) $(OBJECTS0) $(LDLIBS) -o $@
 		@GFORTHDITC_EXE@
 
+# ------------- additional C primitives
+
+%.c:		%.pri prim2cl.fs
+		$(FORTHK) prim2cl.fs -e "file $< altogether bye" >$@
+
+%.so:		%.c
+		$(GCC) -shared $(CFLAGS) $< -o $@
+
 # -------------	Make Documentation
 
 #TAGS is a GNU standard target

arch/4stack/mach.fs

@@ -31,19 +31,33 @@
 
 true  Constant NIL  \ relocating
 
-false Constant has-files 
-false Constant has-OS
-false Constant has-prims
-false Constant has-floats
-false Constant has-locals
-false Constant has-dcomps
-false Constant has-hash
-false Constant has-xconds
-false Constant has-header
-false Constant ITC
-
 : prims-include  ." Include primitives" cr s" arch/4stack/prim.fs" included ;
 : asm-include    ." Include assembler" cr s" arch/4stack/asm.fs" included ;
 
 : >boot
     S" ' boot >body $800 ! here $804 !" evaluate ;
+
+>ENVIRON
+
+false Constant file		\ controls the presence of the
+				\ file access wordset
+false Constant OS		\ flag to indicate a operating system
+
+false Constant prims		\ true: primitives are c-code
+
+false Constant floating		\ floating point wordset is present
+
+false Constant glocals		\ gforth locals are present
+				\ will be loaded
+false Constant dcomps		\ double number comparisons
+
+false Constant hash		\ hashing primitives are loaded/present
+
+false Constant xconds		\ used together with glocals,
+				\ special conditionals supporting gforths'
+				\ local variables
+false Constant header		\ save a header information
+
+false Constant ec
+false Constant crlf
+false Constant ITC

arch/mips/machine.h

@@ -45,7 +45,7 @@
 #define FLUSH_ICACHE(addr,size) \
 			cacheflush((char *)(addr), (int)(size), BCACHE)
 
-#include "../../engine/32bit.h"
+#include "../../machine/32bit.h"
 
 #ifdef DIRECT_THREADED
 /* some definitions for composing opcodes */

arch/misc/asm.fs

@@ -8,7 +8,6 @@ also assembler also definitions forth
 $0 Constant PC		$1 Constant PC+2
 $2 Constant PC+4	$3 Constant PC+6
 
-$7 Constant *ACCU
 $8 Constant ACCU	$9 Constant SF
 $A Constant ZF		$C Constant CF
 
@@ -17,6 +16,7 @@ $A Constant ZF		$C Constant CF
 $0 Constant JMP		$1 Constant JS
 $2 Constant JZ		$4 Constant JC
 
+$7 Constant *ACCU
 ( $8 Constant ACCU )	$9 Constant SUB
 ( $A Constant SUBR )	$B Constant ADD
 $C Constant XOR		$D Constant OR

arch/misc/mach.fs

@@ -40,16 +40,24 @@ false Constant NIL  \ relocating
 
 >ENVIRON
 
-false Constant file
-false Constant OS
-false Constant prims
-false Constant floating
-false Constant glocals
-false Constant dcomps
-false Constant hash
-false Constant xconds
-false Constant header
-true  Constant ec
-true  Constant crlf
-true  Constant ITC
+false Constant file		\ controls the presence of the
+				\ file access wordset
+false Constant OS		\ flag to indicate a operating system
 
+false Constant prims		\ true: primitives are c-code
+
+false Constant floating		\ floating point wordset is present
+
+false Constant glocals		\ gforth locals are present
+				\ will be loaded
+false Constant dcomps		\ double number comparisons
+
+false Constant hash		\ hashing primitives are loaded/present
+
+false Constant xconds		\ used together with glocals,
+				\ special conditionals supporting gforths'
+				\ local variables
+false Constant header		\ save a header information
+
+true Constant ec
+false Constant crlf

arch/misc/tt.fs

@@ -12,7 +12,10 @@
 
 decimal
 
-: ms  0 ?DO ( $3000 0 DO LOOP ) LOOP ;
+variable loops/ms
+0 loops/ms !
+
+: ms  0 ?DO  loops/ms @ 0 ?DO LOOP LOOP ;
 : blank  bl fill ;
 
 Create pn-tab ," 000102030405060708091011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980"

engine/32bit.h

+/*
+  This is a generic file for 32-bit machines with IEEE FP arithmetic (no VMS).
+  It only supports indirect threading.
+
+  Copyright (C) 1995 Free Software Foundation, Inc.
+
+  This file is part of Gforth.
+
+  Gforth is free software; you can redistribute it and/or
+  modify it under the terms of the GNU General Public License
+  as published by the Free Software Foundation; either version 2
+  of the License, or (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*/
+
+/* define this if IEEE singles and doubles are available as C data types */
+#define IEEE_FP
+
+/* the IEEE types are used only for loading and storing */
+/* the IEEE double precision type */
+typedef double DFloat;
+/* the IEEE single precision type */
+typedef float SFloat;
+
+#ifndef USE_FTOS
+#ifndef USE_NO_FTOS
+/* keep top of FP stack in register. Since most processors have FP
+   registers and they are hardly used in gforth, this is usually a
+   good idea.  The 88100 has no separate FP regs, but many general
+   purpose regs, so it should be ok */
+#define USE_FTOS
+#endif
+#endif
+/* I don't do the same for the data stack (i.e. USE_TOS), since this
+   loses on processors with few registers. USE_TOS might be defined in
+   the processor-specific files */
+
+#ifdef DIRECT_THREADED
+/* If you want direct threading, write a .h file for your processor! */
+/* We could put some stuff here that causes a compile error, but then
+   we could not use this file in the other machine.h files */
+#endif
+

engine/Makefile.in

@@ -21,8 +21,8 @@
 # ------------- gforth version
 
 VERSION_MAJOR=0
-VERSION_MINOR=3
-VERSION_RELEASE=1
+VERSION_MINOR=4
+VERSION_RELEASE=0
 VERSION =$(VERSION_MAJOR).$(VERSION_MINOR).$(VERSION_RELEASE)
 DOSVERSION=$(VERSION_MAJOR)$(VERSION_MINOR)$(VERSION_RELEASE)
 
@@ -51,6 +51,24 @@ STRIP	= strip
 
 FORTHPATH = $(libdir)/gforth/site-forth$(PATHSEP)$(datadir)/gforth/site-forth$(PATHSEP)$(libdir)/gforth/$(VERSION)$(PATHSEP)$(datadir)/gforth/$(VERSION)$(PATHSEP).
 
+# ------------	Install Directorys
+
+VPATH = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+srcdir = @srcdir@
+bindir = $(exec_prefix)/bin
+#read-only architecture-independent files
+datadir = $(prefix)/share
+#read-only architecture-dependent non-ascii files
+libdir = $(prefix)/lib
+infodir = $(prefix)/info
+mandir = $(prefix)/man
+man1dir= $(mandir)/man1
+man1ext= .1
+#older emacses have their site-lisp in $(libdir)/emacs/
+emacssitelispdir=$(datadir)/emacs/site-lisp
+
 # ------------- Compiler Flags
 
 XCFLAGS	= @CFLAGS@

engine/cache.c

+/* cache flushing for the HP-PA architecture
+
+  Copyright (C) 1995 Free Software Foundation, Inc.
+
+  This file is part of Gforth.
+
+  Gforth is free software; you can redistribute it and/or
+  modify it under the terms of the GNU General Public License
+  as published by the Free Software Foundation; either version 2
+  of the License, or (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*/
+
+void cacheflush(void * address, int size, int linewidth)
+{
+  int i;
+
+  address=(void *)((int)address & (-linewidth));
+
+  for(i=1-linewidth; i<size; i+=linewidth)
+    asm volatile("fdc (%0)\n\t"
+		 "sync\n\t"
+		 "fic,m %1(%0)\n\t"
+		 "sync" : : "r" (address), "r" (linewidth) : "memory" );
+}

engine/config.h.in

+/* engine/config.h.in.  Generated automatically from configure.in by autoheader.  */
+
+/* Define if `sys_siglist' is declared by <signal.h>.  */
+#undef SYS_SIGLIST_DECLARED
+
+/* Define if your processor stores words with the most significant
+   byte first (like Motorola and SPARC, unlike Intel and VAX).  */
+#undef WORDS_BIGENDIAN
+
+/* Define if you want to force a direct threaded code implementation
+   (does not work on all machines */
+#ifndef DIRECT_THREADED
+#undef DIRECT_THREADED
+#endif
+
+/* Define if you want to force an indirect threaded code implementation */
+#ifndef INDIRECT_THREADED
+#undef INDIRECT_THREADED
+#endif
+
+/* Define if you want to use explicit register declarations for better
+   performance or for more convenient CODE words (does not work with
+   all GCC versions on all machines) */
+#ifndef FORCE_REG
+#undef FORCE_REG
+#endif
+
+/* an integer type that is as long as a pointer */
+#define CELL_TYPE long
+
+/* an integer type that is twice as long as a pointer */
+#define DOUBLE_CELL_TYPE none
+
+/* a path separator character */
+#define PATHSEP ':'
+
+/* define this if there is no working DOUBLE_CELL_TYPE on your machine */
+#undef BUGGY_LONG_LONG
+
+/* The number of bytes in a char *.  */
+#undef SIZEOF_CHAR_P
+
+/* The number of bytes in a int.  */
+#undef SIZEOF_INT
+
+/* The number of bytes in a long.  */
+#undef SIZEOF_LONG
+
+/* The number of bytes in a long long.  */
+#undef SIZEOF_LONG_LONG
+
+/* The number of bytes in a short.  */
+#undef SIZEOF_SHORT
+
+/* Define if you have the atanh function.  */
+#undef HAVE_ATANH
+
+/* Define if you have the dlopen function.  */
+#undef HAVE_DLOPEN
+
+/* Define if you have the ecvt function.  */
+#undef HAVE_ECVT
+
+/* Define if you have the expm1 function.  */
+#undef HAVE_EXPM1
+
+/* Define if you have the getpagesize function.  */
+#undef HAVE_GETPAGESIZE
+
+/* Define if you have the log1p function.  */
+#undef HAVE_LOG1P
+
+/* Define if you have the memmove function.  */
+#undef HAVE_MEMMOVE
+
+/* Define if you have the mmap function.  */
+#undef HAVE_MMAP
+
+/* Define if you have the pow10 function.  */
+#undef HAVE_POW10
+
+/* Define if you have the rint function.  */
+#undef HAVE_RINT
+
+/* Define if you have the strerror function.  */
+#undef HAVE_STRERROR
+
+/* Define if you have the strsignal function.  */
+#undef HAVE_STRSIGNAL
+
+/* Define if you have the strtoul function.  */
+#undef HAVE_STRTOUL
+
+/* Define if you have the sys_siglist function.  */
+#undef HAVE_SYS_SIGLIST
+
+/* Define if you have the sysconf function.  */
+#undef HAVE_SYSCONF
+
+/* Define if you have the <sys/mman.h> header file.  */
+#undef HAVE_SYS_MMAN_H
+
+/* Define if you have the dl library (-ldl).  */
+#undef HAVE_LIBDL
+
+/* Define if you have the kernel32 library (-lkernel32).  */
+#undef HAVE_LIBKERNEL32
+
+/* Define if you have the m library (-lm).  */
+#undef HAVE_LIBM
+/* Of course, sys_siglist is a variable, not a function */

engine/ecvt.c

 /* cheap ecvt replacement */
 
+#include <stdio.h>
 #include "config.h"
 #include <math.h>
 extern double floor(double);
@@ -12,6 +13,7 @@ char* ecvt(double x, int len, int* exp, int* sign)
 {
    int i, j;
    double z;
+   fprintf(stderr, "using own ecvt\n");
    
    if(len > (MAXCONV-1)) len = MAXCONV-1;
    
@@ -53,7 +55,7 @@ char* ecvt(double x, int len, int* exp, int* sign)
 		  scratch[j]='0';
 	       }
 	  }
-	if(j==0)
+	if(j<0)
 	  {
 	     scratch[0]='1';
 	     *exp += 1;
@@ -69,8 +71,8 @@ char* ecvt(double x, int len, int* exp, int* sign)
 int main(int argc, char ** argv)
 {
    int a, b;
-   char * conv=ecvt(PI*1e10,20,&a,&b);
+   char * conv=ecvt(9e0,20,&a,&b);
    
-   printf("ecvt Test: %f -> %s, %d, %d\n",PI,conv,a,b);
+   printf("ecvt Test: %f -> %s, %d, %d\n",9e0,conv,a,b);
 }
 #endif

engine/io.c

@@ -85,12 +85,15 @@
 #endif /* !_POSIX_VERSION */
 
 /* Posix systems use termios and the Posix signal functions. */
-#if defined (_POSIX_VERSION)
+#if defined (_POSIX_VERSION) || defined (NeXT)
 #  if !defined (TERMIOS_MISSING)
 #    undef NEW_TTY_DRIVER
 #    define TERMIOS_TTY_DRIVER
 #    include <termios.h>
 #  endif /* !TERMIOS_MISSING */
+#endif /* _POSIX_VERSION || NeXT */
+
+#if defined (_POSIX_VERSION)
 #  define HAVE_POSIX_SIGNALS
 #  if !defined (O_NDELAY)
 #    define O_NDELAY O_NONBLOCK	/* Posix-style non-blocking i/o */
@@ -107,7 +110,7 @@
    special character is disabled and to disable certain special
    characters.  Posix systems should set to 0, USG systems to -1. */
 #if !defined (NEW_TTY_DRIVER) && !defined (_POSIX_VDISABLE)
-#  if defined (_POSIX_VERSION)
+#  if defined (_POSIX_VERSION) || defined (NeXT)
 #    define _POSIX_VDISABLE 0
 #  else /* !_POSIX_VERSION */
 #    define _POSIX_VDISABLE -1
@@ -974,7 +977,7 @@ void install_signal_handlers (void)
     signal (sigs_to_ignore [i], SIG_IGN);
 */
   for (i = 0; i < DIM (sigs_to_throw); i++)
-    signal (sigs_to_throw [i], signal_throw);
+    signal (sigs_to_throw [i], die_on_signal ? graceful_exit : signal_throw);
   for (i = 0; i < DIM (sigs_to_quit); i++)
     signal (sigs_to_quit [i], graceful_exit);
 #ifdef SIGCONT

engine/io.h

@@ -33,8 +33,8 @@ extern jmp_buf throw_jmp_buf;
 #else
 unsigned char getkey(FILE *);
 long key_avail(FILE *);
-void prep_terminal();
-void deprep_terminal();
+void prep_terminal(void);
+void deprep_terminal(void);
 void get_winsize(void);
 
 #  define key()		getkey(stdin)

hash.fs

@@ -175,7 +175,7 @@ has? cross 0=
   base @ >r hex HashTable  Hashlen 0
   DO  cr  i 2 .r ." : " dup i cells +
       BEGIN  @ dup  WHILE
-             dup cell+ @ head>string type space  REPEAT  drop
+             dup cell+ @ name>string type space  REPEAT  drop
   LOOP  drop r> base ! ;
 
 \ \ this stuff is for evaluating the hash function

kernel/aliases.fs

+\ run-time routine headers
+
+\ Copyright (C) 1997 Free Software Foundation, Inc.
+
+\ This file is part of Gforth.
+
+\ Gforth is free software; you can redistribute it and/or
+\ modify it under the terms of the GNU General Public License
+\ as published by the Free Software Foundation; either version 2
+\ of the License, or (at your option) any later version.
+
+\ This program is distributed in the hope that it will be useful,
+\ but WITHOUT ANY WARRANTY; without even the implied warranty of
+\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+\ GNU General Public License for more details.
+
+\ You should have received a copy of the GNU General Public License
+\ along with this program; if not, write to the Free Software
+\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+-2 Alias: :docol
+-3 Alias: :docon
+-4 Alias: :dovar
+-5 Alias: :douser
+-6 Alias: :dodefer
+-7 Alias: :dofield
+-8 Alias: :dodoes
+-9 Alias: :doesjump
+-10 alias noop
+-11 alias lit
+-12 alias execute
+-13 alias perform
+
+has? glocals [IF]
+-14 alias branch-lp+!#
+
+[THEN]
+-15 alias branch
+-16 alias ?branch
+
+has? glocals [IF]
+-17 alias ?branch-lp+!#
+
+[THEN]
+
+has? xconds [IF]
+-18 alias ?dup-?branch
+-19 alias ?dup-0=-?branch
+
+[THEN]
+-20 alias (next)
+
+has? glocals [IF]
+-21 alias (next)-lp+!#
+
+[THEN]
+-22 alias (loop)
+
+has? glocals [IF]
+-23 alias (loop)-lp+!#
+
+[THEN]
+-24 alias (+loop)
+
+has? glocals [IF]
+-25 alias (+loop)-lp+!#
+
+[THEN]
+
+has? xconds [IF]
+-26 alias (-loop)
+
+has? glocals [IF]
+-27 alias (-loop)-lp+!#
+
+[THEN]
+-28 alias (s+loop)
+
+has? glocals [IF]
+-29 alias (s+loop)-lp+!#
+
+[THEN]
+
+[THEN]
+-30 alias unloop
+-31 alias (for)
+-32 alias (do)
+-33 alias (?do)
+
+has? xconds [IF]