--- gforth/cross.fs 2004/05/16 21:16:35 1.145 +++ gforth/cross.fs 2006/01/29 18:34:33 1.151 @@ -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 -- ) @@ -2204,7 +2205,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 +2615,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 +2632,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 @@ -3268,6 +3269,7 @@ tchar 8 = 78 and or magic 7 + c! : save-cross ( "image-name" "binary-name" -- ) + 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 +3286,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+