gforth/cross.fs - diff

Return to cross.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/cross.fs between versions 1.154 and 1.157

version 1.154, 2006/02/18 14:54:03	version 1.157, 2006/03/04 22:45:07
Line 1751 Ghost state drop	Line 1751 Ghost state drop
swap -rot bounds ?DO I c@ over X c! X char+ LOOP drop ;	swap -rot bounds ?DO I c@ over X c! X char+ LOOP drop ;

2Variable last-string	2Variable last-string
	X has? rom [IF] $60 [ELSE] $00 [THEN] Constant header-masks

	: ht-header, ( addr count -- )
	dup there swap last-string 2!
	dup header-masks or T c, H bounds ?DO I c@ T c, H LOOP ;
: ht-string, ( addr count -- )	: ht-string, ( addr count -- )
dup there swap last-string 2!	dup there swap last-string 2!
dup T c, H bounds ?DO I c@ T c, H LOOP ;	dup T c, H bounds ?DO I c@ T c, H LOOP ;
Line 2060 $20 constant restrict-mask	Line 2064 $20 constant restrict-mask

>TARGET	>TARGET
X has? f83headerstring [IF]	X has? f83headerstring [IF]
: name, ( "name" -- ) bl word count ht-string, X cfalign ;	: name, ( "name" -- ) bl word count ht-header, X cfalign ;
[ELSE]	[ELSE]
: name, ( "name" -- ) bl word count ht-lstring, X cfalign ;	: name, ( "name" -- ) bl word count ht-lstring, X cfalign ;
[THEN]	[THEN]
Line 2573 Cond: MAXI	Line 2577 Cond: MAXI
(THeader (:) ;	(THeader (:) ;

: :noname ( -- colon-sys )	: :noname ( -- colon-sys )
X cfalign there	switchrom X cfalign there
\ define a nameless ghost	\ define a nameless ghost
here ghostheader dup last-header-ghost ! dup to lastghost	here ghostheader dup last-header-ghost ! dup to lastghost
(:) ;	(:) ;
Line 2866 by User	Line 2870 by User

[THEN]	[THEN]

	T has? rom H [IF]
Builder (Value)	Builder (Value)
Build: ( n -- ) ;Build	Build: ( n -- ) ;Build
by: :docon ( target-body-addr -- n ) T @ H ;DO	by: :dovalue ( target-body-addr -- n ) T @ @ H ;DO

	Builder Value
	Build: T here 0 A, H switchram T align here swap ! , H ;Build
	by (Value)

	Builder AValue
	Build: T here 0 A, H switchram T align here swap ! A, H ;Build
	by (Value)
	[ELSE]
	Builder (Value)
	Build: ( n -- ) ;Build
	by: :dovalue ( target-body-addr -- n ) T @ H ;DO

Builder Value	Builder Value
BuildSmart: T , H ;Build	BuildSmart: T , H ;Build
Line 2877 by (Value)	Line 2894 by (Value)
Builder AValue	Builder AValue
BuildSmart: T A, H ;Build	BuildSmart: T A, H ;Build
by (Value)	by (Value)
	[THEN]

Defer texecute	Defer texecute

Builder Defer	Builder Defer
BuildSmart: ( -- ) [T'] noop T A, H ;Build	T has? rom H [IF]
by: :dodefer ( ghost -- ) X @ texecute ;DO	Build: ( -- ) T here 0 A, H switchram T align here swap ! H [T'] noop T A, H ( switchrom ) ;Build
	by: :dodefer ( ghost -- ) X @ X @ texecute ;DO
	[ELSE]
	BuildSmart: ( -- ) [T'] noop T A, H ;Build
	by: :dodefer ( ghost -- ) X @ texecute ;DO
	[THEN]

Builder interpret/compile:	Builder interpret/compile:
Build: ( inter comp -- ) swap T A, A, H ;Build-immediate	Build: ( inter comp -- ) swap T A, A, H ;Build-immediate
Line 3215 Cond: ABORT" if, ahead, there [char]	Line 3238 Cond: ABORT" if, ahead, there [char]
>r then, r> compile ALiteral compile c(abort") then, ;Cond	>r then, r> compile ALiteral compile c(abort") then, ;Cond
[THEN]	[THEN]

	X has? rom [IF]
	Cond: IS T ' >body @ H compile ALiteral compile ! ;Cond
	: IS T >address ' >body @ ! H ;
	Cond: TO T ' >body @ H compile ALiteral compile ! ;Cond
	: TO T ' >body @ ! H ;
	[ELSE]
Cond: IS T ' >body H compile ALiteral compile ! ;Cond	Cond: IS T ' >body H compile ALiteral compile ! ;Cond
: IS T >address ' >body ! H ;	: IS T >address ' >body ! H ;
Cond: TO T ' >body H compile ALiteral compile ! ;Cond	Cond: TO T ' >body H compile ALiteral compile ! ;Cond
: TO T ' >body ! H ;	: TO T ' >body ! H ;
	[THEN]

Cond: defers T ' >body @ compile, H ;Cond	Cond: defers T ' >body @ compile, H ;Cond

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.154
changed lines
	Added in v.1.157