Skip to content

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

Reimplemented [IF] [ELSE] [THEN] etc. 

Corrected a bug concerning redefinitions in Kernal
Added config info for HP-PA
Added replacement for rint
parent ee102d63
Hide whitespace changes
Inline Side-by-side
Showing with 94 additions and 93 deletions
configure
View file @ c5cecdc5
......@@ -489,6 +489,7 @@ echo "$ac_t""$host" 1>&4
case "$host_cpu" in
hppa*)
mach_h=hppa
LIBOBJS="cache.o"
;;
sparc*)
mach_h=sparc
......@@ -539,7 +540,7 @@ else
ac_cv_cross=yes
else
cat > conftest.$ac_ext <<EOF
#line 543 "configure"
#line 544 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
......@@ -563,7 +564,7 @@ else
{ echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
else
cat > conftest.$ac_ext <<EOF
#line 567 "configure"
#line 568 "configure"
#include "confdefs.h"
main () {
/* Are we little or big endian? From Harbison&Steele. */
......@@ -678,7 +679,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="$LIBS -lm "
cat > conftest.$ac_ext <<EOF
#line 682 "configure"
#line 683 "configure"
#include "confdefs.h"
int main() { return 0; }
......@@ -718,7 +719,7 @@ else
ac_cv_func_memcmp=no
else
cat > conftest.$ac_ext <<EOF
#line 722 "configure"
#line 723 "configure"
#include "confdefs.h"
main()
......@@ -747,7 +748,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 751 "configure"
#line 752 "configure"
#include "confdefs.h"
#include <ctype.h> /* Arbitrary system header to define __stub macros. */
/* Override any gcc2 internal prototype to avoid an error. */
......@@ -792,7 +793,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 796 "configure"
#line 797 "configure"
#include "confdefs.h"
#include <ctype.h> /* Arbitrary system header to define __stub macros. */
/* Override any gcc2 internal prototype to avoid an error. */
......@@ -838,7 +839,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 842 "configure"
#line 843 "configure"
#include "confdefs.h"
#include <ctype.h> /* Arbitrary system header to define __stub macros. */
/* Override any gcc2 internal prototype to avoid an error. */
......@@ -887,7 +888,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 891 "configure"
#line 892 "configure"
#include "confdefs.h"
#include <ctype.h> /* Arbitrary system header to define __stub macros. */
/* Override any gcc2 internal prototype to avoid an error. */
......
configure.in
View file @ c5cecdc5
......@@ -26,6 +26,7 @@ AC_CANONICAL_HOST
case "$host_cpu" in
hppa*)
mach_h=hppa
LIBOBJS="cache.o"
;;
sparc*)
mach_h=sparc
......
cross.fs
View file @ c5cecdc5
\ CROSS.FS The Cross-Compiler 06oct92py
\ $Id: cross.fs,v 1.17 1994-11-29 16:22:37 pazsan Exp $
\ $Id: cross.fs,v 1.18 1994-12-15 12:35:12 pazsan Exp $
\ Idea and implementation: Bernd Paysan (py)
\ Copyright 1992-94 by the GNU Forth Development Group
......@@ -256,7 +256,7 @@ VARIABLE Already
BEGIN @ dup
WHILE 2dup cell+ @ =
UNTIL
nip 2 cells + count cr ." CROSS: Exists: " type 4 spaces
2 cells + count cr ." CROSS: Exists: " type 4 spaces drop
swap cell+ !
ELSE true ABORT" CROSS: Ghostnames inconsistent"
THEN ;
......@@ -312,7 +312,7 @@ VARIABLE ^imm
>TARGET
: immediate 20 flag!
^imm @ @ dup <imm> = ?EXIT
^imm @ @ dup <imm> = IF drop EXIT THEN
<res> <> ABORT" CROSS: Cannot immediate a unresolved word"
<imm> ^imm @ ! ;
: restrict 40 flag! ;
......@@ -322,7 +322,7 @@ VARIABLE ^imm
: ALIAS2 create here 0 , DOES> @ execute ;
\ usage:
\ ' alias2 bla !
\ ' <name> alias2 bla !
\ Target Header Creation 01nov92py
......@@ -337,10 +337,10 @@ VARIABLE CreateFlag CreateFlag off
tlast @ dup 0> IF T 1 cells - THEN A, H there tlast !
>in @ name, >in ! T here H tlastcfa !
CreateFlag @ IF
>in @ alias2 swap >in ! \ create alias in target
>in @ ghost swap >in !
swap also ghosts ' previous swap ! \ tick ghost and store in alias
CreateFlag off
>in @ alias2 swap >in ! \ create alias in target
>in @ ghost swap >in !
swap also ghosts ' previous swap ! \ tick ghost and store in alias
CreateFlag off
ELSE ghost THEN
dup >magic ^imm ! \ a pointer for immediate
Already @ IF dup >end tdoes !
......
engine.c
View file @ c5cecdc5
......@@ -122,6 +122,9 @@ char *cstr(Char *from, UCell size, int clear)
#define NEWLINE '\n'
#ifndef HAVE_RINT
#define rint(x) floor((x)+0.5)
#endif
static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
......
toolsext.fs
View file @ c5cecdc5
\ TOOLSEXT.FS [IF] [ELSE] [THEN] and more 20may93jaw
\ This here is fully ans compatible
\ May be cross-compiled
\ ( \ added 09jun93jaw
\ very close to dpANS5
decimal
CREATE Opennest 7 chars allot
CREATE Closenest 7 chars allot
: SKIPNEST
1 BEGIN
BEGIN name dup WHILE
2dup Opennest count compare 0=
IF 2drop 1+
ELSE Closenest count compare 0= IF 1- THEN
THEN
?dup 0= IF EXIT THEN
REPEAT
2drop refill 0=
UNTIL drop ;
\ : ( s" (" Opennest place
\ s" )" Closenest place
\ SKIPNEST ; immediate
: comment? ( c-addr u -- c-addr u )
2dup s" (" compare 0=
IF postpone (
ELSE 2dup s" \" compare 0= IF postpone \ THEN
THEN ;
: [ELSE]
1 BEGIN
BEGIN name dup WHILE
comment?
2dup s" [IF]" compare 0=
IF 2drop 1+
ELSE 2dup s" [ELSE]" compare 0=
IF 2drop 1- dup IF 1+ THEN
ELSE s" [THEN]" compare 0= IF 1- THEN
THEN
THEN
?dup 0= IF EXIT THEN
REPEAT
2drop refill 0=
UNTIL drop ; immediate
: [THEN] ( -- ) ; immediate
: [IF] ( flag -- )
0= IF postpone [ELSE] THEN ; immediate
\ [IFUNDEF] [IFDEF] 9may93jaw
: [IFUNDEF]
bl word find nip 0= postpone [IF] ; immediate
: [IFDEF]
bl word find nip 0<> postpone [IF] ; immediate
\ [IF]? 9jun93jaw
\ same as comment? but skips [IF] .... [THEN]
: [if]? ( c-addr u -- c-addr u )
2dup s" [IF]" compare 0= >r
2dup s" [ELSE]" compare 0= >r
2dup s" [IFUNDEF]" compare 0= >r
2dup s" [IFDEF]" compare 0= r> or r> or r> or
IF s" [IF]" Opennest place
s" [THEN]" Closenest place
SKIPNEST THEN ;
\ Interpretative Structuren 16feb92py
Variable countif
: dummy ; immediate
: >exec >r ; restrict ( :-)
: scanIF f83find dup 0= IF drop ['] dummy >name THEN ;
Create [struct]-search ' scanIF A, ' (reveal) A, ' drop A,
Create [struct]-voc NIL A, G [struct]-search T A,
NIL A, NIL A,
: ?if countif @ 0<
IF [ [struct]-voc 3 cells + ] ALiteral @ lookup ! THEN ;
UNLOCK Tlast @ NIL Tlast ! LOCK
: [IF] 1 countif +! ?if ; immediate
: [THEN] -1 countif +! ?if ; immediate
: [ELSE] postpone [THEN] r> >exec postpone [IF] ;
immediate
' [IF] Alias [IFDEF] immediate
' [IF] Alias [IFUNDEF] immediate
' [IF] Alias [BEGIN] immediate
' [IF] Alias [WHILE] immediate
' [THEN] Alias [UNTIL] immediate
' [THEN] Alias [AGAIN] immediate
' [IF] Alias [DO] immediate
' [IF] Alias [?DO] immediate
' [THEN] Alias [LOOP] immediate
' [THEN] Alias [+LOOP] immediate
: [REPEAT] postpone [AGAIN] postpone [THEN] ;
immediate
' ( Alias ( immediate
' \ Alias \ immediate
UNLOCK Tlast @ swap Tlast ! LOCK
1 cells - G [struct]-voc T !
\ Interpretative Structuren 30apr92py
: defined bl word find nip 0<> ; immediate
: [IF] 0= IF countif off
lookup @ [ [struct]-voc 3 cells + ] ALiteral !
[struct]-voc lookup !
THEN ; immediate
: [IFDEF] postpone defined postpone [IF] ; immediate
: [IFUNDEF] postpone defined 0= postpone [IF] ; immediate
: [ELSE] 0 postpone [IF] ; immediate
: [THEN] ; immediate
\ Structs for interpreter 28nov92py
User (i)
: [DO] ( start end -- ) >in @ -rot
DO I (i) ! dup >r >in ! interpret r> swap +LOOP drop ;
immediate
: [?DO] 2dup = IF 2drop postpone [ELSE] ELSE postpone [DO] THEN ;
immediate
: [+LOOP] ( n -- ) rdrop rdrop ; immediate
: [LOOP] ( -- ) 1 rdrop rdrop ; immediate
: [FOR] ( n -- ) 0 swap postpone [DO] ; immediate
: [NEXT] ( n -- ) -1 rdrop rdrop ; immediate
: [I] ( -- index ) (I) @ postpone Literal ; immediate
: [BEGIN] >in @ >r BEGIN r@ >in ! interpret UNTIL rdrop ;
immediate
' [+LOOP] Alias [UNTIL] immediate
: [REPEAT] ( -- ) false rdrop rdrop ; immediate
' [REPEAT] Alias [AGAIN] immediate
: [WHILE] ( flag -- )
0= IF postpone [ELSE] true rdrop rdrop 1 countif +! THEN ;
immediate
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