version 1.175, 2010/12/31 18:09:02
|
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 765 Plugin ?do, ( -- ?do-token )
|
Line 765 Plugin ?do, ( -- ?do-token )
|
Plugin for, ( -- for-token ) |
Plugin for, ( -- for-token ) |
Plugin loop, ( do-token / ?do-token -- ) |
Plugin loop, ( do-token / ?do-token -- ) |
Plugin +loop, ( do-token / ?do-token -- ) |
Plugin +loop, ( do-token / ?do-token -- ) |
|
Plugin -loop, ( do-token / ?do-token -- ) |
Plugin next, ( for-token ) |
Plugin next, ( for-token ) |
Plugin leave, ( -- ) |
Plugin leave, ( -- ) |
Plugin ?leave, ( -- ) |
Plugin ?leave, ( -- ) |
Line 1726 T has? relocate H
|
Line 1727 T has? relocate H
|
|
|
Ghost (do) Ghost (?do) 2drop |
Ghost (do) Ghost (?do) 2drop |
Ghost (for) drop |
Ghost (for) drop |
Ghost (loop) Ghost (+loop) 2drop |
Ghost (loop) Ghost (+loop) Ghost (-loop) 2drop drop |
Ghost (next) drop |
Ghost (next) drop |
Ghost !does drop |
Ghost !does drop |
Ghost compile, drop |
Ghost compile, drop |
Line 2965 Builder input-var
|
Line 2966 Builder input-var
|
Build: ( m v size -- m v' ) over T , H + ;Build |
Build: ( m v size -- m v' ) over T , H + ;Build |
DO: abort" Not in cross mode" ;DO |
DO: abort" Not in cross mode" ;DO |
|
|
|
\ Mini-OOF |
|
|
|
Builder method |
|
Build: ( m v -- m' v ) over T , swap cell+ swap H ;Build |
|
DO: abort" Not in cross mode" ;DO |
|
|
|
Builder var |
|
Build: ( m v size -- m v+size ) over T , H + ;Build |
|
DO: ( o -- addr ) T @ H + ;DO |
|
|
|
Builder end-class |
|
Build: ( addr m v -- ) |
|
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 |
|
by Create |
|
|
|
: class ( class -- class methods vars ) dup T 2@ H ; |
|
: defines ( xt class -- ) T ' >body @ + ! H ; |
|
|
\ Peephole optimization 05sep01jaw |
\ Peephole optimization 05sep01jaw |
|
|
\ this section defines different compilation |
\ this section defines different compilation |
Line 3048 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 ; |
Line 3233 Cond: ENDCASE endcase, ;Cond
|
Line 3253 Cond: ENDCASE endcase, ;Cond
|
1to compile (+loop) loop] |
1to compile (+loop) loop] |
compile unloop skiploop] ; ' (+loop,) plugin-of +loop, |
compile unloop skiploop] ; ' (+loop,) plugin-of +loop, |
|
|
|
: (-loop,) ( target-addr -- ) |
|
1to compile (-loop) loop] |
|
compile unloop skiploop] ; ' (-loop,) plugin-of -loop, |
|
|
: (next,) |
: (next,) |
compile (next) loop] compile unloop ; ' (next,) plugin-of next, |
compile (next) loop] compile unloop ; ' (next,) plugin-of next, |
|
|
Line 3242 Cond: FOR for, ;Cond
|
Line 3266 Cond: FOR for, ;Cond
|
|
|
Cond: LOOP 1 ncontrols? loop, ;Cond |
Cond: LOOP 1 ncontrols? loop, ;Cond |
Cond: +LOOP 1 ncontrols? +loop, ;Cond |
Cond: +LOOP 1 ncontrols? +loop, ;Cond |
|
Cond: -LOOP 1 ncontrols? -loop, ;Cond |
Cond: NEXT 1 ncontrols? next, ;Cond |
Cond: NEXT 1 ncontrols? next, ;Cond |
|
|
\ String words 23feb93py |
\ String words 23feb93py |