Get rid of dodoes: in the kernel, still has some closure issues (a5f043c7) · Commits · Bernd Paysan / gforth

cross.fs

+23 −34

Original line number	Diff line number	Diff line
		@@ -1912,12 +1912,11 @@ previous

		: (cr) >tempdp colon, tempdp> ; ' (cr) plugin-of colon-resolve
		: (ar) T ! H ; ' (ar) plugin-of addr-resolve
		: (dr) ( ghost res-pnt target-addr addr )
		>tempdp drop over
		: doer/does, ( ghost -- )
		dup >magic @ <do:> =
		IF doer,
		ELSE dodoes,
		THEN
		IF doer, ELSE dodoes, THEN ;
		: (dr) ( ghost res-pnt target-addr addr )
		>tempdp drop over doer/does,
		tempdp> ; ' (dr) plugin-of doer-resolve

		: (cm) ( -- addr )
		@@ -2587,15 +2586,19 @@ T 2 cells H Value xt>body
		: (doeshandler,) ( -- )
		T H ; ' (doeshandler,) plugin-of doeshandler,

		Defer gset-extra

		: (dodoes,) ( does-action-ghost -- )
		]comp [G'] :dodoes addr, comp[
		dup gset-extra
		addr,
		2 fillcfa ; ' (dodoes,) plugin-of dodoes,
		2 fillcfa ;

		: doextraxt, ( -- )
		: doextraxt, ( does-action-ghost -- )
		]comp [G'] :doextraxt addr, comp[
		0 addr,
		2 fillcfa ;
		gset-extra
		2 fillcfa ; ' doextraxt, plugin-of dodoes,

		: (dlit,) ( n -- ) compile lit td, ; ' (dlit,) plugin-of dlit,

		@@ -2825,7 +2828,6 @@ Cond: [ ( -- ) interpreting-state ;Cond
		Ghost does, drop

		Defer gset-optimizer
		Defer gset-extra

		: !does ( does-action -- )
		tlastcfa @ [G'] :dovar killref
		@@ -2860,22 +2862,13 @@ X has? primcentric [IF]
		IF there resolve THEN ;

		Cond: DOES>
		T here H [ T has? primcentric H [IF] ] 5 [ [ELSE] ] 4 [ [THEN] ] T cells
		H + alit, compile !does compile ;s
		doeshandler, resolve-does>-part
		;Cond
		Cond: EXTRA>
		T here cfaligned H [ T has? primcentric H [IF] ] 8 [ [ELSE] ] 7 [ [THEN] ] T cells
		H + alit, compile !extraxt compile ;
		T :noname H 2drop depth resolve-does>-part
		Last-Header-Ghost @ >do:ghost @ >r
		T :noname H
		r> ?dup IF swap resolve ELSE drop THEN
		;Cond

		: oldDOES>
		['] does-resolved created >comp !
		switchrom doeshandler, T here H !does
		instant-interpret-does>-hook
		depth ;Resolve off T ] H ;

		: DOES>
		['] extra-resolved created >comp !
		T here cfaligned #10 cells H \ includes noname header+vtable
		@@ -2933,10 +2926,7 @@ Cond: DOES>
		\ makes the codefield for a word that is built
		>do:ghost @ dup undefined? 0=
		IF
		dup >magic @ <do:> =
		IF doer,
		ELSE dodoes,
		THEN
		doer/does,
		EXIT
		THEN
		\ compile :dodoes gexecute
		@@ -3215,8 +3205,7 @@ variable cross-boot[][]
		>space here >r ghostheader space>
		['] colon-resolved r@ >comp !
		r@ created >do:ghost ! r@ swap resolve
		r> gset-extra
		tlastcfa @ >tempdp doextraxt, tempdp> ;
		r> tlastcfa @ >tempdp doextraxt, tempdp> ;
		IS !newdoes

		: ;DO ( [xt] [colon-sys] -- )

kernel/comp.fs

+0 −21

Original line number	Diff line number	Diff line
		@@ -481,27 +481,6 @@ Variable to-style# 0 to-style# !

		: !!?addr!! ( -- ) to-style# @ -1 = -2056 and throw ;

		: uvalue-to ( n uvalue-xt -- )
		\g uvalue-to is the to-method for uvalues; it's xt is only
		\g there to be consumed by @code{set-to}.
		\ should be defined with TO: OPT-TO:, but not supported by cross.fs
		!!?addr!! >body @ next-task + !-table to-!exec ;
		opt: ( uvalue-xt to-xt -- )
		!!?addr!! drop >body @ postpone useraddr , !-table to-!, ;
		: u-compile, ( xt -- ) >body @ postpone user@ , ;

		: UValue ( "name" -- )
		\G Define a per-thread value
		Create cell uallot , ['] uvalue-to set-to
		['] u-compile, set-optimizer
		DOES> @ next-task + @ ;

		: 2Constant ( w1 w2 "name" -- ) \ double two-constant
		Create ( w1 w2 "name" -- )
		2,
		DOES> ( -- w1 w2 )
		2@ ;

		: (Field) Header reveal dofield, ?noname-vt ;

		\ IS Defer What's Defers TO 24feb93py

kernel/doers.fs

+0 −3

Original line number	Diff line number	Diff line
		@@ -38,9 +38,6 @@ doer? :dodefer 0= [IF] \D compileddofillers .( DODEFER )
		[THEN]

		\D compileddofillers .( DO2CON )
		\| : 2Constant ( w1 w2 "name" -- )
		DOES> ( -- w1 w2 )
		2@ ;

		doer? :docon 0= [IF] \D compileddofillers .( DOCON )
		\| : (Constant) DOES> @ ;

kernel/vars.fs

+24 −0

Original line number	Diff line number	Diff line
		@@ -19,8 +19,32 @@

		hex \ everything now hex! 11may93jaw

		\ important definers

		: uvalue-to ( n uvalue-xt -- )
		\g uvalue-to is the to-method for uvalues; it's xt is only
		\g there to be consumed by @code{set-to}.
		\ should be defined with TO: OPT-TO:, but not supported by cross.fs
		!!?addr!! >body @ next-task + !-table to-!exec ;
		opt: ( uvalue-xt to-xt -- )
		!!?addr!! drop >body @ postpone useraddr , !-table to-!, ;
		: u-compile, ( xt -- ) >body @ postpone user@ , ;

		: UValue ( "name" -- )
		\G Define a per-thread value
		Create cell uallot , ['] uvalue-to set-to
		['] u-compile, set-optimizer
		DOES> @ next-task + @ ;

		: 2Constant ( w1 w2 "name" -- ) \ double two-constant
		Create ( w1 w2 "name" -- )
		2,
		DOES> ( -- w1 w2 )
		2@ ;

		\ important constants 17dec92py


		\ dpANS6 (sect 3.1.3.1) says
		\ "a true flag ... [is] a single-cell value with all bits set"
		\ better definition: 0 0= constant true ( no dependence on 2's compl)

debugs.fs

+1 −1

File changed.

Contains only whitespace changes.