--- gforth/cross.fs 2004/05/16 21:16:35 1.145 +++ gforth/cross.fs 2006/02/18 14:54:03 1.154 @@ -1,7 +1,7 @@ \ CROSS.FS The Cross-Compiler 06oct92py \ Idea and implementation: Bernd Paysan (py) -\ Copyright (C) 1995,1996,1997,1998,1999,2000,2003 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2004,2005 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -1722,7 +1722,8 @@ Ghost (do) Ghost (?do) Ghost (for) drop Ghost (loop) Ghost (+loop) 2drop Ghost (next) drop -Ghost (does>) Ghost (does>1) Ghost compile, 2drop drop +Ghost (does>) Ghost (does>1) Ghost (does>2) 2drop drop +Ghost compile, drop Ghost (.") Ghost (S") Ghost (ABORT") 2drop drop Ghost (C") Ghost c(abort") Ghost type 2drop drop Ghost ' drop @@ -1761,7 +1762,7 @@ Ghost state drop : count dup X c@ swap X char+ swap ; -: on -1 -1 rot TD! ; +: on >r -1 -1 r> TD! ; : off T 0 swap ! H ; : tcmove ( source dest len -- ) @@ -1770,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! ; @@ -2204,7 +2208,7 @@ NoHeaderFlag off ENDCASE LOOP ; -Defer setup-execution-semantics +Defer setup-execution-semantics ' noop IS setup-execution-semantics 0 Value lastghost : (THeader ( "name" -- ghost ) @@ -2614,7 +2618,7 @@ Cond: [ ( -- ) interpreting-state ;Cond r@ created >do:ghost ! r@ swap resolve r> tlastcfa @ >tempdp dodoes, tempdp> ; -Defer instant-interpret-does>-hook +Defer instant-interpret-does>-hook ' noop IS instant-interpret-does>-hook T has? peephole H [IF] : does-resolved ( ghost -- ) @@ -2631,7 +2635,7 @@ T has? peephole H [IF] >TARGET Cond: DOES> - T here 4 cells H + alit, compile (does>1) + T here 5 cells H + alit, compile (does>2) compile ;s doeshandler, resolve-does>-part ;Cond @@ -2821,7 +2825,7 @@ by Create : u, ( n -- udp ) current-region >r user-region activate - X here swap X , tup@ - + X here swap X , tup@ - r> activate ; : au, ( n -- udp ) @@ -3268,6 +3272,7 @@ tchar 8 = 78 and or magic 7 + c! : save-cross ( "image-name" "binary-name" -- ) + .regions \ s" ec" X $has? IF .regions THEN bl parse ." Saving to " 2dup type cr w/o bin create-file throw >r s" header" X $has? IF @@ -3284,7 +3289,8 @@ magic 7 + c! ELSE bl parse 2drop THEN - dictionary >rmem @ there + >rom dictionary >rmem @ there + s" rom" X $has? IF dictionary >rstart @ - THEN r@ write-file throw \ write image s" relocate" X $has? IF dictionary >rbm @ there 1- tcell>bit rshift 1+