gforth/prims2x.fs - diff

Return to prims2x.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/prims2x.fs between versions 1.113 and 1.116

version 1.113, 2002/09/14 08:20:19	version 1.116, 2002/09/22 14:21:30
Line 89 variable out-nls \ newlines in output (f	Line 89 variable out-nls \ newlines in output (f
variable store-optimization \ use store optimization?	variable store-optimization \ use store optimization?
store-optimization off	store-optimization off

	variable include-skipped-insts
	\ does the threaded code for a combined instruction include the cells
	\ for the component instructions (true) or only the cells for the
	\ inline arguments (false)
	include-skipped-insts off

: th ( addr1 n -- addr2 )	: th ( addr1 n -- addr2 )
cells + ;	cells + ;
Line 250 variable in-part \ true if processing a	Line 255 variable in-part \ true if processing a
create combined-prims max-combined cells allot	create combined-prims max-combined cells allot
variable num-combined	variable num-combined

	: map-combined { xt -- }
	\ perform xt for all components of the current combined instruction
	num-combined @ 0 +do
	combined-prims i th @ xt execute
	loop ;

table constant combinations	table constant combinations
\ the keys are the sequences of pointers to primitives	\ the keys are the sequences of pointers to primitives

Line 733 stack inst-stream IP Cell	Line 744 stack inst-stream IP Cell
endif	endif
." }" cr ;	." }" cr ;

	: output-profile-part ( p )
	." add_inst(b, " quote
	prim-name 2@ type
	quote ." );" cr ;

: output-profile-combined ( -- )	: output-profile-combined ( -- )
\ generate code for postprocessing the VM block profile stuff	\ generate code for postprocessing the VM block profile stuff
." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr	." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr
num-combined @ 0 +do	['] output-profile-part map-combined
." add_inst(b, " quote
combined-prims i th @ prim-name 2@ type
quote ." );" cr
loop
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr	." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr
combined-prims num-combined @ 1- th @ prim-c-code 2@ s" SET_IP" search nip nip	combined-prims num-combined @ 1- th @ prim-c-code 2@ s" SET_IP" search nip nip
combined-prims num-combined @ 1- th @ prim-c-code 2@ s" SUPER_END" search nip nip or if	combined-prims num-combined @ 1- th @ prim-c-code 2@ s" SUPER_END" search nip nip or if
Line 826 stack inst-stream IP Cell	Line 838 stack inst-stream IP Cell
: output-alias ( -- )	: output-alias ( -- )
( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;	( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;

	: output-prim-num ( -- )
	prim prim-num @ 8 + 4 .r space prim prim-name 2@ type cr ;

: output-forth ( -- )	: output-forth ( -- )
prim prim-forth-code @ 0=	prim prim-forth-code @ 0=
IF \ output-alias	IF \ output-alias
Line 937 stack inst-stream IP Cell	Line 952 stack inst-stream IP Cell
prim to combined	prim to combined
0 num-combined !	0 num-combined !
current-depth max-stacks cells erase	current-depth max-stacks cells erase
	include-skipped-insts @ current-depth 0 th !
max-depth max-stacks cells erase	max-depth max-stacks cells erase
min-depth max-stacks cells erase	min-depth max-stacks cells erase
prim prim-effect-in prim prim-effect-in-end !	prim prim-effect-in prim prim-effect-in-end !
Line 948 stack inst-stream IP Cell	Line 964 stack inst-stream IP Cell
: min! ( n addr -- )	: min! ( n addr -- )
tuck @ min swap ! ;	tuck @ min swap ! ;

	: inst-stream-correction ( nin1 nstack -- nin2 )
	0= if
	include-skipped-insts @ -
	endif ;

: add-depths { p -- }	: add-depths { p -- }
\ combine stack effect of p with *-depths	\ combine stack effect of p with *-depths
max-stacks 0 ?do	max-stacks 0 ?do
current-depth i th @	current-depth i th @
p prim-stacks-in i th @ +	p prim-stacks-in i th @ + i inst-stream-correction
dup max-depth i th max!	dup max-depth i th max!
p prim-stacks-out i th @ -	p prim-stacks-out i th @ -
dup min-depth i th min!	dup min-depth i th min!
Line 1051 stack inst-stream IP Cell	Line 1072 stack inst-stream IP Cell
: output-parts ( -- )	: output-parts ( -- )
prim >r in-part on	prim >r in-part on
current-depth max-stacks cells erase	current-depth max-stacks cells erase
num-combined @ 0 +do	['] output-part map-combined
combined-prims i th @ output-part
loop
in-part off	in-part off
r> to prim ;	r> to prim ;

Line 1079 stack inst-stream IP Cell	Line 1098 stack inst-stream IP Cell

\ peephole optimization rules	\ peephole optimization rules

	\ data for a simple peephole optimizer that always tries to combine
	\ the currently compiled instruction with the last one.

\ in order for this to work as intended, shorter combinations for each	\ in order for this to work as intended, shorter combinations for each
\ length must be present, and the longer combinations must follow	\ length must be present, and the longer combinations must follow
\ shorter ones (this restriction may go away in the future).	\ shorter ones (this restriction may go away in the future).

: output-peephole ( -- )	: output-peephole ( -- )
combined-prims num-combined @ 1- cells combinations search-wordlist	combined-prims num-combined @ 1- cells combinations search-wordlist
s" the prefix for this combination must be defined earlier" ?print-error	s" the prefix for this superinstruction must be defined earlier" ?print-error
." {"	." {"
execute prim-num @ 5 .r ." ,"	execute prim-num @ 5 .r ." ,"
combined-prims num-combined @ 1- th @ prim-num @ 5 .r ." ,"	combined-prims num-combined @ 1- th @ prim-num @ 5 .r ." ,"
Line 1093 stack inst-stream IP Cell	Line 1115 stack inst-stream IP Cell
combined prim-c-name 2@ type ." */"	combined prim-c-name 2@ type ." */"
cr ;	cr ;

: output-forth-peephole ( -- )
combined-prims num-combined @ 1- cells combinations search-wordlist
s" the prefix for this combination must be defined earlier" ?print-error
execute prim-num @ 5 .r
combined-prims num-combined @ 1- th @ prim-num @ 5 .r
combined prim-num @ 5 .r ." prim, \ "
combined prim-c-name 2@ type
cr ;

	\ cost and superinstruction data for a sophisticated combiner (e.g.,
	\ shortest path)

	\ This is intended as initializer for a structure like this

	\ struct cost {
	\ int loads; /* number of stack loads */
	\ int stores; /* number of stack stores */
	\ int updates; /* number of stack pointer updates */
	\ int length; /* number of components */
	\ int components; / array of vm_prim indexes of components */
	\ };

	\ How do you know which primitive or combined instruction this
	\ structure refers to? By the order of cost structures, as in most
	\ other cases.

	: compute-costs { p -- nloads nstores nupdates }
	\ compute the number of loads, stores, and stack pointer updates
	\ of a primitive or combined instruction; does not take TOS
	\ caching into account, nor that IP updates are combined with
	\ other stuff
	0 max-stacks 0 +do
	p prim-stacks-in i th @ +
	loop
	0 max-stacks 0 +do
	p prim-stacks-out i th @ +
	loop
	0 max-stacks 0 +do
	p prim-stacks-in i th @ p prim-stacks-out i th @ <> -
	loop ;

	: output-num-part ( p -- )
	prim-num @ 4 .r ." ," ;

	: output-costs ( -- )
	." {" prim compute-costs
	rot 2 .r ." ," swap 2 .r ." ," 2 .r ." ,"
	combined if
	num-combined @ 2 .r
	." , ((int []){" ['] output-num-part map-combined ." })}, /* "
	else
	." 1, ((int []){" prim prim-num @ 4 .r ." })}, /* "
	endif
	prim prim-name 2@ type ." */"
	cr ;

\ the parser	\ the parser

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

Removed from v.1.113
changed lines
	Added in v.1.116