Commit 0c1b61d3 authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Merged in gforth-EC patches

parent 14fd3cd8

Makefile.in

+14 −52
Original line number Diff line number Diff line
@@ -167,7 +167,7 @@ GEN = gforth version.fs 
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_GEN0 = primitives.b primitives.i prim_labels.i aliases.fs primitives.fs

FORTH_GEN =  $(FORTH_GEN0) @KERNEL@ gforth.fi

# this is used for antidependences,

FORTH_GEN1 = $(FORTH_GEN0) @kernel_fi@
@@ -203,7 +203,7 @@ version.fs: version-stamp 
		$(MAKE) gforth

		echo ": version-string s\" $(VERSION)\" ;" >$@



more:	$(FORTH_GEN) gforth

more:	$(OBJECTS) $(FORTH_GEN) gforth



#from the gcc Makefile: 

#"Deletion of files made during compilation.
@@ -309,13 +309,14 @@ install: gforth $(FORTH_SRC) kernel.fi gforth.fi gforth.1 primitives gforth.TAGS 
		-$(RM) $(bindir)/gforth $(bindir)/gforth-$(VERSION)

		$(INSTALL_PROGRAM) -s gforth $(bindir)

		ln $(bindir)/gforth $(bindir)/gforth-$(VERSION)

		$(INSTALL_DATA) $(srcdir)/gforth.1 $(man1dir)

		for i in $(srcdir)/gforth.info*; do $(INSTALL_DATA) $$i $(infodir); done

		-$(INSTALL_DATA) $(srcdir)/gforth.1 $(man1dir)

		-for i in $(srcdir)/gforth.info*; do $(INSTALL_DATA) $$i $(infodir); done

		for i in $(FORTH_SRC) primitives; do \

			$(INSTALL_DATA) $(srcdir)/$$i $(datadir)/gforth/$(VERSION); \

		done

		$(INSTALL_DATA) kernel.fi $(libdir)/gforth/$(VERSION)

		$(RM) gforth.fi; $(MAKE) gforth.fi #gforth.fi contains some path names

		$(INSTALL_DATA) gforth.fi $(libdir)/gforth/$(VERSION)

		sed s:^$(srcdir)/:$(datadir)/gforth/$(VERSION)/: gforth.TAGS >TAGS; $(INSTALL_DATA) TAGS $(datadir)/gforth/$(VERSION)

		if test -d $(emacssitelispdir); then \

			$(INSTALL_DATA) $(srcdir)/gforth.el $(emacssitelispdir); \
@@ -356,53 +357,13 @@ gforth: $(OBJECTS) 
		$(GCC) $(LDFLAGS) $(OBJECTS) $(LDLIBS) -o $@

		@MAKE_EXE@



kernl16l.fi-:	$(KERN_SRC) version.fs mach16l.fs $(FORTH_GEN0)

		$(FORTHK) -e 's" mach16l.fs"' main.fs -e "save-cross kernl16l.fi- $(bindir)/gforth-$(VERSION) bye"

kernl%.fi-:	mach%.fs $(KERN_SRC) version.fs $(FORTH_GEN0)

		$(FORTHK) -e 's" $<"' main.fs -e "save-cross $@ $(bindir)/gforth-$(VERSION) bye"



kernl16b.fi-:	$(KERN_SRC) version.fs mach16b.fs $(FORTH_GEN0)

		$(FORTHK) -e 's" mach16b.fs"' main.fs -e "save-cross kernl16b.fi- $(bindir)/gforth-$(VERSION) bye"



kernl32l.fi-:	$(KERN_SRC) version.fs mach32l.fs $(FORTH_GEN0)

		$(FORTHK) -e 's" mach32l.fs"' main.fs -e "save-cross kernl32l.fi- $(bindir)/gforth-$(VERSION) bye"



kernl32b.fi-:	$(KERN_SRC) version.fs mach32b.fs $(FORTH_GEN0)

		$(FORTHK) -e 's" mach32b.fs"' main.fs -e "save-cross kernl32b.fi- $(bindir)/gforth-$(VERSION) bye"



kernl64l.fi-:	$(KERN_SRC) version.fs mach64l.fs $(FORTH_GEN0)

		$(FORTHK) -e 's" mach64l.fs"' main.fs -e "save-cross kernl64l.fi- $(bindir)/gforth-$(VERSION) bye"



kernl64b.fi-:	$(KERN_SRC) version.fs mach64b.fs $(FORTH_GEN0)

		$(FORTHK) -e 's" mach64b.fs"' main.fs -e "save-cross kernl64b.fi- $(bindir)/gforth-$(VERSION) bye"



kernl16b.fi:	$(KERNLS)

		-$(CP) kernl16b.fi kernl16b.fi~

		-$(CP) kernl16b.fi- kernl16b.fi

		@LINK_KERNL16B@



kernl16l.fi:	$(KERNLS)

		-$(CP) kernl16l.fi kernl16l.fi~

		-$(CP) kernl16l.fi- kernl16l.fi

		@LINK_KERNL16L@



kernl32b.fi:	$(KERNLS)

		-$(CP) kernl32b.fi kernl32b.fi~

		-$(CP) kernl32b.fi- kernl32b.fi

		@LINK_KERNL32B@



kernl32l.fi:	$(KERNLS)

		-$(CP) kernl32l.fi kernl32l.fi~

		-$(CP) kernl32l.fi- kernl32l.fi

		@LINK_KERNL32L@



kernl64b.fi:	$(KERNLS)

		-$(CP) kernl64b.fi kernl64b.fi~

		-$(CP) kernl64b.fi- kernl64b.fi

		@LINK_KERNL64B@



kernl64l.fi:	$(KERNLS)

		-$(CP) kernl64l.fi kernl64l.fi~

		-$(CP) kernl64l.fi- kernl64l.fi

		@LINK_KERNL64L@

kernl%.fi:	kernl%.fi- $(KERNLS)

		-$(CP) $@ $@~

		-$(CP) $< $@

		@LINK_KERNL@



gforth.fi:	@kernel_fi@ gforth $(GFORTH_FI_SRC)

		$(FORTHK) --clear-dictionary $(FORTHSIZES) startup.fs -e "savesystem gforth.fi1 bye"
@@ -442,8 +403,9 @@ aliases.fs: primitives.b prims2x.fs aliases0.fs 
		$(CP) aliases0.fs aliases.fs

		$(FORTHK) prims2x.fs -e "s\" primitives.b\" ' output-alias process-file bye" >>$@



primitives.fs:	primitives.b prims2x.fs

		$(FORTHK) prims2x.fs -e "s\" primitives.b\" ' output-forth process-file bye" >$@

primitives.fs:	primitives.b prims2x.fs aliases0.fs

		$(CP) aliases0.fs primitives.fs

		$(FORTHK) prims2x.fs -e "s\" primitives.b\" ' output-forth process-file bye" >>$@



primitives.TAGS: primitives.b prims2x.fs

		$(FORTHK) prims2x.fs -e "s\" $(srcdir)/primitives.b\" ' output-tag process-file bye" >$@

configure.in

+3 −13
Original line number Diff line number Diff line
@@ -187,24 +187,14 @@ AC_DEFINE_UNQUOTED(PATHSEP,'$PATHSEP') 
AC_SUBST(FORTHSIZES)



dnl copy commands for systems that don't have links

AC_SUBST(LINK_KERNL16L)

LINK_KERNL16L=""

AC_SUBST(LINK_KERNL16B)

LINK_KERNL16B=""

AC_SUBST(LINK_KERNL32L)

LINK_KERNL32L=""

AC_SUBST(LINK_KERNL32B)

LINK_KERNL32B=""

AC_SUBST(LINK_KERNL64L)

LINK_KERNL64L=""

AC_SUBST(LINK_KERNL64B)

LINK_KERNL64B=""

AC_SUBST(LINK_KERNL)

LINK_KERNL=""



#if test $host_os=dos

#then

#  echo Configuring for DOS!!!

#  MAKE_EXE="coff2exe gforth"

#  LINK_KERNL32L='$(CP) kernl32l.fi kernel.fi'

#  LINK_KERNL='$(CP) kernl32l.fi kernel.fi'

#fi



dnl the following macro produces a warning with autoconf-2.1

cross.fs

+133 −37
Original line number Diff line number Diff line
@@ -91,9 +91,20 @@ H 


>CROSS



\ Parameter for target systems                         06oct92py



mach-file count included



also Forth definitions



[IFDEF] asm-include asm-include [THEN]



previous



>CROSS



\ Variables                                            06oct92py



-1 Constant NIL

Variable image

Variable tlast    NIL tlast !  \ Last name field

Variable tlastcfa \ Last code field
@@ -102,10 +113,6 @@ Variable bit$ 
Variable tdp

: there  tdp @ ;



\ Parameter for target systems                         06oct92py



mach-file count included



\ Create additional parameters                         19jan95py



T
@@ -187,7 +194,7 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, 8 c, 4 c, 2 c, 1 c, 
    cell tuck 1- and - [ cell 1- ] Literal and ;

: cfalign+  ( taddr -- rest )

    \ see kernel.fs:cfaligned

    float tuck 1- and - [ float 1- ] Literal and ;

    /maxalign tuck 1- and - [ /maxalign 1- ] Literal and ;



>TARGET

: aligned ( taddr -- ta-addr )  dup align+ + ;
@@ -250,7 +257,9 @@ Variable atonce atonce off 


: GhostHeader <fwd> , 0 , ['] NoExec , ;



: >magic ; : >link cell+ ; : >exec cell+ cell+ ;

: >magic ;

: >link cell+ ;

: >exec cell+ cell+ ;

: >end 3 cells + ;



Variable last-ghost
@@ -424,11 +433,27 @@ Create tag-bof 1 c, 0C c, 
	base !

    THEN ;



\ Check for words



Defer skip? ' false IS skip?



: defined? ( -- flag ) \ name

    ghost >magic @ <fwd> <> ;



: needed? ( -- flag ) \ name

    ghost dup >magic @ <fwd> =

    IF  >link @ 0<>  ELSE  drop false  THEN ;



: skip-defs ( -- )

    BEGIN  refill  WHILE  source -trailing nip 0= UNTIL  THEN ;



\ Target header creation



VARIABLE CreateFlag CreateFlag off



: (Theader ( "name" -- ghost ) T align H view,

: (Theader ( "name" -- ghost )

\  >in @ bl word count type 2 spaces >in !

  T align H view,

  tlast @ dup 0> IF  T 1 cells - THEN  A, H  there tlast !

  >in @ name, >in ! T here H tlastcfa !

  CreateFlag @ IF
@@ -450,8 +475,18 @@ VARIABLE ;Resolve 1 cells allot 


>TARGET

: Alias    ( cfa -- ) \ name

    >in @ skip? IF  2drop  EXIT  THEN  >in !

    dup 0< has-prims 0= and

    IF

	." needs prim: " >in @ bl word count type >in ! cr

    THEN

    (THeader over resolve T A, H 80 flag! ;

: Alias:   ( cfa -- ) \ name

    >in @ skip? IF  2drop  EXIT  THEN  >in !

    dup 0< has-prims 0= and

    IF

	." needs doer: " >in @ bl word count type >in ! cr

    THEN

    ghost tuck swap resolve <do:> swap >magic ! ;

>CROSS
@@ -506,7 +541,26 @@ ghost :docol ghost :doesjump ghost :dodoes 2drop drop 


: dodoes, ( -- ) compile :doesjump T 0 , H ;



[IFUNDEF] (code) 

Defer (code)

Defer (end-code)

[THEN]



>TARGET

: Code

    (THeader there resolve

    there 2 T cells H + T a, 0 , H

    depth (code) ;



: Code:

    ghost dup there resolve  <do:> swap >magic !

    depth (code) ;



: end-code

    depth ?dup IF   1- <> ABORT" CROSS: Stack changed"

    ELSE true ABORT" CROSS: Stack empty" THEN

    (end-code) ;

               

: '  ( -- cfa ) bl word gfind 0= ABORT" CROSS: undefined "

  dup >magic @ <fwd> = ABORT" CROSS: forward " >link @ ;
@@ -529,6 +583,30 @@ Cond: ALiteral ( n -- ) restrict? alit, ;Cond 
: Char ( "<char>" -- )  bl word char+ c@ ;

Cond: [Char]   ( "<char>" -- )  restrict? Char  lit, ;Cond



\ some special literals					27jan97jaw



Cond: MAXU

 restrict? compile lit 

 tcell 0 ?DO FF T c, H LOOP ;Cond



Cond: MINI

 restrict? compile lit

 bigendian IF

 80 T c, H tcell 1 ?DO 0 T c, H LOOP 

 ELSE

 tcell 1 ?DO 0 T c, H LOOP 80 T c, H

 THEN

 ;Cond

 

Cond: MAXI

 restrict? compile lit

 bigendian IF

 7F T c, H tcell 1 ?DO FF T c, H LOOP 

 ELSE

 tcell 1 ?DO FF T c, H LOOP 7F T c, H

 THEN

 ;Cond



>CROSS

\ Target compiling loop                                12dec92py

\ ">tib trick thrown out                               10may93jaw
@@ -561,6 +639,7 @@ Cond: [Char] ( "<char>" -- ) restrict? Char lit, ;Cond 
\             is not allowed if a system should be ans conform



: : ( -- colon-sys ) \ Name

  >in @ skip? IF  drop skip-defs  EXIT  THEN  >in !

  (THeader ;Resolve ! there ;Resolve cell+ !

  docol, depth T ] H ;
@@ -840,14 +919,14 @@ also minimal 


\ define new [IFDEF] and [IFUNDEF]                      20may93jaw



: there? bl word gfind IF >magic @ <fwd> <> ELSE drop false THEN ;

: defined? defined? ;



: [IFDEF] there? postpone [IF] ;

: [IFUNDEF] there? 0= postpone [IF] ;

: [IFDEF] defined? postpone [IF] ;

: [IFUNDEF] defined? 0= postpone [IF] ;



\ C: \- \+ Conditional Compiling                         09jun93jaw



: C: >in @ there? 0=

: C: >in @ defined? 0=

     IF    >in ! T : H

     ELSE drop

        BEGIN bl word dup c@
@@ -859,8 +938,8 @@ also minimal 


also minimal



: \- there? IF postpone \ THEN ;

: \+ there? 0= IF postpone \ THEN ;

: \- defined? IF postpone \ THEN ;

: \+ defined? 0= IF postpone \ THEN ;



: [IF]   postpone [IF] ;

: [THEN] postpone [THEN] ;
@@ -889,6 +968,7 @@ char 1 bigendian + cell + magic 7 + c! 
: save-cross ( "image-name" "binary-name" -- )

  bl parse ." Saving to " 2dup type cr

  w/o bin create-file throw >r

  NIL IF

      s" #! "   r@ write-file throw

      bl parse  r@ write-file throw

      s"  -i"   r@ write-file throw
@@ -899,27 +979,43 @@ char 1 bigendian + cell + magic 7 + c! 
      loop

      drop

      magic 8       r@ write-file throw \ write magic

  ELSE

      bl parse 2drop

  THEN

  image @ there r@ write-file throw \ write image

  NIL IF

      bit$  @ there 1- cell>bit rshift 1+

                r@ write-file throw \ write tags

  THEN

  r> close-file throw ;



\ words that should be in minimal



: + + ;         : 1- 1- ;

: - - ;         : 2* 2* ;

: * * ;         : / / ;

: dup dup ;     : over over ;

: swap swap ;   : rot rot ;

: drop drop ;   : =   = ;

: lshift lshift ; : 2/ 2/ ;

: here there ;

also forth [IFDEF] Label : Label Label ; [THEN] previous

: + + ;

: or or ;

: 1- 1- ;

: - - ;

: 2* 2* ;

: * * ;

: / / ;

: dup dup ;

: over over ;

: swap swap ;

: rot rot ;

: drop drop ;

: =   = ;

: 0=   0= ;

: lshift lshift ;

: 2/ 2/ ;

: . . ;

\ cell constant cell



mach-file count included



\ include bug5.fs

\ only forth also minimal definitions

: all-words    ['] false    IS skip? ;

: needed-words ['] needed?  IS skip? ;

: undef-words  ['] defined? IS skip? ;



: \  postpone \ ;  immediate

: (  postpone ( ;  immediate

errore.fs

+2 −0
Original line number Diff line number Diff line
@@ -43,6 +43,7 @@ decimal 
	IF 2 cells + count type drop exit THEN

    REPEAT

    drop

[ has-os [IF] ]

    dup -511 -255 within

    IF

	256 + negate strsignal type exit
@@ -51,5 +52,6 @@ decimal 
    IF

	512 + negate strerror type exit

    THEN

[ [THEN] ]

    . ;

etags.fs

+2 −0
Original line number Diff line number Diff line
@@ -37,6 +37,8 @@ 
\ header, NAME>STRING must convert that pointer to a string, and

\ HEADER must be a deferred word that is called to create the name.



include extend.fs



: tags-file-name ( -- c-addr u )

    \ for now I use just TAGS; this may become more flexible in the

    \ future