gforth/cross.fs - diff

Return to cross.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/cross.fs between versions 1.43 and 1.46

version 1.43, 1997/02/08 22:58:09	version 1.46, 1997/02/24 22:28:57
Line 100 also Forth definitions	Line 100 also Forth definitions
[IFDEF] asm-include asm-include [THEN]	[IFDEF] asm-include asm-include [THEN]

previous	previous
	hex

>CROSS	>CROSS

Line 245 VARIABLE VocTemp	Line 246 VARIABLE VocTemp
: <T get-current VocTemp ! also Ghosts definitions ;	: <T get-current VocTemp ! also Ghosts definitions ;
: T> previous VocTemp @ set-current ;	: T> previous VocTemp @ set-current ;

	hex
4711 Constant <fwd> 4712 Constant <res>	4711 Constant <fwd> 4712 Constant <res>
4713 Constant <imm> 4714 Constant <do:>	4713 Constant <imm> 4714 Constant <do:>

Line 444 Defer skip? ' false IS skip?	Line 446 Defer skip? ' false IS skip?
ghost dup >magic @ <fwd> =	ghost dup >magic @ <fwd> =
IF >link @ 0<> ELSE drop false THEN ;	IF >link @ 0<> ELSE drop false THEN ;

	: doer? ( -- flag ) \ name
	ghost >magic @ <do:> = ;

: skip-defs ( -- )	: skip-defs ( -- )
BEGIN refill WHILE source -trailing nip 0= UNTIL THEN ;	BEGIN refill WHILE source -trailing nip 0= UNTIL THEN ;

Line 525 ghost (does>) ghost noop	Line 530 ghost (does>) ghost noop
ghost (.") ghost (S") ghost (ABORT") 2drop drop	ghost (.") ghost (S") ghost (ABORT") 2drop drop
ghost ' drop	ghost ' drop
ghost :docol ghost :doesjump ghost :dodoes 2drop drop	ghost :docol ghost :doesjump ghost :dodoes 2drop drop
	ghost over ghost = ghost drop 2drop drop

\ compile 10may93jaw	\ compile 10may93jaw

Line 539 ghost :docol ghost :doesjump ghost :d	Line 545 ghost :docol ghost :doesjump ghost :d
\ generic threading modell	\ generic threading modell
: docol, ( -- ) compile :docol T 0 , H ;	: docol, ( -- ) compile :docol T 0 , H ;

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

[IFUNDEF] (code)	[IFUNDEF] (code)
Defer (code)	Defer (code)
Line 549 Defer (end-code)	Line 555 Defer (end-code)
>TARGET	>TARGET
: Code	: Code
(THeader there resolve	(THeader there resolve
there 2 T cells H + T a, 0 , H	[ has-prims 0= [IF] ITC [ELSE] true [THEN] ] [IF]
	there 2 T cells H + T a, 0 , H
	[THEN]
depth (code) ;	depth (code) ;

: Code:	: Code:
Line 644 Cond: MAXI	Line 652 Cond: MAXI
docol, depth T ] H ;	docol, depth T ] H ;

: :noname ( -- colon-sys )	: :noname ( -- colon-sys )
T align H there docol, depth T ] H ;	T cfalign H there docol, depth T ] H ;

Cond: EXIT ( -- ) restrict? compile ;S ;Cond	Cond: EXIT ( -- ) restrict? compile ;S ;Cond

Line 665 Cond: [ restrict? state off ;Cond	Line 673 Cond: [ restrict? state off ;Cond

>TARGET	>TARGET
Cond: DOES> restrict?	Cond: DOES> restrict?
compile (does>) dodoes, tdoes @ ?dup IF @ T here H resolve THEN	compile (does>) dodoes, tdoes @ ?dup IF @ T here H resolve THEN
;Cond	;Cond
: DOES> dodoes, T here H !does depth T ] H ;	: DOES> dodoes, T here H !does depth T ] H ;

Line 760 Build: T 0 au, , H ;	Line 768 Build: T 0 au, , H ;
by User	by User
Builder AUser	Builder AUser

Build: ( n -- ) T , H ;	Build: ( n -- ) ;
by: :docon ( ghost -- n ) T @ H ;DO	by: :docon ( ghost -- n ) T @ H ;DO
	Builder (Constant)

	Build: ( n -- ) T , H ;
	by (Constant)
Builder Constant	Builder Constant

Build: ( n -- ) T A, H ;	Build: ( n -- ) T A, H ;
by Constant	by (Constant)
Builder AConstant	Builder AConstant

Build: ( d -- ) T , , H ;	Build: ( d -- ) T , , H ;
DO: ( ghost -- d ) T dup cell+ @ swap @ H ;DO	DO: ( ghost -- d ) T dup cell+ @ swap @ H ;DO
Builder 2Constant	Builder 2Constant

Build: T 0 , H ;	Build: T , H ;
by Constant	by (Constant)
Builder Value	Builder Value

Build: T 0 A, H ;	Build: T A, H ;
by Constant	by (Constant)
Builder AValue	Builder AValue

Build: ( -- ) compile noop ;	Build: ( -- ) compile noop ;
Line 796 Builder interpret/compile:	Line 808 Builder interpret/compile:
1- tuck + swap invert and ;	1- tuck + swap invert and ;
>TARGET	>TARGET

	Build: ;
	by: :dofield T @ H + ;DO
	Builder (Field)

Build: >r rot r@ nalign dup T , H ( align1 size offset )	Build: >r rot r@ nalign dup T , H ( align1 size offset )
+ swap r> nalign ;	+ swap r> nalign ;
by: :dofield T @ H + ;DO	by (Field)
Builder Field	Builder Field

: struct T 0 1 chars H ;	: struct T 0 1 chars H ;
Line 853 Cond: AGAIN restrict? sys? compile b	Line 869 Cond: AGAIN restrict? sys? compile b
Cond: UNTIL restrict? sys? compile ?branch <resolve ;Cond	Cond: UNTIL restrict? sys? compile ?branch <resolve ;Cond
Cond: REPEAT restrict? over 0= ?struc compile AGAIN compile THEN ;Cond	Cond: REPEAT restrict? over 0= ?struc compile AGAIN compile THEN ;Cond

	Cond: CASE restrict? 0 ;Cond
	Cond: OF restrict? 1+ >r compile over compile = compile IF compile drop
	r> ;Cond
	Cond: ENDOF restrict? >r compile ELSE r> ;Cond
	Cond: ENDCASE restrict? compile drop 0 ?DO compile THEN LOOP ;Cond

\ Structural Conditionals 12dec92py	\ Structural Conditionals 12dec92py

Cond: DO restrict? compile (do) T here H ;Cond	Cond: DO restrict? compile (do) T here H ;Cond
Line 920 also minimal	Line 942 also minimal
\ define new [IFDEF] and [IFUNDEF] 20may93jaw	\ define new [IFDEF] and [IFUNDEF] 20may93jaw

: defined? defined? ;	: defined? defined? ;
	: needed? needed? ;
	: doer? doer? ;

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

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

Removed from v.1.43
changed lines
	Added in v.1.46