--- gforth/cross.fs	2009/03/24 08:55:29	1.167
+++ gforth/cross.fs	2011/12/31 15:29:25	1.179
@@ -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,2004,2005,2006,2007 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.
 
@@ -765,6 +765,7 @@ Plugin ?do,	( -- ?do-token )
 Plugin for,	( -- for-token )
 Plugin loop,	( do-token / ?do-token -- )
 Plugin +loop,	( do-token / ?do-token -- )
+Plugin -loop,	( do-token / ?do-token -- )
 Plugin next,	( for-token )
 Plugin leave,	( -- )
 Plugin ?leave, 	( -- )
@@ -1726,9 +1727,9 @@ T has? relocate H
 
 Ghost (do)      Ghost (?do)                     2drop
 Ghost (for)                                     drop
-Ghost (loop)    Ghost (+loop)                   2drop
+Ghost (loop)    Ghost (+loop)   Ghost (-loop)   2drop drop
 Ghost (next)                                    drop
-Ghost (does>)   Ghost (does>1)  Ghost (does>2)  2drop drop
+Ghost !does                                     drop
 Ghost compile,                                  drop
 Ghost (.")      Ghost (S")      Ghost (ABORT")  2drop drop
 Ghost (C")      Ghost c(abort") Ghost type      2drop drop
@@ -2412,14 +2413,11 @@ T 2 cells H Value xt>body
   there xt>body + ca>native T a, H 1 fillcfa ;		' (doprim,) plugin-of doprim,
 
 : (doeshandler,) ( -- ) 
-  T cfalign H [G'] :doesjump addr, T 0 , H ; 		' (doeshandler,) plugin-of doeshandler,
+    T H ; 					' (doeshandler,) plugin-of doeshandler,
 
 : (dodoes,) ( does-action-ghost -- )
   ]comp [G'] :dodoes addr, comp[
   addr,
-  \ the relocator in the c engine, does not like the
-  \ does-address to marked for relocation
-  [ T e? ec H 0= [IF] ] T here H tcell - reloff [ [THEN] ]
   2 fillcfa ;						' (dodoes,) plugin-of dodoes,
 
 : (dlit,) ( n -- ) compile lit td, ;			' (dlit,) plugin-of dlit,
@@ -2652,7 +2650,7 @@ T has? primcentric H [IF]
 >TARGET
 Cond: DOES>
         T here H [ T has? primcentric H [IF] ] 5 [ [ELSE] ] 4 [ [THEN] ] T cells
-        H + alit, compile (does>2) compile ;s
+        H + alit, compile !does compile ;s
         doeshandler, resolve-does>-part
         ;Cond
 
@@ -2949,6 +2947,15 @@ by (Field)
     T 1 cells H dup ;
 >CROSS
 
+\ ABI-CODE support
+Builder (ABI-CODE)
+Build: ;Build
+by: :doabicode noop ;DO
+
+BUILDER (;abi-code)
+Build: ;Build
+by: :do;abicode noop ;DO
+
 \ Input-Methods                                            01py
 
 Builder input-method
@@ -2959,6 +2966,25 @@ Builder input-var
 Build: ( m v size -- m v' )  over T , H + ;Build
 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
 
 \ this section defines different compilation
@@ -3227,6 +3253,10 @@ Cond: ENDCASE   endcase, ;Cond
   1to compile (+loop)  loop] 
   compile unloop skiploop] ;			' (+loop,) plugin-of +loop,
 
+: (-loop,) ( target-addr -- )
+  1to compile (-loop)  loop] 
+  compile unloop skiploop] ;			' (-loop,) plugin-of -loop,
+
 : (next,) 
   compile (next)  loop] compile unloop ;	' (next,) plugin-of next,
 
@@ -3236,6 +3266,7 @@ Cond: FOR	for, ;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
 
 \ String words                                         23feb93py
@@ -3310,7 +3341,7 @@ Cond: postpone ( -- ) \ name
 hex
 
 >CROSS
-Create magic  s" Gforth3x" here over allot swap move
+Create magic  s" Gforth4x" here over allot swap move
 
 bigendian 1+ \ strangely, in magic big=0, little=1
 tcell 1 = 0 and or