From dccbff0e169d5467a78be5c6d935fa505f6a029f Mon Sep 17 00:00:00 2001
From: rich <rich>
Date: Fri, 11 Sep 2009 08:32:32 +0000
Subject: [PATCH] Fix ROT/-ROT (Ian Osgood).

---
 jonesforth.S |  6 +++---
 jonesforth.f | 36 +++++++++++++++++-------------------
 test_stack.f |  2 +-
 3 files changed, 21 insertions(+), 23 deletions(-)

diff --git a/jonesforth.S b/jonesforth.S
index 8b02f1b..c7f777c 100644
--- a/jonesforth.S
+++ b/jonesforth.S
@@ -1,7 +1,7 @@
 /*	A sometimes minimal FORTH compiler and tutorial for Linux / i386 systems. -*- asm -*-
 	By Richard W.M. Jones <rich@annexia.org> http://annexia.org/forth
 	This is PUBLIC DOMAIN (see public domain release statement below).
-	$Id: jonesforth.S,v 1.45 2007-10-22 18:53:13 rich Exp $
+	$Id: jonesforth.S,v 1.46 2009-09-11 08:32:32 rich Exp $
 
 	gcc -m32 -nostdlib -static -Wl,-Ttext,0 -Wl,--build-id=none -o jonesforth jonesforth.S
 */
@@ -716,18 +716,18 @@ code_\label :			// assembler code follows
 	pop %eax
 	pop %ebx
 	pop %ecx
+	push %ebx
 	push %eax
 	push %ecx
-	push %ebx
 	NEXT
 
 	defcode "-ROT",4,,NROT
 	pop %eax
 	pop %ebx
 	pop %ecx
-	push %ebx
 	push %eax
 	push %ecx
+	push %ebx
 	NEXT
 
 	defcode "2DROP",5,,TWODROP // drop top two elements of stack
diff --git a/jonesforth.f b/jonesforth.f
index e5718ea..5c13095 100644
--- a/jonesforth.f
+++ b/jonesforth.f
@@ -2,7 +2,7 @@
 \	A sometimes minimal FORTH compiler and tutorial for Linux / i386 systems. -*- asm -*-
 \	By Richard W.M. Jones <rich@annexia.org> http://annexia.org/forth
 \	This is PUBLIC DOMAIN (see public domain release statement below).
-\	$Id: jonesforth.f,v 1.17 2007-10-12 20:07:44 rich Exp $
+\	$Id: jonesforth.f,v 1.18 2009-09-11 08:32:33 rich Exp $
 \
 \	The first part of this tutorial is in jonesforth.S.  Get if from http://annexia.org/forth
 \
@@ -249,7 +249,7 @@
 
 ( Some more complicated stack examples, showing the stack notation. )
 : NIP ( x y -- y ) SWAP DROP ;
-: TUCK ( x y -- y x y ) DUP ROT ;
+: TUCK ( x y -- y x y ) SWAP OVER ;
 : PICK ( x_u ... x_1 x_0 u -- x_u ... x_1 x_0 x_u )
 	1+		( add one because of 'u' on the stack )
 	4 *		( multiply by the word size )
@@ -349,7 +349,7 @@
 	SWAP		( width u )
 	DUP		( width u u )
 	UWIDTH		( width u uwidth )
-	-ROT		( u uwidth width )
+	ROT		( u uwidth width )
 	SWAP -		( u width-uwidth )
 	( At this point if the requested width is narrower, we'll have a negative number on the stack.
 	  Otherwise the number on the stack is the number of spaces to print.  But SPACES won't print
@@ -368,18 +368,18 @@
 	DUP 0< IF
 		NEGATE		( width u )
 		1		( save a flag to remember that it was negative | width n 1 )
-		ROT		( 1 width u )
-		SWAP		( 1 u width )
+		SWAP		( width 1 u )
+		ROT		( 1 u width )
 		1-		( 1 u width-1 )
 	ELSE
 		0		( width u 0 )
-		ROT		( 0 width u )
-		SWAP		( 0 u width )
+		SWAP		( width 0 u )
+		ROT		( 0 u width )
 	THEN
 	SWAP		( flag width u )
 	DUP		( flag width u u )
 	UWIDTH		( flag width u uwidth )
-	-ROT		( flag u uwidth width )
+	ROT		( flag u uwidth width )
 	SWAP -		( flag u width-uwidth )
 
 	SPACES		( flag u )
@@ -402,8 +402,9 @@
 : ? ( addr -- ) @ . ;
 
 ( c a b WITHIN returns true if a <= c and c < b )
+(  or define without ifs: OVER - >R - R>  U<  )
 : WITHIN
-	ROT		( b c a )
+	-ROT		( b c a )
 	OVER		( b c a c )
 	<= IF
 		> IF		( b c -- )
@@ -828,7 +829,7 @@
 		LATEST @ 128 DUMP
 )
 : DUMP		( addr len -- )
-	BASE @ ROT		( save the current BASE at the bottom of the stack )
+	BASE @ -ROT		( save the current BASE at the bottom of the stack )
 	HEX			( and switch to hexadecimal mode )
 
 	BEGIN
@@ -868,12 +869,9 @@
 		CR
 
 		DUP 1- 15 AND 1+ ( addr len linelen )
-		DUP		( addr len linelen linelen )
-		ROT		( addr linelen len linelen )
+		TUCK		( addr linelen len linelen )
 		-		( addr linelen len-linelen )
-		ROT		( len-linelen addr linelen )
-		+		( len-linelen addr+linelen )
-		SWAP		( addr-linelen len-linelen )
+		>R + R>		( addr+linelen len-linelen )
 	REPEAT
 
 	DROP			( restore stack )
@@ -1572,7 +1570,7 @@
 : R/W ( -- fam ) O_RDWR ;
 
 : OPEN-FILE	( addr u fam -- fd 0 (if successful) | c-addr u fam -- fd errno (if there was an error) )
-	ROT		( fam addr u )
+	-ROT		( fam addr u )
 	CSTRING		( fam cstring )
 	SYS_OPEN SYSCALL2 ( open (filename, flags) )
 	DUP		( fd fd )
@@ -1586,9 +1584,9 @@
 : CREATE-FILE	( addr u fam -- fd 0 (if successful) | c-addr u fam -- fd errno (if there was an error) )
 	O_CREAT OR
 	O_TRUNC OR
-	ROT		( fam addr u )
+	-ROT		( fam addr u )
 	CSTRING		( fam cstring )
-	420 ROT		( 0644 fam cstring )
+	420 -ROT	( 0644 fam cstring )
 	SYS_OPEN SYSCALL3 ( open (filename, flags|O_TRUNC|O_CREAT, 0644) )
 	DUP		( fd fd )
 	DUP 0< IF	( errno? )
@@ -1604,7 +1602,7 @@
 ;
 
 : READ-FILE	( addr u fd -- u2 0 (if successful) | addr u fd -- 0 0 (if EOF) | addr u fd -- u2 errno (if error) )
-	ROT SWAP -ROT	( u addr fd )
+	>R SWAP R>	( u addr fd )
 	SYS_READ SYSCALL3
 
 	DUP		( u2 u2 )
diff --git a/test_stack.f b/test_stack.f
index e8e558d..1c4563d 100644
--- a/test_stack.f
+++ b/test_stack.f
@@ -7,8 +7,8 @@
 	23 DROP DEPTH . CR
 	1 2 SWAP . . CR
 	1 2 OVER . . . CR
-	1 2 3 ROT . . . CR
 	1 2 3 -ROT . . . CR
+	1 2 3 ROT . . . CR
 	1 2 3 4 2DROP . . CR
 	1 2 3 4 2DUP . . . . . . CR
 	1 2 3 4 2SWAP . . . . CR
-- 
1.8.3.1