Added compat/strcomp.fs, introducing STR=, STRING-PREFIX?, and STR< (56147e25) · Commits · Bernd Paysan / gforth

Makefile.in

+10 −6

Original line number	Diff line number	Diff line
		@@ -252,6 +252,7 @@ COMPAT = compat/README \
		compat/exception.fs \
		compat/loops.fs \
		compat/required.fs \
		compat/strcomp.fs \
		compat/struct.fs \
		compat/vocabulary.fs

		@@ -366,6 +367,9 @@ FORTH_GEN = $(FORTH_GEN0) @KERNEL@ gforth.fi
		# this is used for antidependences,
		FORTH_GEN1 = $(FORTH_GEN0) @kernel_fi@

		#kernel dependencies
		KERN_DEPS = $(KERN_SRC) kernel/version.fs machpc.fs $(FORTH_GEN0) compat/strcomp.fs

		#distributed documentation
		DOCDIST = doc/gforth.info doc/gforth.info-* doc/gforth.ps

		@@ -564,22 +568,22 @@ bench: gforth-fast$(EXE) gforth.fi
		# 3. copy new kernels to kernlXYZ.fi
		# these are the ones we want to use now

		kernl16l.fi-: $(KERN_SRC) kernel/version.fs mach16l.fs machpc.fs $(FORTH_GEN0)
		kernl16l.fi-: $(KERN_DEPS) mach16l.fs
		$(FORTHB) -e 's" mach16l.fs"' $(srcdir)/kernel/main.fs -e "save-cross kernl16l.fi- $(bindir)/gforth-$(VERSION) bye"

		kernl16b.fi-: $(KERN_SRC) kernel/version.fs mach16b.fs machpc.fs $(FORTH_GEN0)
		kernl16b.fi-: $(KERN_DEPS) mach16b.fs
		$(FORTHB) -e 's" mach16b.fs"' $(srcdir)/kernel/main.fs -e "save-cross kernl16b.fi- $(bindir)/gforth-$(VERSION) bye"

		kernl32l.fi-: $(KERN_SRC) kernel/version.fs mach32l.fs machpc.fs $(FORTH_GEN0)
		kernl32l.fi-: $(KERN_DEPS) mach32l.fs
		$(FORTHB) -e 's" mach32l.fs"' $(srcdir)/kernel/main.fs -e "save-cross kernl32l.fi- $(bindir)/gforth-$(VERSION) bye"

		kernl32b.fi-: $(KERN_SRC) kernel/version.fs mach32b.fs machpc.fs $(FORTH_GEN0)
		kernl32b.fi-: $(KERN_DEPS) mach32b.fs
		$(FORTHB) -e 's" mach32b.fs"' $(srcdir)/kernel/main.fs -e "save-cross kernl32b.fi- $(bindir)/gforth-$(VERSION) bye"

		kernl64l.fi-: $(KERN_SRC) kernel/version.fs mach64l.fs machpc.fs $(FORTH_GEN0)
		kernl64l.fi-: $(KERN_DEPS) mach64l.fs
		$(FORTHB) -e 's" mach64l.fs"' $(srcdir)/kernel/main.fs -e "save-cross kernl64l.fi- $(bindir)/gforth-$(VERSION) bye"

		kernl64b.fi-: $(KERN_SRC) kernel/version.fs mach64b.fs machpc.fs $(FORTH_GEN0)
		kernl64b.fi-: $(KERN_DEPS) mach64b.fs
		$(FORTHB) -e 's" mach64b.fs"' $(srcdir)/kernel/main.fs -e "save-cross kernl64b.fi- $(bindir)/gforth-$(VERSION) bye"

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

compat/strcomp.fs

0 → 100644

+27 −0

Original line number	Diff line number	Diff line
		\ string comparisons

		\ This file is in the public domain. NO WARRANTY.

		\ Uses of COMPARE can be replaced with STR=, STRING-PREFIX?, and STR<
		\ (and these can be implemented more efficiently and used more easily
		\ than COMPARE). See <news:2002Aug12.110229@a0.complang.tuwien.ac.at>
		\ and following.

		s" gforth" environment? [if]
		defined str=
		[else]
		0
		[then]
		0= [if]

		: str= ( c-addr1 u1 c-addr2 u2 -- f )
		compare 0= ;

		: string-prefix? ( c-addr1 u1 c-addr2 u2 -- f )
		\G Is @var{c-addr2 u2} a prefix of @var{c-addr1 u1}?
		tuck 2>r min 2r> str= ;

		: str< ( c-addr1 u1 c-addr2 u2 -- f )
		compare 0< ;

		[then]

cross.fs

+17 −15

Original line number	Diff line number	Diff line
		@@ -30,6 +30,8 @@ ToDo:

		[THEN]

		s" compat/strcomp.fs" included

		hex

		\ debugging for compiling
		@@ -259,9 +261,9 @@ hex

		\ FIXME move down
		: comment? ( c-addr u -- c-addr u )
		2dup s" (" compare 0=
		2dup s" (" str=
		IF postpone (
		ELSE 2dup s" \" compare 0= IF postpone \ THEN
		ELSE 2dup s" \" str= IF postpone \ THEN
		THEN ;

		: X ( -- <name> )
		@@ -474,8 +476,8 @@ sourcepath value fpath
		2dup 2 u> swap 1+ c@ [char] : = and >r \ dos absoulte: c:/....
		over c@ [char] / = >r
		over c@ [char] ~ = >r
		\ 2dup 3 min S" ../" compare 0= r> or >r \ not catered for in expandtopic
		2 min S" ./" compare 0=
		\ 2dup S" ../" string-prefix? r> or >r \ not catered for in expandtopic
		S" ./" string-prefix?
		r> r> r> or or or ;

		Create ofile 0 c, 255 chars allot
		@@ -491,14 +493,14 @@ Create tfile 0 c, 255 chars allot
		REPEAT ;

		: remove~+ ( -- )
		ofile count 3 min s" ~+/" compare 0=
		ofile count s" ~+/" string-prefix?
		IF
		ofile count 3 /string ofile place
		THEN ;

		: expandtopic ( -- ) \ stack effect correct? - anton
		\ expands "./" into an absolute name
		ofile count 2 min s" ./" compare 0=
		ofile count s" ./" string-prefix?
		IF
		ofile count 1 /string tfile place
		0 ofile c! sourcefilename extractpath ofile place
		@@ -511,7 +513,7 @@ Create tfile 0 c, 255 chars allot
		\ deletes phrases like "xy/.." out of our directory name 2dec97jaw
		over swap
		BEGIN dup WHILE
		dup >r '/ scan 2dup 4 min s" /../" compare 0=
		dup >r '/ scan 2dup s" /../" string-prefix?
		IF
		dup r> - >r 4 /string over r> + 4 -
		swap 2dup + >r move dup r> over -
		@@ -574,7 +576,7 @@ fpath= ~+
		: included? ( c-addr u -- f )
		file-list
		BEGIN @ dup
		WHILE >r 2dup r@ >fl-name count compare 0=
		WHILE >r 2dup r@ >fl-name count str=
		IF rdrop 2drop true EXIT THEN
		r>
		REPEAT
		@@ -3439,17 +3441,17 @@ Create parsed 20 chars allot \ store word we parsed
		1 BEGIN
		BEGIN bl word count dup WHILE
		comment? 20 umin parsed place upcase parsed count
		2dup s" [IF]" compare 0= >r
		2dup s" [IFUNDEF]" compare 0= >r
		2dup s" [IFDEF]" compare 0= r> or r> or
		2dup s" [IF]" str= >r
		2dup s" [IFUNDEF]" str= >r
		2dup s" [IFDEF]" str= r> or r> or
		IF 2drop 1+
		ELSE 2dup s" [ELSE]" compare 0=
		ELSE 2dup s" [ELSE]" str=
		IF 2drop 1- dup
		IF 1+
		THEN
		ELSE
		2dup s" [ENDIF]" compare 0= >r
		s" [THEN]" compare 0= r> or
		2dup s" [ENDIF]" str= >r
		s" [THEN]" str= r> or
		IF 1- THEN
		THEN
		THEN
		@@ -3497,7 +3499,7 @@ Cond: [IFUNDEF] postpone [IFUNDEF] ;Cond
		IF >in ! X :
		ELSE drop
		BEGIN bl word dup c@
		IF count comment? s" ;" compare 0= ?EXIT
		IF count comment? s" ;" str= ?EXIT
		ELSE refill 0= ABORT" CROSS: Out of Input while C:"
		THEN
		AGAIN

ds2texi.fs

+2 −2

Original line number	Diff line number	Diff line
		@@ -61,7 +61,7 @@ create description-buffer 4096 chars allot
		description-buffer tuck - ;

		: skip-prefix ( c-addr1 u1 -- c-addr2 u2 )
		2dup 2 min s" --" compare 0=
		2dup s" --" string-prefix?
		IF
		[char] - skip [char] - scan 1 /string
		THEN ;
		@@ -165,7 +165,7 @@ create description-buffer 4096 chars allot
		\ with the prefix addr2 u2 and continuing with a word in the
		\ wordlist `documentation'. f is true if xt is executed.
		>r dup >r
		3 pick over compare 0=
		3 pick over str=
		if \ addr2 u2 is a prefix of addr1 u1
		r> /string documentation search-wordlist
		if \ the rest of addr1 u1 is in documentation

fi2c.fs

+1 −1

Original line number	Diff line number	Diff line
		@@ -36,7 +36,7 @@ Variable au

		: search-magic ( fd -- ) >r
		BEGIN magicbuf 8 r@ read-file throw 8 = WHILE
		magicbuf s" Gforth2" tuck compare 0= UNTIL
		magicbuf s" Gforth2" tuck str= UNTIL
		ELSE true abort" No magic found" THEN
		1 magicbuf 7 + c@ 5 rshift 3 and lshift tchars !
		1 magicbuf 7 + c@ 1 rshift 3 and lshift tcell !