--- gforth/cross.fs 2006/02/12 23:45:53 1.152 +++ gforth/cross.fs 2006/02/18 22:58:04 1.155 @@ -1771,6 +1771,9 @@ Ghost state drop ?DO dup T c@ H I T c! H 1+ tchar +LOOP drop ; +: tcallot ( char size -- ) + 0 ?DO dup T c, H tchar +LOOP drop ; + : td, ( d -- ) \G Store a host value as one cell into the target there tcell X allot TD! ; @@ -2570,7 +2573,7 @@ Cond: MAXI (THeader (:) ; : :noname ( -- colon-sys ) - X cfalign there + switchrom X cfalign there \ define a nameless ghost here ghostheader dup last-header-ghost ! dup to lastghost (:) ; @@ -2821,8 +2824,8 @@ by Create \ Variable tudp 0 tudp ! : u, ( n -- udp ) - current-region >r user-region activate .regions - X here swap X , tup@ - .regions + current-region >r user-region activate + X here swap X , tup@ - r> activate ; : au, ( n -- udp ) @@ -2863,6 +2866,19 @@ by User [THEN] +T has? rom H [IF] +Builder (Value) +Build: ( n -- ) ;Build +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: :docon ( target-body-addr -- n ) T @ H ;DO @@ -2874,12 +2890,18 @@ by (Value) Builder AValue BuildSmart: T A, H ;Build by (Value) +[THEN] Defer texecute Builder Defer -BuildSmart: ( -- ) [T'] noop T A, H ;Build -by: :dodefer ( ghost -- ) X @ texecute ;DO +T has? rom H [IF] + 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: Build: ( inter comp -- ) swap T A, A, H ;Build-immediate @@ -3212,10 +3234,17 @@ Cond: ABORT" if, ahead, there [char] >r then, r> compile ALiteral compile c(abort") then, ;Cond [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 : IS T >address ' >body ! H ; Cond: TO T ' >body H compile ALiteral compile ! ;Cond : TO T ' >body ! H ; +[THEN] Cond: defers T ' >body @ compile, H ;Cond