--- gforth/arch/4stack/prim-new.fs	1997/05/29 19:42:44	1.1
+++ gforth/arch/4stack/prim-new.fs	2008/11/01 22:19:30	1.7
@@ -1,5 +1,22 @@
 \ 4stack primitives
 
+\ Copyright (C) 2000,2007,2008 Free Software Foundation, Inc.
+
+\ This file is part of Gforth.
+
+\ Gforth is free software; you can redistribute it and/or
+\ modify it under the terms of the GNU General Public License
+\ as published by the Free Software Foundation, either version 3
+\ of the License, or (at your option) any later version.
+
+\ This program is distributed in the hope that it will be useful,
+\ but WITHOUT ANY WARRANTY; without even the implied warranty of
+\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+\ GNU General Public License for more details.
+
+\ You should have received a copy of the GNU General Public License
+\ along with this program. If not, see http://www.gnu.org/licenses/.
+
 Label start  ;;
 nop          ;; first opcode must be a nop!
 $80000000 ## ;;
@@ -55,7 +72,11 @@ docon:  .endif ;;
 	nop      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;
 end-code
 
--3 Alias: :docon
+-2 Doer: :docol
+-3 Doer: :docon
+-4 Doer: :dovar
+-8 Doer: :dodoes
+-9 Doer: :doesjump
 
 Code execute ( xt -- )
 	nop      nop       nop      ip@       br .endif
@@ -154,23 +175,6 @@ Code (emit)
 	nop      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;
 end-code
 
-: (type)
-    bounds ?DO  I c@ (emit)  LOOP ;
-\    BEGIN  dup  WHILE
-\	>r dup c@ (emit) 1+ r> 1-  REPEAT  2drop ;
-
-\ obligatory code address manipulations
-
-: >code-address ( xt -- addr )  cell+ @ -8 and ;
-: >does-code    ( xt -- addr )
-    cell+ @ -8 and \ dup 3 and 3 <> IF  drop 0  EXIT  THEN
-    8 + dup cell - @ 3 and 0<> and ;
-: code-address! ( addr xt -- )  >r 3 or $808 @ r> 2! ;
-: does-code!    ( a_addr xt -- )  >r 5 - $808 @ r> 2! ;
-: does-handler! ( a_addr -- )  $818 2@ rot 2! ;
-
-\ this was obligatory, now some things to speed it up
-
 Code 2/
 	asr      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;
 end-code
@@ -400,6 +404,23 @@ Code (find-samelen)
 	nop      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;
 end-code
 
+\ obligatory code address manipulations
+
+: >code-address ( xt -- addr )  cell+ @ -8 and ;
+: >does-code    ( xt -- addr )
+    cell+ @ -8 and \ dup 3 and 3 <> IF  drop 0  EXIT  THEN
+    8 + dup cell - @ 3 and 0<> and ;
+: code-address! ( addr xt -- )  >r 3 or $808 @ r> 2! ;
+: does-code!    ( a_addr xt -- )  >r 5 - $808 @ r> 2! ;
+: does-handler! ( a_addr -- )  $818 2@ rot 2! ;
+
+\ this was obligatory, now some things to speed it up
+
+: (type)
+    bounds ?DO  I c@ (emit)  LOOP ;
+\    BEGIN  dup  WHILE
+\	>r dup c@ (emit) 1+ r> 1-  REPEAT  2drop ;
+
 \ division a/b
 \ x:=a, y:=b, r:=est; iterate(x:=x*r, y:=y*r, r:=2-y*r);
 \ result: x=a/b; y=1; r=1