Diff for /gforth/cross.fs between versions 1.177 and 1.180

version 1.177, 2011/11/11 18:29:09 version 1.180, 2012/02/13 22:58:13
Line 1 Line 1
 \ CROSS.FS     The Cross-Compiler                      06oct92py  \ CROSS.FS     The Cross-Compiler                      06oct92py
 \ Idea and implementation: Bernd Paysan (py)  \ Idea and implementation: Bernd Paysan (py)
   
 \ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2004,2005,2006,2007,2009,2010 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2004,2005,2006,2007,2009,2010,2011 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 2968  DO:  abort" Not in cross mode" ;DO Line 2968  DO:  abort" Not in cross mode" ;DO
   
 \ Mini-OOF  \ Mini-OOF
   
 \ Builder method  Builder method
 \ Build: ( m v -- m' v )  over T , swap cell+ swap H ;Build  Build: ( m v -- m' v )  over T , swap cell+ swap H ;Build
 \ DO:  abort" Not in cross mode" ;DO  DO:  abort" Not in cross mode" ;DO
   
 \ Builder var  Builder var
 \ Build: ( m v size -- m v+size )  over T , H + ;Build  Build: ( m v size -- m v+size )  over T , H + ;Build
 \ DO: ( o -- addr ) T @ H + ;DO  DO: ( o -- addr ) T @ H + ;DO
   
 \ Builder end-class  Builder end-class
 \ Build: ( addr m v -- )  Build: ( addr m v -- )
 \   T here >r , dup , 2 cells H ?DO T ['] noop , 1 cells H +LOOP     T here >r , dup , 2 cells H ?DO T ['] noop , 1 cells H +LOOP
 \   T cell+ dup cell+ r> rot @ 2 cells /string move H ;Build     T cell+ dup cell+ r> rot @ 2 cells /string move H ;Build
 \ by: Variable  by Create
   
 \ : defines ( xt class -- )  T ' >body @ + ! H ;  : class ( class -- class methods vars ) dup T 2@ H ;
   : defines ( xt class -- )  T ' >body @ + ! H ;
   
 \ Peephole optimization                                 05sep01jaw  \ Peephole optimization                                 05sep01jaw
   
Line 3067  compile: does-resolved ;compile Line 3068  compile: does-resolved ;compile
 \ : ?struc      ( flag -- )       ABORT" CROSS: unstructured " ;  \ : ?struc      ( flag -- )       ABORT" CROSS: unstructured " ;
 \ : sys?        ( sys -- sys )    dup 0= ?struc ;  \ : sys?        ( sys -- sys )    dup 0= ?struc ;
   
 : >mark       ( -- sys )        T here  ( dup ." M" hex. ) 0 , H ;  : >mark       ( -- sys )        T here  0 , H ;
   
 X has? abranch [IF]  X has? abranch [IF]
     : branchoffset ( src dest -- )  drop ;      : branchoffset ( src dest -- )  drop ;

Removed from v.1.177  
changed lines
  Added in v.1.180


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>