Commit 9fbef218 authored by pazsan's avatar pazsan

C-based EC version runs now on OS hosted system.

parent a8368759
...@@ -21,7 +21,7 @@ dnl Process this file with autoconf to produce a configure script. ...@@ -21,7 +21,7 @@ dnl Process this file with autoconf to produce a configure script.
dnl We use some automake macros here, dnl We use some automake macros here,
dnl but don't use automake for creating Makefile.in dnl but don't use automake for creating Makefile.in
AC_INIT([gforth],[0.6.2-20060709],[https://savannah.gnu.org/bugs/?func=addbug&group=gforth]) AC_INIT([gforth],[0.6.9-20070401],[https://savannah.gnu.org/bugs/?func=addbug&group=gforth])
AC_PREREQ(2.54) AC_PREREQ(2.54)
#snapshots have numbers major.minor.release-YYYYMMDD #snapshots have numbers major.minor.release-YYYYMMDD
#note that lexicographic ordering must be heeded. #note that lexicographic ordering must be heeded.
......
...@@ -1244,6 +1244,9 @@ bits/byte Constant tbits/byte ...@@ -1244,6 +1244,9 @@ bits/byte Constant tbits/byte
H H
tbits/char bits/byte / Constant tbyte tbits/char bits/byte / Constant tbyte
: >signed ( u -- n )
1 tbits/char tcell * 1- lshift 2dup and
IF negate or ELSE drop THEN ;
\ Variables 06oct92py \ Variables 06oct92py
...@@ -2316,10 +2319,12 @@ Variable prim# ...@@ -2316,10 +2319,12 @@ Variable prim#
prim# @ (THeader ( S xt ghost ) prim# @ (THeader ( S xt ghost )
['] prim-resolved over >comp ! ['] prim-resolved over >comp !
dup >ghost-flags <primitive> set-flag dup >ghost-flags <primitive> set-flag
over resolve-noforwards T A, H
s" EC" T $has? H 0= s" EC" T $has? H 0=
IF IF
over resolve-noforwards T A, H
alias-mask flag! alias-mask flag!
ELSE
T here H resolve-noforwards T A, H
THEN THEN
-1 prim# +! ; -1 prim# +! ;
>CROSS >CROSS
...@@ -2975,10 +2980,17 @@ T has? primcentric H [IF] ...@@ -2975,10 +2980,17 @@ T has? primcentric H [IF]
: (callcm) T here 0 a, 0 a, H ; ' (callcm) plugin-of colonmark, : (callcm) T here 0 a, 0 a, H ; ' (callcm) plugin-of colonmark,
: (call-res) >tempdp resolved gexecute tempdp> drop ; : (call-res) >tempdp resolved gexecute tempdp> drop ;
' (call-res) plugin-of colon-resolve ' (call-res) plugin-of colon-resolve
T has? ec H [IF]
: (pprim) T @ H >signed dup 0< IF $4000 - ELSE
cr ." wrong usage of (prim) "
dup gdiscover IF .ghost ELSE . THEN cr -1 throw THEN
T a, H ; ' (pprim) plugin-of prim,
[ELSE]
: (pprim) dup 0< IF $4000 - ELSE : (pprim) dup 0< IF $4000 - ELSE
cr ." wrong usage of (prim) " cr ." wrong usage of (prim) "
dup gdiscover IF .ghost ELSE . THEN cr -1 throw THEN dup gdiscover IF .ghost ELSE . THEN cr -1 throw THEN
T a, H ; ' (pprim) plugin-of prim, T a, H ; ' (pprim) plugin-of prim,
[THEN]
\ if we want this, we have to spilt aconstant \ if we want this, we have to spilt aconstant
\ and constant!! \ and constant!!
...@@ -3002,7 +3014,7 @@ Builder Defer ...@@ -3002,7 +3014,7 @@ Builder Defer
compile: g>body compile lit-perform T A, H ;compile compile: g>body compile lit-perform T A, H ;compile
Builder (Field) Builder (Field)
compile: g>body T @ H compile lit+ T , H ;compile compile: g>body T @ H compile lit+ T here H reloff T , H ;compile
Builder interpret/compile: Builder interpret/compile:
compile: does-resolved ;compile compile: does-resolved ;compile
......
...@@ -236,7 +236,7 @@ extern int gforth_memcmp(const char * s1, const char * s2, size_t n); ...@@ -236,7 +236,7 @@ extern int gforth_memcmp(const char * s1, const char * s2, size_t n);
#ifdef GFORTH_DEBUGGING #ifdef GFORTH_DEBUGGING
#if DEBUG #if DEBUG
#define NAME(string) { saved_ip=ip; asmcomment(string); fprintf(stderr,"%08lx depth=%3ld: "string"\n",(Cell)ip,sp0+3-sp);} #define NAME(string) { saved_ip=ip; asmcomment(string); fprintf(stderr,"%08lx depth=%3ld tos=%016lx: "string"\n",(Cell)ip,sp0+3-sp,sp[0]);}
#else /* !DEBUG */ #else /* !DEBUG */
#define NAME(string) { saved_ip=ip; asm(""); } #define NAME(string) { saved_ip=ip; asm(""); }
/* the asm here is to avoid reordering of following stuff above the /* the asm here is to avoid reordering of following stuff above the
......
...@@ -209,10 +209,16 @@ goto *next_code; ...@@ -209,10 +209,16 @@ goto *next_code;
a_retaddr = next_code; a_retaddr = next_code;
a_body = PFA(CFA); a_body = PFA(CFA);
INST_TAIL; INST_TAIL;
#ifdef DEBUG
fprintf(stderr, "dodoes to %x, push %x\n", a_retaddr, a_body);
#endif
goto **(Label *)DOES_CODE1(CFA); goto **(Label *)DOES_CODE1(CFA);
#else /* !defined(NO_IP) */ #else /* !defined(NO_IP) */
a_retaddr = (Cell *)IP; a_retaddr = (Cell *)IP;
a_body = PFA(CFA); a_body = PFA(CFA);
#ifdef DEBUG
fprintf(stderr, "dodoes to %x, push %x\n", a_retaddr, a_body);
#endif
SET_IP(DOES_CODE1(CFA)); SET_IP(DOES_CODE1(CFA));
#endif /* !defined(NO_IP) */ #endif /* !defined(NO_IP) */
...@@ -751,6 +757,9 @@ n = n1+n2; ...@@ -751,6 +757,9 @@ n = n1+n2;
\ lit+ / lit_plus = lit + \ lit+ / lit_plus = lit +
lit+ ( n1 #n2 -- n ) new lit_plus lit+ ( n1 #n2 -- n ) new lit_plus
#ifdef DEBUG
fprintf(stderr, "lit+ %08x\n", n2);
#endif
n=n1+n2; n=n1+n2;
\ PFE-0.9.14 has it differently, but the next release will have it as follows \ PFE-0.9.14 has it differently, but the next release will have it as follows
......
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