Skip to content

gforth
gforth
Commit d07d99ef authored by pazsan's avatar pazsan
Browse files
Options

Steps to make 0.2.0 dist-ready.

parent 50224434
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 909 additions and 71 deletions
Makefile.in
View file @ d07d99ef
......@@ -38,7 +38,7 @@ LN_S = @LN_S@
GCC = @CC@
CC = $(GCC)
FORTH = ./gforth
FORTHK = $(FORTH) -i ./kernal.fi
FORTHK = $(FORTH) -i ./kernel.fi
STRIP = strip
TEXI2DVI = texi2dvi
DVI2PS = dvips -D300
......@@ -74,7 +74,7 @@ man1ext= .1
#older emacses have their site-lisp in $(libdir)/emacs/
emacssitelispdir=$(datadir)/emacs/site-lisp
INCLUDES = forth.h threading.h io.h io-dos.h config.h
INCLUDES = forth.h threading.h io.h
KERN_SRC = \
add.fs \
......@@ -82,14 +82,13 @@ KERN_SRC = \
cross.fs \
errore.fs \
extend.fs \
kernal.fs \
kernel.fs \
main.fs \
search-order.fs \
special.fs \
tools.fs \
toolsext.fs \
vars.fs \
version.fs
vars.fs
GFORTH_FI_SRC = \
assert.fs \
......@@ -133,10 +132,11 @@ FORTH_SRC = $(KERN_SRC) $(GFORTH_FI_SRC) \
tt.fs sokoban.fs \
wordsets.fs \
tester.fs coretest.fs postponetest.fs dbltest.fs \
bubble.fs siev.fs matrix.fs fib.fs
bubble.fs siev.fs matrix.fs fib.fs \
oof.fs oofsampl.fs
SOURCES = CVS compat Makefile.in configure.in configure config.sub config.guess \
acconfig.h config.h.in \
acconfig.h config.h.in stamp-h.in \
install-sh INSTALL README ToDo BUGS model COPYING Benchres \
gforth.ds texinfo.tex gforth.1 gforth.el \
primitives engine.c main.c io.c memcasecmp.c \
......@@ -144,7 +144,7 @@ SOURCES = CVS compat Makefile.in configure.in configure config.sub config.guess
getopt.c getopt1.c getopt.h select.c \
ecvt.c memcmp.c strtol.c strtoul.c ansidecl.h memmove.c pow10.c \
strerror.c strsignal.c dblsub.c \
INSTALL.DOS makefile.dos mkdosmf.sed configure.bat \
INSTALL.DOS makefile.dos mkdosmf.sed configure.bat dosconf.h \
startup.dos history.dos \
glosgen.glo glossaries.doc \
$(INCLUDES) $(FORTH_SRC)
......@@ -157,9 +157,9 @@ OBJECTS = engine.o io.o main.o memcasecmp.o @LIBOBJS@ @getopt_long@
# things that need a working forth system to be generated
FORTH_GEN0 = primitives.b primitives.i prim_labels.i aliases.fs
FORTH_GEN = $(FORTH_GEN0) @KERNAL@ gforth.fi
FORTH_GEN = $(FORTH_GEN0) @KERNEL@ gforth.fi
# this is used for antidependences,
FORTH_GEN1 = $(FORTH_GEN0) @kernal_fi@
FORTH_GEN1 = $(FORTH_GEN0) @kernel_fi@
#distributed documentation
DOCDIST = gforth.texi gforth.fns gforth.ps gforth.info*
......@@ -206,7 +206,7 @@ clean: mostlyclean
-$(RM) -rf $(GEN) *.o
distclean: clean
-$(RM) machine.h kernal.fi config.cache config.log config.status config.h Makefile
-$(RM) machine.h kernel.fi config.cache config.log config.status config.h Makefile
#realclean is useless, but dangerous, so it's commented out
#realclean: distclean
......@@ -220,7 +220,7 @@ virtualclean: mostlyclean
dist: $(SOURCES) $(FORTH_GEN) $(DOCDIST)
-rm -rf gforth-$(VERSION)
mkdir gforth-$(VERSION)
$(CP) -rp $(SOURCES) $(FORTH_GEN0) @KERNAL@ $(DOCDIST) gforth-$(VERSION)
$(CP) -rp $(SOURCES) $(FORTH_GEN0) @KERNEL@ $(DOCDIST) gforth-$(VERSION)
tar cvf - gforth-$(VERSION)|gzip -9 >gforth-$(VERSION).tar.gz
-rm -rf gforth-$(VERSION)
......@@ -230,7 +230,7 @@ dist: $(SOURCES) $(FORTH_GEN) $(DOCDIST)
bindist: $(SOURCES) $(FORTH_GEN) gforth $(OBJECTS) config.status Makefile
-rm -rf gforth-$(VERSION)
mkdir gforth-$(VERSION)
$(CP) -rp -d $(SOURCES) config.status Makefile $(FORTH_GEN) gforth $(OBJECTS) machine.h kernal.fi gforth-$(VERSION)
$(CP) -rp -d $(SOURCES) config.status Makefile $(FORTH_GEN) gforth $(OBJECTS) machine.h kernel.fi gforth-$(VERSION)
strip gforth-$(VERSION)/gforth
tar cvf - gforth-$(VERSION)|gzip -9 >gforth-$(VERSION)-@host@.tar.gz
......@@ -244,7 +244,7 @@ bindist: $(SOURCES) $(FORTH_GEN) gforth $(OBJECTS) config.status Makefile
binonlydist: $(SOURCES) $(FORTH_GEN) gforth $(OBJECTS)
-rm -rf gforth-$(VERSION)
mkdir gforth-$(VERSION)
$(CP) -p -d config.status Makefile gforth $(OBJECTS) machine.h kernal.fi gforth-$(VERSION)
$(CP) -p -d config.status Makefile gforth $(OBJECTS) machine.h kernel.fi gforth-$(VERSION)
strip gforth-$(VERSION)/gforth
tar cvf - gforth-$(VERSION)|gzip -9 >gforth-$(VERSION)-binonly-@host@.tar.gz
......@@ -253,7 +253,7 @@ binonlydist: $(SOURCES) $(FORTH_GEN) gforth $(OBJECTS)
#strip gforth, because the debugging stuff is hardly useful once
# gforth manages to execute more than a few primitives
install: gforth $(FORTH_SRC) kernal.fi gforth.fi gforth.1 gforth.info* primitives gforth.TAGS
install: gforth $(FORTH_SRC) kernel.fi gforth.fi gforth.1 gforth.info* primitives gforth.TAGS
for i in $(bindir) $(mandir) $(infodir) $(libdir)/gforth/$(VERSION) $(datadir)/gforth/$(VERSION) $(libdir)/gforth/site-forth $(datadir)/gforth/site-forth; do \
$(INSTALL_DIR) $$i; \
done
......@@ -266,7 +266,7 @@ install: gforth $(FORTH_SRC) kernal.fi gforth.fi gforth.1 gforth.info* primitive
for i in $(FORTH_SRC) primitives; do \
$(INSTALL_DATA) $$i $(datadir)/gforth/$(VERSION); \
done
$(INSTALL_DATA) kernal.fi $(libdir)/gforth/$(VERSION)
$(INSTALL_DATA) kernel.fi $(libdir)/gforth/$(VERSION)
$(FORTHK) startup.fs dumpimage.fs -e "savesystem $(libdir)/gforth/$(VERSION)/gforth.fi bye" #gforth.fi contains some path names
sed s:$(srcdir)/:$(datadir)/gforth/$(VERSION)/: gforth.TAGS >TAGS; $(INSTALL_DATA) TAGS $(datadir)/gforth/$(VERSION)
if test -d $(emacssitelispdir); then \
......@@ -304,22 +304,22 @@ gforth: $(OBJECTS)
$(GCC) $(LDFLAGS) $(OBJECTS) $(LDLIBS) -o $@
@MAKE_EXE@
kernl16l.fi-: $(KERN_SRC) mach16l.fs $(FORTH_GEN0)
kernl16l.fi-: $(KERN_SRC) version.fs mach16l.fs $(FORTH_GEN0)
$(FORTHK) -p . -e 's" mach16l.fs"' main.fs -e "save-cross kernl16l.fi- $(bindir)/gforth-$(VERSION) bye"
kernl16b.fi-: $(KERN_SRC) mach16b.fs $(FORTH_GEN0)
kernl16b.fi-: $(KERN_SRC) version.fs mach16b.fs $(FORTH_GEN0)
$(FORTHK) -p . -e 's" mach16b.fs"' main.fs -e "save-cross kernl16b.fi- $(bindir)/gforth-$(VERSION) bye"
kernl32l.fi-: $(KERN_SRC) mach32l.fs $(FORTH_GEN0)
kernl32l.fi-: $(KERN_SRC) version.fs mach32l.fs $(FORTH_GEN0)
$(FORTHK) -p . -e 's" mach32l.fs"' main.fs -e "save-cross kernl32l.fi- $(bindir)/gforth-$(VERSION) bye"
kernl32b.fi-: $(KERN_SRC) mach32b.fs $(FORTH_GEN0)
kernl32b.fi-: $(KERN_SRC) version.fs mach32b.fs $(FORTH_GEN0)
$(FORTHK) -p . -e 's" mach32b.fs"' main.fs -e "save-cross kernl32b.fi- $(bindir)/gforth-$(VERSION) bye"
kernl64l.fi-: $(KERN_SRC) mach64l.fs $(FORTH_GEN0)
kernl64l.fi-: $(KERN_SRC) version.fs mach64l.fs $(FORTH_GEN0)
$(FORTHK) -p . -e 's" mach64l.fs"' main.fs -e "save-cross kernl64l.fi- $(bindir)/gforth-$(VERSION) bye"
kernl64b.fi-: $(KERN_SRC) mach64b.fs $(FORTH_GEN0)
kernl64b.fi-: $(KERN_SRC) version.fs mach64b.fs $(FORTH_GEN0)
$(FORTHK) -p . -e 's" mach64b.fs"' main.fs -e "save-cross kernl64b.fi- $(bindir)/gforth-$(VERSION) bye"
kernl16b.fi: $(KERNLS)
......@@ -352,20 +352,20 @@ kernl64l.fi: $(KERNLS)
-$(CP) kernl64l.fi- kernl64l.fi
@LINK_KERNL64L@
gforth.fi: @kernal_fi@ gforth $(GFORTH_FI_SRC)
gforth.fi: @kernel_fi@ gforth $(GFORTH_FI_SRC)
$(FORTHK) -p . startup.fs -e "savesystem gforth.fi bye"
gforth.TAGS: @kernal_fi@ gforth $(GFORTH_FI_SRC) primitives.TAGS
gforth.TAGS: @kernel_fi@ gforth $(GFORTH_FI_SRC) primitives.TAGS
$(FORTHK) -p . etags.fs startup.fs -e bye
cat TAGS primitives.TAGS kernal.TAGS >gforth.TAGS
cat TAGS primitives.TAGS kernel.TAGS >gforth.TAGS
engine.s: engine.c primitives.i prim_labels.i machine.h threading.h $(INCLUDES)
engine.s: engine.c primitives.i prim_labels.i machine.h threading.h $(INCLUDES) config.h
$(GCC) $(CFLAGS) $(ENGINE_FLAGS) -S engine.c
engine.o: engine.c primitives.i prim_labels.i machine.h threading.h $(INCLUDES)
engine.o: engine.c primitives.i prim_labels.i machine.h threading.h $(INCLUDES) config.h
$(GCC) $(CFLAGS) $(ENGINE_FLAGS) -c engine.c
main.o: main.c machine.h threading.h $(INCLUDES)
main.o: main.c machine.h threading.h $(INCLUDES) config.h
$(GCC) $(CFLAGS) $(ENGINE_FLAGS) -c main.c
strtoul.o: strtoul.c strtol.c
......@@ -394,7 +394,7 @@ doc.fd: makedoc.fs float.fs search-order.fs glocals.fs environ.fs \
doskey.fs vt100key.fs startup.fs assert.fs debugging.fs code.fs
$(FORTHK) -p . -e "s\" doc.fd\"" makedoc.fs startup.fs code.fs -e bye
crossdoc.fd: $(KERN_SRC) $(FORTH_GEN0)
crossdoc.fd: $(KERN_SRC) version.fs $(FORTH_GEN0)
$(FORTHK) -p . -e 's" mach32l.fs"' main.fs -e bye
gforth.texi: gforth.ds primitives.b ds2texi.fs prims2x.fs doc.fd crossdoc.fd
......
configure.bat
View file @ d07d99ef
......@@ -17,11 +17,29 @@ REM You should have received a copy of the GNU General Public License
REM along with this program; if not, write to the Free Software
REM Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
ECHO *** Configuring for MS-DOS with DJGPP GNU C ***
THREAD=d
FREGS=y
:SWITCHES
IF "%1"=="--enable-direct-threaded" THREAD=d
IF "%1"=="--enable-indirect-threaded" THREAD=i
IF "%1"=="--enable-force-reg" FREGS=y
shift
IF NOT "%1"=="" GOTO SWITCHES
COPY MAKEFILE.DOS MAKEFILE
COPY KERNL32L.FI KERNEL.FI
COPY 386.H MACHINE.H
COPY DOSCONF.H CONFIG.H
COPY STARTUP.FS STARTUP.UNX
COPY STARTUP.DOS STARTUP.FS
COPY HISTORY.DOS HISTORY.FS
COPY KERNL32L.FI KERNAL.FI
IF "%THREAD%"=="i" ECHO "#ifndef INDIRECT_THREADED" >>CONFIG.H
IF "%THREAD%"=="i" ECHO "#define INDIRECT_THREADED 1" >>CONFIG.H
IF "%THREAD%"=="i" ECHO "#endif" >>CONFIG.H
IF "%THREAD%"=="d" ECHO "#ifndef DIRECT_THREADED" >>CONFIG.H
IF "%THREAD%"=="d" ECHO "#define DIRECT_THREADED 1" >>CONFIG.H
IF "%THREAD%"=="d" ECHO "#endif" >>CONFIG.H
IF "%FREGS%"=="y" ECHO "#ifndef FORCE_REG" >>CONFIG.H
IF "%FREGS%"=="y" ECHO "#define FORCE_REG 1" >>CONFIG.H
IF "%FREGS%"=="y" ECHO "#endif" >>CONFIG.H
\ No newline at end of file
configure.in
View file @ d07d99ef
......@@ -81,20 +81,57 @@ case "$ac_cv_sizeof_char_p" in
;;
esac
AC_CHECK_INT_TYPE(sizeof(char *),cell,long)
AC_CHECK_SIZEOF(short)
AC_CHECK_SIZEOF(int)
AC_CHECK_SIZEOF(long)
AC_CHECK_SIZEOF(long long)
ac_cv_int_type_cell=none
case "$ac_cv_sizeof_char_p" in
$ac_cv_sizeof_short)
ac_cv_int_type_cell=short
;;
$ac_cv_sizeof_int)
ac_cv_int_type_cell=int
;;
$ac_cv_sizeof_long)
ac_cv_int_type_cell=long
;;
$ac_cv_sizeof_long_long)
ac_cv_int_type_cell="long long"
;;
esac
if test "$ac_cv_int_type_cell" != int; then
echo "So, sizeof(pointer)!=sizeof(int); looks like a DOS C compiler to me."
echo "Since you don't have a proper C on this machine, that's one more reason"
echo "to use Forth;-)"
fi
AC_CHECK_INT_TYPE(2*sizeof(char *),double cell,long long)
AC_DEFINE_UNQUOTED(CELL_TYPE,$ac_cv_int_type_cell)
ac_cv_int_type_double_cell=none
case `expr 2 '*' "$ac_cv_sizeof_char_p"` in
$ac_cv_sizeof_short)
ac_cv_int_type_double_cell=short
;;
$ac_cv_sizeof_int)
ac_cv_int_type_double_cell=int
;;
$ac_cv_sizeof_long)
ac_cv_int_type_double_cell=long
;;
$ac_cv_sizeof_long_long)
ac_cv_int_type_double_cell="long long"
;;
esac
if test "$ac_cv_int_type_double_cell" = none; then
echo "Emulating double-cell arithmetic. This may be slow."
echo "If you find this unacceptable, ask the GCC maintainers to provide proper"
echo 'long longs for your machine (the GCC manual states that they "are twice as'
echo "long as \`long int'\")."
echo 'long longs for your machine (the GCC manual states that they \"are twice as'
echo "long as \`long int\'\")."
LIBOBJS="$LIBOBJS dblsub.o"
AC_DEFINE(BUGGY_LONG_LONG)
else
AC_DEFINE_UNQUOTED(DOUBLE_CELL_TYPE,$ac_cv_int_type_double_cell)
fi
#terminology is a bit unusual here: The host is the system on which
......@@ -103,7 +140,7 @@ AC_CANONICAL_HOST
case "$host_cpu" in
hppa*)
mach_h=hppa
LIBOBJS="$LIBOBJS cache.o"
LIBOBJS="cache.o"
LDFLAGS="-Xlinker -N"
LIBS="-L/lib/pa1.1/"
;;
......@@ -157,19 +194,19 @@ LINK_KERNL64B=""
#then
# echo Configuring for DOS!!!
# MAKE_EXE="coff2exe gforth"
# LINK_KERNL32L='$(CP) kernl32l.fi kernal.fi'
# LINK_KERNL32L='$(CP) kernl32l.fi kernel.fi'
#fi
dnl the following macro produces a warning with autoconf-2.1
AC_C_BIGENDIAN
AC_SUBST(KERNAL)
AC_SUBST(KERNEL)
dnl ac_cv_c_bigendian is an undocumented variable of autoconf-2.1
if test $ac_cv_c_bigendian = yes; then
bytesex=b
KERNAL="kernl16b.fi kernl16l.fi kernl32b.fi kernl32l.fi kernl64b.fi kernl64l.fi"
KERNEL="kernl16b.fi kernl16l.fi kernl32b.fi kernl32l.fi kernl64b.fi kernl64l.fi"
else
bytesex=l
KERNAL="kernl16l.fi kernl16b.fi kernl32l.fi kernl32b.fi kernl64l.fi kernl64b.fi"
KERNEL="kernl16l.fi kernl16b.fi kernl32l.fi kernl32b.fi kernl64l.fi kernl64b.fi"
fi
dnl Checks for programs.
......@@ -191,9 +228,9 @@ AC_REPLACE_FUNCS(ecvt)
dnl No check for select, because our replacement is no good under
dnl anything but DOS
kernal_fi=kernl${wordsize}${bytesex}.fi
AC_SUBST(kernal_fi)
kernel_fi=kernl${wordsize}${bytesex}.fi
AC_SUBST(kernel_fi)
AC_LINK_FILES(${mach_h}.h $kernal_fi,machine.h kernal.fi)
AC_LINK_FILES(${mach_h}.h $kernel_fi,machine.h kernel.fi)
AC_OUTPUT(Makefile,echo timestamp > stamp-h)
cross.fs
View file @ d07d99ef
......@@ -173,7 +173,7 @@ bigendian
\ MakeKernal 12dec92py
>MINIMAL
: makekernal ( targetsize -- targetsize )
: makekernel ( targetsize -- targetsize )
bit$ over 1- cell>bit rshift 1+ initmem
image over initmem tdp off ;
......@@ -194,7 +194,7 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, 8 c, 4 c, 2 c, 1 c,
: align+ ( taddr -- rest )
cell tuck 1- and - [ cell 1- ] Literal and ;
: cfalign+ ( taddr -- rest )
\ see kernal.fs:cfaligned
\ see kernel.fs:cfaligned
float tuck 1- and - [ float 1- ] Literal and ;
>TARGET
......@@ -202,7 +202,7 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, 8 c, 4 c, 2 c, 1 c,
\ assumes cell alignment granularity (as GNU C)
: cfaligned ( taddr1 -- taddr2 )
\ see kernal.fs
\ see kernel.fs
dup cfalign+ + ;
>CROSS
......@@ -385,7 +385,7 @@ s" crossdoc.fd" r/w create-file throw value doc-file-id
source >in @ /string doc-file-id write-line throw
source >in ! drop ; immediate
Variable to-doc
Variable to-doc to-doc on
: cross-doc-entry ( -- )
to-doc @ tlast @ 0<> and \ not an anonymous (i.e. noname) header
......@@ -400,11 +400,11 @@ Variable to-doc
[char] \ parse 2drop
POSTPONE \g
>in !
THEN to-doc on ;
THEN ;
\ Target TAGS creation
s" kernal.TAGS" r/w create-file throw value tag-file-id
s" kernel.TAGS" r/w create-file throw value tag-file-id
\ contains the file-id of the tags file
Create tag-beg 2 c, 7F c, bl c,
......@@ -463,7 +463,6 @@ VARIABLE ;Resolve 1 cells allot
>TARGET
: Alias ( cfa -- ) \ name
dup 0< IF to-doc off THEN
(THeader over resolve T A, H 80 flag! ;
>CROSS
......@@ -936,7 +935,12 @@ only forth also minimal definitions
: hex hex ;
: tudp T tudp H ;
: tup T tup H ; minimal
: tup T tup H ;
: doc-off false T to-doc H ! ;
: doc-on true T to-doc H ! ;
minimal
\ for debugging...
: order order ;
......
filedump.fs
View file @ d07d99ef
#! /usr/local/lib/gforth/0.2.0/kernal.fi
#! /usr/local/lib/gforth/0.2.0/kernel.fi
\ file hex dump
Create buffer $10 allot
......
glocals.fs
View file @ d07d99ef
......@@ -381,7 +381,7 @@ forth definitions
\ If this assumption is too optimistic, the compiler will warn the user.
\ Implementation: migrated to kernal.fs
\ Implementation: migrated to kernel.fs
\ THEN (another control flow from before joins the current one):
\ The new locals-list is the intersection of the current locals-list and
......
io.c
View file @ d07d99ef
......@@ -45,6 +45,7 @@
#include "forth.h"
#include "io.h"
#ifndef MSDOS
#if defined (__GNUC__)
# define alloca __builtin_alloca
#else
......@@ -283,6 +284,11 @@ void prep_terminal ()
if (terminal_prepped)
return;
if (!isatty(tty)) { /* added by MdG */
terminal_prepped = 1; /* added by MdG */
return; /* added by MdG */
} /* added by MdG */
oldmask = sigblock (sigmask (SIGINT));
/* We always get the latest tty values. Maybe stty changed them. */
......@@ -389,6 +395,12 @@ void deprep_terminal ()
if (!terminal_prepped)
return;
/* Added by MdG */
if (!isatty(tty)) {
terminal_prepped = 0;
return;
}
oldmask = sigblock (sigmask (SIGINT));
the_ttybuff.sg_flags = original_tty_flags;
......@@ -443,6 +455,11 @@ void prep_terminal ()
if (terminal_prepped)
return;
if (!isatty(tty)) { /* added by MdG */
terminal_prepped = 1; /* added by MdG */
return; /* added by MdG */
} /* added by MdG */
/* Try to keep this function from being INTerrupted. We can do it
on POSIX and systems with BSD-like signal handling. */
#if defined (HAVE_POSIX_SIGNALS)
......@@ -547,6 +564,12 @@ void deprep_terminal ()
if (!terminal_prepped)
return;
/* Added by MdG */
if (!isatty(tty)) {
terminal_prepped = 0;
return;
}
#if defined (HAVE_POSIX_SIGNALS)
sigemptyset (&set);
sigemptyset (&oset);
......@@ -693,7 +716,7 @@ int main()
puts("");
}
#endif
#endif /* MSDOS */
/* signal handling adapted from pfe by Dirk Zoller (Copylefted) - anton */
......@@ -717,7 +740,9 @@ signal_throw(int sig)
} *p, throwtable[] = {
{ SIGINT, -28 },
{ SIGFPE, -55 },
#ifdef SIGBUS
{ SIGBUS, -23 },
#endif
{ SIGSEGV, -9 },
};
signal(sig,signal_throw);
......@@ -729,15 +754,22 @@ signal_throw(int sig)
longjmp(throw_jmp_buf,code); /* or use siglongjmp ? */
}
UCell cols=80;
#ifdef MSDOS
UCell rows=25;
#else
UCell rows=24;
#endif
#ifdef SIGCONT
static void termprep (int sig)
{
signal(sig,termprep);
terminal_prepped=0;
}
#endif
UCell rows=24;
UCell cols=80;
#ifdef SIGWINCH
void get_winsize()
{
#ifdef TIOCGWINSZ
......@@ -770,6 +802,7 @@ static void change_winsize(int sig)
get_winsize();
#endif
}
#endif
void install_signal_handlers (void)
{
......
io.h
View file @ d07d99ef
......@@ -26,24 +26,23 @@ extern jmp_buf throw_jmp_buf;
#ifdef MSDOS
# define prep_terminal()
# define deprep_terminal()
# define install_signal_handlers()
# include <conio.h>
# define key() getch()
# define key_query FLAG(kbhit())
# define key_query FLAG(kbhit())
#else
unsigned char getkey(FILE *);
long key_avail(FILE *);
void prep_terminal();
void deprep_terminal();
void install_signal_handlers(void);
void get_winsize(void);
extern int terminal_prepped;
extern UCell rows, cols;
# define key() getkey(stdin)
# define key_query -(!!key_avail(stdin)) /* !! FLAG(...)? - anton */
/* flag was originally wrong -- lennart */
#endif
void install_signal_handlers(void);
extern UCell rows, cols;
kernal.fs → kernel.fs
View file @ d07d99ef
\ KERNAL.FS GForth kernal 17dec92py
\ kernel.fs GForth kernel 17dec92py
\ Copyright (C) 1995 Free Software Foundation, Inc.
......@@ -1157,7 +1157,7 @@ defer ;-hook ( sys2 -- sys1 )
: :noname ( -- xt colon-sys ) \ core-ext colon-no-name
0 last !
here docol: cfa, 0 ] :-hook ;
cfalign here docol: cfa, 0 ] :-hook ;
\ Search list handling 23feb93py
......
main.fs
View file @ d07d99ef
......@@ -33,7 +33,7 @@ include cross.fs \ include cross-compiler
decimal
cell 2 = [IF] 32 [ELSE] 256 [THEN] KB makekernal ( size )
cell 2 = [IF] 32 [ELSE] 256 [THEN] KB makekernel ( size )
\ create image-header
0 A, \ base address
0 , \ checksum
......@@ -53,7 +53,9 @@ LOCK
0 AConstant forthstart
doc-off
include aliases.fs \ include primitive aliases
doc-on
\ include cond.fs \ conditional compile
\ include patches.fs \ include primitive patches
......@@ -61,7 +63,7 @@ include vars.fs \ variables and other stuff
include add.fs \ additional things
include errore.fs
include version.fs
include kernal.fs \ load kernal
include kernel.fs \ load kernel
include extend.fs \ load core-extended
include tools.fs \ load tools ( .s dump )
include toolsext.fs
......
mkdosmf.sed
View file @ d07d99ef
......@@ -6,9 +6,9 @@ s%-pipe %%g
s% ./gforth% gforth%g
s%io.o %%g
s%-DDEFAULTPATH=\\".*"%-DDEFAULTPATH=\\".\\"%g
s%@kernal_fi@%kernl32l.fi%g
s%@KERNAL@%kernl16l.fi kernl16b.fi kernl32l.fi kernl32b.fi kernl64l.fi kernl64b.fi%g
s%@LIBOBJS@%ecvt.o select.o strsignal.o%g
s%@kernel_fi@%kernl32l.fi%g
s%@KERNEL@%kernl16l.fi kernl16b.fi kernl32l.fi kernl32b.fi kernl64l.fi kernl64b.fi%g
s%@LIBOBJS@%ecvt.o io.o strsignal.o%g
s%@getopt_long@%getopt.o getopt1.o%g
s%@host@%dos%g
s%@CC@%gcc%g
......@@ -30,7 +30,7 @@ s%@srcdir@%%g
s%@LINK_KERNL16B@%%g
s%@LINK_KERNL16L@%%g
s%@LINK_KERNL32B@%%g
s%@LINK_KERNL32L@%-$(CP) kernl32l.fi kernal.fi%g
s%@LINK_KERNL32L@%-$(CP) kernl32l.fi kernel.fi%g
s%@LINK_KERNL64B@%%g
s%@LINK_KERNL64L@%%g
s%\": version-string s\\\" $(VERSION)\\\" ;\"%: version-string s\" $(VERSION)\" ;%g
......
oof.fs 0 → 100644
View file @ d07d99ef
This diff is collapsed.
oofsampl.fs 0 → 100644
View file @ d07d99ef
\ oof.fs Object Oriented FORTH
\ This file is (c) 1996 by Bernd Paysan
\ e-mail: paysan@informatik.tu-muenchen.de
\
\ Please copy and share this program, modify it for your system
\ and improve it as you like. But don't remove this notice.
\
\ Thank you.
\
\ Data structures: data 28nov93py
: place ( addr1 n addr2 -- )
over >r rot over 1+ r> move c! ;
: i! postpone ! ; immediate
: i@ postpone @ ; immediate
object class data \ abstract data class
cell var ref \ reference counter
method ! method @ method .
method null method atom? method #
how: : atom? ( -- flag ) true ;
: # ( -- n ) 0 ;
: null ( -- addr ) new ;
class;
\ Data structures: int 30apr93py
data class int
cell var value
how: : ! value i! ;
: @ value i@ ;
: . @ 0 .r ;
: init ( data -- ) ! ;
: dispose -1 ref +!
ref i@ 0> 0= IF super dispose THEN ;
: null 0 new ;
class;
\ Data structures: list 17nov93py
0 Value nil
data class lists
data ptr first data ptr next
method empty? method ?
how: : null nil ;
: atom? false ;
class;
lists class nil-class
how: : empty? true ;
: dispose ;
: . ." ()" ;
class;
nil-class : (nil (nil self TO nil
nil (nil bind first nil (nil bind next
\ Data structures: list 12mar94py
lists class linked
how: : empty? false ;
: # next # 1+ ;
: ? first . ;
: @ first @ ;
: ! first ! ;
: init ( first next -- )
dup >o 1 ref +! o> bind next
dup >o 1 ref +! o> bind first ;
: . self >o [char] (
BEGIN emit ? next atom? next self o> >o
IF ." . " data . o> ." )" EXIT THEN bl
empty? UNTIL o> drop ." )" ;
: dispose -1 ref +! ref i@ 0> 0=
IF first dispose next dispose super dispose THEN ;
class;
\ Data structures: string 04dec93py
int class string
how: : ! ( addr count -- )
value i@ over 1+ resize throw value i!
value i@ place ;
: @ ( -- addr count ) value i@ count ;
: . @ type ;
: init ( addr count -- )
dup 1+ allocate throw value i! value i@ place ;
: null S" " new ;
: dispose ref i@ 1- 0> 0=
IF value i@ free throw THEN super dispose ;
class;
\ Data sturctures: pointer 17nov93py
data class pointer
data ptr container
method ptr!
how: : ! container ! ;
: @ container @ ;
: . container . ;
: # container # ;
: init ( data -- ) dup >o 1 ref +! o> bind container ;
: ptr! ( data -- ) container dispose init ;
: dispose -1 ref +! ref i@ 0> 0=
IF container dispose super dispose THEN ;
: null nil new ;
class;
\ Data sturctures: array 30apr93py
data class array
data [] container
cell var range
how: : ! container ! ;
: @ container @ ;
: . [char] [
# 0 ?DO emit I container . [char] , LOOP drop ." ]" ;
: init ( data n -- ) range i! bind container ;
: dispose -1 ref +! ref i@ 0> 0=
IF # 0 ?DO I container dispose LOOP
super dispose THEN ;
: null nil 0 new ;
: # range i@ ;
: atom? false ;
class;
\ Data structure utilities 17nov93py
: cons linked new ;
: list nil cons ;
: car >o lists first self o> ;
: cdr >o lists next self o> ;
: print >o data . o> ;
: ddrop >o data dispose o> ;
: make-string string new ;
: $" state @ IF postpone S" postpone make-string exit THEN
[char] " parse make-string ; immediate