Commit 8e802cf8 authored by pazsan's avatar pazsan

C-based Gforth EC starts to work

parent 398094e7
This diff is collapsed.
......@@ -86,6 +86,8 @@ typedef void *Label;
#define HAS_FLOATING
#define HAS_OS
#define HAS_DEBUG
#define HAS_GLOCALS
#define HAS_HASH
#ifndef HAS_PEEPHOLE
#define HAS_PEEPHOLE
#endif
......@@ -95,10 +97,16 @@ typedef void *Label;
#undef HAS_FLOATING
#undef HAS_OS
#undef HAS_DEBUG
#undef HAS_GLOCALS
#undef HAS_HASH
#ifndef PUTC
# define PUTC(x) putc(x, stdout)
#endif
#ifndef TYPE
# define TYPE(x, l) fwrite(x, l, 1, stdout)
#endif
#endif
#define HAS_DCOMPS
#define HAS_GLOCALS
#define HAS_HASH
#define HAS_XCONDS
#define HAS_STANDARDTHREADING
......
......@@ -94,9 +94,19 @@ if test "$enable_ec" = "yes"; then
echo "defining standalone system"
AC_DEFINE(STANDALONE,,[Define if you want a Gforth without OS])
EC_MODE="true"
EC="-ec"
engine2=""
engine_fast2=""
no_dynamic="-DNO_DYNAMIC"
image_i="image.i"
else
echo "defining hosted system"
EC_MODE="false"
EC=""
engine2="engine2.o"
engine_fast2="engine-fast2.o"
no_dynamic=""
image_i=""
fi
#variables mentioned in INSTALL
......@@ -145,7 +155,12 @@ test "$GCC" = "yes" || AC_MSG_ERROR(Gforth uses GNU C extensions and requires GC
AC_SUBST(CC)
AC_SUBST(DEBUGFLAG)
AC_SUBST(EC)
AC_SUBST(EC_MODE)
AC_SUBST(engine2)
AC_SUBST(engine_fast2)
AC_SUBST(no_dynamic)
AC_SUBST(image_i)
#this is used to disable some (not generally essential) part of the
#Makefile that some makes don't grok. It would be better to test for
......@@ -719,7 +734,9 @@ AC_CHECK_FUNCS(mmap sysconf getpagesize)
AM_PATH_LISPDIR
kernel_fi=kernl${wordsize}${bytesex}.fi
include_fi=kernl${wordsize}${bytesex}${EC}.fi
AC_SUBST(kernel_fi)
AC_SUBST(include_fi)
#this breaks bindists
#dnl replace srource directory by absolute value
......
......@@ -1175,6 +1175,7 @@ false DefaultValue header
false DefaultValue backtrace
false DefaultValue new-input
false DefaultValue peephole
false DefaultValue primcentric
false DefaultValue abranch
true DefaultValue f83headerstring
true DefaultValue control-rack
......@@ -2625,7 +2626,7 @@ Cond: [ ( -- ) interpreting-state ;Cond
Defer instant-interpret-does>-hook ' noop IS instant-interpret-does>-hook
T has? peephole H [IF]
T has? primcentric H [IF]
: does-resolved ( ghost -- )
compile does-exec g>xt T a, H ;
[ELSE]
......@@ -2640,7 +2641,7 @@ T has? peephole H [IF]
>TARGET
Cond: DOES>
T here H [ T has? peephole H [IF] ] 5 [ [ELSE] ] 4 [ [THEN] ] T cells
T here H [ T has? primcentric H [IF] ] 5 [ [ELSE] ] 4 [ [THEN] ] T cells
H + alit, compile (does>2) compile ;s
doeshandler, resolve-does>-part
;Cond
......@@ -2960,7 +2961,7 @@ DO: abort" Not in cross mode" ;DO
\ optimizer for cross
T has? peephole H [IF]
T has? primcentric H [IF]
\ .( loading peephole optimization) cr
......
......@@ -27,8 +27,8 @@ EXE=@EXEEXT@
# ------------- System specific variables
machine=@machine@
kernel_fi=@kernel_fi@
include_fi=gforth.fi
kernel_fi = @kernel_fi@
include_fi = @include_fi@
# this is the type of machine
# used to extend the include path with ./arch/$machine
# so we could include a machine specific
......@@ -38,6 +38,8 @@ PATHSEP = @PATHSEP@
osclass = @OSCLASS@
EC = @EC@
# ------------- Utility programs
SHELL = /bin/sh
......@@ -79,6 +81,7 @@ CFLAGS = $(DEBUGFLAG) -I$(srcdir)/../arch/$(machine) -I. -Wall $(SWITCHES) -DDEF
CFLAGS2 = $(DEBUGFLAG) -I$(srcdir)/../arch/$(machine) -I. -Wall $(SWITCHES) -DDEFAULTPATH='"$(FORTHPATH)"'
FORTHKFLAGS= --die-on-signal -p "..$(PATHSEP)$(srcdir)" -i ../$(kernel_fi)
FORTHK = ../gforth $(FORTHKFLAGS)
FORTH = ../gforth --die-on-signal -p "..$(PATHSEP)$(srcdir)" -i ../gforth.fi
#John Wavrik should use -Xlinker -N to get a writable text (executable)
XLDFLAGS = @LDFLAGS@
......@@ -87,9 +90,9 @@ LDLIBS = @LIBS@
AOBJECTS = io.o signals.o support.o @LIBOBJS@
OBJECTS = engine.o engine2.o main.o
OBJECTS = engine.o @engine2@ main.o
OBJECTS_NATIVE = engine-native.o engine-native2.o engine-native3.o main-native.o
OBJECTS_FAST = engine-fast.o engine-fast2.o main-fast.o
OBJECTS_FAST = engine-fast.o @engine_fast2@ main-fast.o
OBJECTS_ITC = engine-itc.o main-itc.o
OBJECTS_DITC = engine-ditc.o main-ditc.o
OBJECTS_PROF = engine-prof.o main-prof.o
......@@ -98,7 +101,7 @@ OBJECTS_FI = engine.o main-fi.o
# In engine subdirectory there are (or should be) only files that belong to
# our engine, so we can make life easy
DEPS = config.h *.h $(srcdir)/../arch/$(machine)/*.[h]
ENGINE_DEPS = engine.c $(DEPS) prim_lab.i prim.i
ENGINE_DEPS = engine.c $(DEPS) prim_lab.i prim.i @image_i@
MAIN_DEPS = main.c $(DEPS) prim_superend.i prim_num.i prim_grp.i costs.i super2.i
ENGINE_FAST_DEPS = engine.c $(DEPS) prim_lab-fast.i prim-fast.i
MAIN_FAST_DEPS = main.c $(DEPS) prim_superend-fast.i prim_num-fast.i prim_grp-fast.i costs-fast.i super2-fast.i
......@@ -109,25 +112,25 @@ MAIN_FAST_DEPS = main.c $(DEPS) prim_superend-fast.i prim_num-fast.i prim_grp-fa
support.o: support.c config.h forth.h longlong.h
gforth$(EXE): $(OBJECTS) $(AOBJECTS)
gforth$(EC)$(EXE): $(OBJECTS) $(AOBJECTS)
$(GCC) $(LDFLAGS) $(OBJECTS) $(AOBJECTS) $(LDLIBS) -o $@
gforth-native$(EXE): $(OBJECTS_NATIVE) $(AOBJECTS)
gforth-native$(EC)$(EXE): $(OBJECTS_NATIVE) $(AOBJECTS)
$(GCC) $(LDFLAGS) $(OBJECTS_NATIVE) $(AOBJECTS) $(LDLIBS) -o $@
gforth-fast$(EXE): $(OBJECTS_FAST) $(AOBJECTS)
gforth-fast$(EC)$(EXE): $(OBJECTS_FAST) $(AOBJECTS)
$(GCC) $(LDFLAGS) $(OBJECTS_FAST) $(AOBJECTS) $(LDLIBS) -o $@
gforth-itc$(EXE): $(OBJECTS_ITC) $(AOBJECTS)
gforth-itc$(EC)$(EXE): $(OBJECTS_ITC) $(AOBJECTS)
$(GCC) $(LDFLAGS) $(OBJECTS_ITC) $(AOBJECTS) $(LDLIBS) -o $@
gforth-ditc$(EXE): $(OBJECTS_DITC) $(AOBJECTS)
gforth-ditc$(EC)$(EXE): $(OBJECTS_DITC) $(AOBJECTS)
$(GCC) $(LDFLAGS) $(OBJECTS_DITC) $(AOBJECTS) $(LDLIBS) -o $@
gforth-prof$(EXE): $(OBJECTS_PROF) $(AOBJECTS) profile.o
gforth-prof$(EC)$(EXE): $(OBJECTS_PROF) $(AOBJECTS) profile.o
$(GCC) $(LDFLAGS) $(OBJECTS_PROF) $(AOBJECTS) profile.o $(LDLIBS) -o $@
gforth-fi$(EXE): $(OBJECTS_FI) $(AOBJECTS)
gforth-fi$(EC)$(EXE): $(OBJECTS_FI) $(AOBJECTS)
$(GCC) $(LDFLAGS) $(OBJECTS_FI) $(AOBJECTS) $(LDLIBS) -o $@
engine.s: $(ENGINE_FAST_DEPS)
......@@ -164,7 +167,7 @@ engine-prof.o: $(ENGINE_DEPS)
$(GCC) $(CFLAGS2) $(ENGINE_FLAGS) -DVM_PROFILING -o $@ -c $(srcdir)/engine.c
main.o: $(MAIN_DEPS)
$(GCC) $(CFLAGS) -DGFORTH_DEBUGGING -o $@ -c $(srcdir)/main.c
$(GCC) $(CFLAGS) -DGFORTH_DEBUGGING @no_dynamic@ -o $@ -c $(srcdir)/main.c
main-native.o: $(MAIN_FAST_DEPS)
$(GCC) $(CFLAGS) -DNO_IP -o $@ -c $(srcdir)/main.c
......@@ -222,8 +225,8 @@ stamp-h: config.h.in ../config.status ../stamp-h.in
cd .. && CONFIG_FILES=$@ CONFIG_HEADERS=engine/config.h ./config.status
echo timestamp > stamp-h
image.c: ../fi2c.fs ../$(include_fi)
$(FORTHK) fi2c.fs -e "s\" ../$(include_fi)\" fi2c bye" >$@
image.i: ../fi2c.fs ../$(include_fi)
$(FORTH) fi2c.fs -e "s\" ../$(include_fi)\" fi2c bye" >$@
../$(include_fi): FORCE
cd .. && $(MAKE) $(include_fi)
......
......@@ -641,7 +641,7 @@ void alloc_stacks(ImageHeader * h)
h->return_stack_size=rsize;
h->locals_stack_size=lsize;
#if defined(HAVE_MMAP)
#if defined(HAVE_MMAP) && !defined(STANDALONE)
if (pagesize > 1) {
size_t p = pagesize;
size_t totalsize =
......@@ -1105,6 +1105,21 @@ static Address append_prim(Cell p)
}
#endif
#ifdef STANDALONE
Address gforth_alloc(Cell size)
{
Address r;
/* leave a little room (64B) for stack underflows */
if ((r = malloc(size+64))==NULL) {
perror(progname);
exit(1);
}
r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float)));
debugp(stderr, "malloc succeeds, address=$%lx\n", (long)r);
return r;
}
#endif
int forget_dyncode(Address code)
{
#ifdef NO_DYNAMIC
......@@ -1740,6 +1755,7 @@ void compile_prim1(Cell *start)
#endif /* !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED)) */
}
#ifndef STANDALONE
Address gforth_loader(FILE *imagefile, char* filename)
/* returns the address of the image proper (after the preamble) */
{
......@@ -1862,6 +1878,7 @@ Address gforth_loader(FILE *imagefile, char* filename)
return imp;
}
#endif
/* pointer to last '/' or '\' in file, 0 if there is none. */
static char *onlypath(char *filename)
......
......@@ -415,9 +415,11 @@ void install_signal_handlers(void)
sigstack.ss_flags=0;
sas_retval=sigaltstack(&sigstack,(stack_t *)0);
}
#ifdef HAS_FILE
if (debug)
fprintf(stderr,"sigaltstack: %s\n",strerror(sas_retval));
#endif
#endif
#define DIM(X) (sizeof (X) / sizeof *(X))
/*
......
......@@ -282,6 +282,7 @@ struct Cellpair parse_white(Char *c_addr1, UCell u1)
return result;
}
#ifdef HAS_FILE
Cell rename_file(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2)
{
char *s1=tilde_cstr(c_addr2, u2, 1);
......@@ -404,6 +405,7 @@ Cell to_float(Char *c_addr, UCell u, Float *rp)
*rp = r;
return flag;
}
#endif
Float v_star(Float *f_addr1, Cell nstride1, Float *f_addr2, Cell nstride2, UCell ucount)
{
......
......@@ -49,9 +49,15 @@ Variable env-current
t-env? dup IF drop THEN ;
' Value Alias DefaultValue
' Value Alias SetValue
: kb 1024 * ;
' noop alias T
' noop alias H
: has? parse-name 2drop true ;
include machpc.fs
ENVIRON>
......@@ -106,27 +112,6 @@ Variable au
THEN
dup 1 8 tcell @ * 1- lshift and negate or ;
1 cells 4 = [IF]
: bswap ( n -- n' ) bswap? @ 0= ?EXIT 0
over 24 rshift $FF and or
over 8 rshift $FF00 and or
over 8 lshift $FF0000 and or
over 24 lshift $FF000000 and or nip ;
[THEN]
1 cells 8 = [IF]
: bswap ( n -- n' ) bswap? @ 0= ?EXIT 0
over 56 rshift $FF and or
over 40 rshift $FF00 and or
over 24 rshift $FF0000 and or
over 8 rshift $FF000000 and or
over 8 lshift $FF00000000 and or
over 24 lshift $FF0000000000 and or
over 40 lshift $FF000000000000 and or
over 56 lshift $FF00000000000000 and or
nip ;
[THEN]
: search-magic ( fd -- ) >r
BEGIN magicbuf 8 r@ read-file throw 8 = WHILE
magicbuf s" Gforth3" tuck str= UNTIL
......@@ -214,7 +199,7 @@ Variable bitmap-chars
: fi2c ( addr u -- ) base @ >r hex
read-image
." static const void* image[" .imagesize ." ] = {" cr .image ." };" cr
." static void* image[" .imagesize ." ] = {" cr .image ." };" cr
." #ifdef USE_RELOC" cr
." const char reloc_bits[" .relocsize ." ] = {" cr .reloc ." };" cr
." #endif" cr
......
......@@ -65,6 +65,9 @@ Defer emit ( c -- ) \ core
Defer key ( -- char ) \ core
\G Receive (but do not display) one character, @var{char}.
: (key) ( -- c ) \ gforth
infile-id key-file ;
: infile-id stdin ;
[IFDEF] (key) ' (key) IS key [THEN]
......@@ -74,6 +77,9 @@ Defer key? ( -- flag ) \ facility key-question
\G yield the character. Once @code{key?} returns true, subsequent
\G calls to @code{key?} before calling @code{key} or @code{ekey} will
\G also return true.
: (key?) ( -- flag ) \ gforth
infile-id key?-file ;
: infile-id stdin ;
[IFDEF] (key?) ' (key?) IS key? [THEN]
......
......@@ -25,7 +25,7 @@ true DefaultValue NIL \ relocating
@EC_MODE@ DefaultValue ec
has? ec 0= [IF]
T has? ec H 0= [IF]
true DefaultValue file \ controls the presence of the
\ file access wordset
true DefaultValue OS \ flag to indicate a operating system
......@@ -57,6 +57,7 @@ true DefaultValue new-input \ enables object oriented input
@PEEPHOLEFLAG@ DefaultValue peephole \ enables peephole optimizer
true DefaultValue primcentric \ enables primcentric code
true DefaultValue abranch \ enables absolute branches
......@@ -76,11 +77,13 @@ false DefaultValue file \ controls the presence of the
\ file access wordset
false DefaultValue OS \ flag to indicate a operating system
@FFCALLFLAG@ DefaultValue ffcall \ Foreign Function Calls
true SetValue relocate
@LIBFFIFLAG@ DefaultValue libffi \ Foreign Function Calls
false DefaultValue ffcall \ Foreign Function Calls
@OLDCALLFLAG@ DefaultValue oldcall \ old Foreign Function Calls
false DefaultValue libffi \ Foreign Function Calls
false DefaultValue oldcall \ old Foreign Function Calls
true DefaultValue prims \ true: primitives are c-code
......@@ -101,7 +104,9 @@ false DefaultValue backtrace \ enables backtrace code
false DefaultValue new-input \ enables object oriented input
@PEEPHOLEFLAG@ DefaultValue peephole \ enables peephole optimizer
false DefaultValue peephole \ enables peephole optimizer
true DefaultValue primcentric \ enables primcentric code
true DefaultValue abranch \ enables absolute branches
......@@ -112,7 +117,7 @@ false DefaultValue crlf
true DefaultValue flash
$100 DefaultValue kernel-start
$0 DefaultValue kernel-start \ no artificial offset
cell 2 = [IF] &32 KB [ELSE] &64 KB [THEN] DefaultValue kernel-size
&1 KB DefaultValue stack-size
......
......@@ -1642,8 +1642,6 @@ f = key_query((FILE*)wfileid);
f = key_query(stdin);
#endif
\+os
stdin ( -- wfileid ) gforth
""The standard input file of the Gforth process.""
wfileid = (Cell)stdin;
......@@ -1656,6 +1654,8 @@ stderr ( -- wfileid ) gforth
""The standard error output file of the Gforth process.""
wfileid = (Cell)stderr;
\+os
form ( -- urows ucols ) gforth
""The number of lines and columns in the terminal. These numbers may change
with the window size.""
......
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