gforth/prims2x0.6.2.fs - diff

Return to prims2x0.6.2.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/prims2x0.6.2.fs between versions 1.3 and 1.5

version 1.3, 2009/01/18 18:41:55	version 1.5, 2009/02/14 19:50:23
Line 302 create sp-update-in max-stacks cells all	Line 302 create sp-update-in max-stacks cells all
create max-depths max-stacks max-combined 1+ * cells allot	create max-depths max-stacks max-combined 1+ * cells allot
\ maximum depth at start of each part: array[parts] of array[stack]	\ maximum depth at start of each part: array[parts] of array[stack]
create max-back-depths max-stacks max-combined 1+ * cells allot	create max-back-depths max-stacks max-combined 1+ * cells allot
\ maximun depth from end of the combination to the start of the each part	\ maximum depth from end of the combination to the start of the each part
	create depths max-stacks max-combined 1+ * cells allot
	\ depth at the start of each part: array[parts] of array[stack]

: s-c-max-depth ( nstack ncomponent -- addr )	: s-c-max-depth ( nstack ncomponent -- addr )
max-stacks * + cells max-depths + ;	max-stacks * + cells max-depths + ;
Line 310 create max-back-depths max-stacks max-co	Line 312 create max-back-depths max-stacks max-co
: s-c-max-back-depth ( nstack ncomponent -- addr )	: s-c-max-back-depth ( nstack ncomponent -- addr )
max-stacks * + cells max-back-depths + ;	max-stacks * + cells max-back-depths + ;

	: s-c-depth ( nstack ncomponent -- addr )
	max-stacks * + cells depths + ;

	: final-max-depth? { nstack ncomponent -- flag }
	\ does the stack reach its final maxdepth before the component?
	nstack ncomponent s-c-max-depth @
	nstack num-combined @ s-c-max-depth @ = ;

wordlist constant primitives	wordlist constant primitives

: create-prim ( prim -- )	: create-prim ( prim -- )
Line 692 stack inst-stream IP Cell	Line 702 stack inst-stream IP Cell
stack-access-transform @ dup >r execute	stack-access-transform @ dup >r execute
0 r> execute - ;	0 r> execute - ;

: stack-pointer-update { stack -- }	: n-stack-pointer-update { n stack -- }
\ stacks grow downwards	\ stack pointer update by n
stack stack-diff	n if \ this check is not necessary, gcc would do this for us
?dup-if \ this check is not necessary, gcc would do this for us
stack inst-stream = if	stack inst-stream = if
." INC_IP(" 0 .r ." );" cr	." INC_IP(" n 0 .r ." );" cr
else	else
stack stack-pointer 2@ type ." += "	stack stack-pointer 2@ type ." += "
stack stack-update-transform 0 .r ." ;" cr	n stack stack-update-transform 0 .r ." ;" cr
endif	endif
endif ;	endif ;

	: stack-pointer-update { stack -- }
	\ stacks grow downwards
	stack stack-diff stack n-stack-pointer-update ;

: stack-pointer-updates ( -- )	: stack-pointer-updates ( -- )
['] stack-pointer-update map-stacks ;	['] stack-pointer-update map-stacks ;

Line 1094 variable tail-nextp2 \ xt to execute for	Line 1107 variable tail-nextp2 \ xt to execute for
current-depth i th !	current-depth i th !
loop ;	loop ;

: copy-maxdepths ( n -- )	: copy-maxdepths { n -- }
max-depth max-depths rot max-stacks * th max-stacks cells move ;	\ transfer current-depth to depths and max-depth to max-depths
	max-depth max-depths n max-stacks * th max-stacks cells move
	current-depth depths n max-stacks * th max-stacks cells move ;

: add-prim ( addr u -- )	: add-prim ( addr u -- )
\ add primitive given by "addr u" to combined-prims	\ add primitive given by "addr u" to combined-prims
Line 1190 variable tail-nextp2 \ xt to execute for	Line 1205 variable tail-nextp2 \ xt to execute for
print-debug-results	print-debug-results
stores ;	stores ;

	: combined-tail-stack-pointer-update { stack -- }
	stack stack-number @ { nstack }
	nstack part-num @ 1+ s-c-depth @ ( nupdate-raw )
	\ correct for possible earlier update
	nstack part-num @ 1+ final-max-depth? if
	stack combined ['] stack-diff prim-context - endif
	stack n-stack-pointer-update ;

	: combined-tail-stack-pointer-updates ( -- )
	['] combined-tail-stack-pointer-update map-stacks ;

: output-combined-tail ( -- )	: output-combined-tail ( -- )
in-part @ >r in-part off	in-part @ >r in-part off
	combined-tail-stack-pointer-updates
part-output-c-tail	part-output-c-tail
combined ['] output-c-tail-no-stores prim-context	combined ['] output-c-tail-no-stores prim-context
r> in-part ! ;	r> in-part ! ;

: part-stack-pointer-updates ( -- )	: part-stack-pointer-updates ( -- )
next-stack-number @ 0 +do	next-stack-number @ 0 +do
i part-num @ 1+ s-c-max-depth @ dup	i part-num @ 1+ final-max-depth? \ reached afterwards
i num-combined @ s-c-max-depth @ = \ final depth	i part-num @ final-max-depth? 0= \ but not before
swap i part-num @ s-c-max-depth @ <> \ just reached now	part-num @ 0= \ exception: first part
part-num @ 0= \ first part
or and if	or and if
stacks i th @ stack-pointer-update	stacks i th @ stack-pointer-update
endif	endif
Line 1216 variable tail-nextp2 \ xt to execute for	Line 1242 variable tail-nextp2 \ xt to execute for
part-fetches	part-fetches
print-debug-args	print-debug-args
combined ['] part-stack-pointer-updates prim-context	combined ['] part-stack-pointer-updates prim-context
1 part-num +!
prim add-depths \ !! right place?	prim add-depths \ !! right place?
prim prim-c-code 2@ ['] output-combined-tail type-c-code	prim prim-c-code 2@ ['] output-combined-tail type-c-code
	1 part-num +!
part-output-c-tail	part-output-c-tail
." }" cr ;	." }" cr ;

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

Removed from v.1.3
changed lines
	Added in v.1.5