--- gforth/cross.fs 1994/05/05 15:46:38 1.3 +++ gforth/cross.fs 1994/06/17 12:34:58 1.6 @@ -1,5 +1,5 @@ \ CROSS.FS The Cross-Compiler 06oct92py -\ $Id: cross.fs,v 1.3 1994/05/05 15:46:38 pazsan Exp $ +\ $Id: cross.fs,v 1.6 1994/06/17 12:34:58 anton Exp $ \ Idea and implementation: Bernd Paysan (py) \ Copyright 1992 by the ANSI figForth Development Group @@ -23,6 +23,12 @@ include other.fs \ ansforth extentions for cross +: comment? ( c-addr u -- c-addr u ) + 2dup s" (" compare 0= + IF postpone ( + ELSE 2dup s" \" compare 0= IF postpone \ THEN + THEN ; + decimal \ number? 11may93jaw @@ -128,7 +134,8 @@ include machine.fs : cell+ cell + ; : cells cell<< lshift ; : chars ; - +: floats float * ; + >CROSS : cell/ cell<< rshift ; >TARGET @@ -155,10 +162,10 @@ endian 0 pad ! -1 pad c! pad @ 0< \ Fixed bug in else part 11may93jaw [IFDEF] Memory \ Memory is a bigFORTH feature - Memory + also Memory : initmem ( var len -- ) 2dup swap handle! >r @ r> erase ; - Target + toss [ELSE] : initmem ( var len -- ) tuck allocate abort" CROSS: No memory for target" @@ -181,7 +188,9 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, : >bit ( addr n -- c-addr mask ) 8 /mod rot + swap bits ; : +bit ( addr n -- ) >bit over c@ or swap c! ; +: -bit ( addr n -- ) >bit invert over c@ and swap c! ; : relon ( taddr -- ) bit$ @ swap cell/ +bit ; +: reloff ( taddr -- ) bit$ @ swap cell/ -bit ; \ Target memory access 06oct92py @@ -261,8 +270,10 @@ Variable atonce atonce off : gfind ( string -- ghost true/1 / string false ) \ searches for string in word-list ghosts \ !! wouldn't it be simpler to just use search-wordlist ? ae - >r get-order 0 set-order also ghosts r> find >r >r - set-order r> r@ IF >body THEN r> ; + dup count [ ' ghosts >body ] ALiteral search-wordlist +\ >r get-order 0 set-order also ghosts r> find >r >r + >r r@ IF >body nip THEN r> ; +\ set-order r> r@ IF >body THEN r> ; VARIABLE Already @@ -478,6 +489,8 @@ Cond: [Char] ( "" -- ) restrict Cond: EXIT ( -- ) restrict? compile ;S ;Cond +Cond: ?EXIT ( -- ) 1 abort" CROSS: using ?exit" ;Cond + Cond: ; ( -- ) restrict? depth ?dup IF 1- <> ABORT" CROSS: Stack changed" ELSE true ABORT" CROSS: Stack empty" THEN @@ -510,7 +523,7 @@ Cond: DOES> restrict? : gdoes, ( ghost -- ) >end @ dup >magic @ <> IF dup >link @ dup 0< IF T A, 0 , H drop EXIT THEN drop THEN - :dodoes T A, H gexecute ; + :dodoes T A, H gexecute T here H cell - reloff ; : TCreate ( ghost -- ) CreateFlag on