Commits

rich  committed dccbff0

Fix ROT/-ROT (Ian Osgood).

  • Participants
  • Parent commits 092aa51

Comments (0)

Files changed (3)

File jonesforth.S

 /*	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
 */
 	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

File jonesforth.f

 \	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
 \
 
 ( 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 )
 	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
 	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 )
 : ? ( 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 -- )
 		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
 		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 )
 : 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 )
 : 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? )
 ;
 
 : 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 )

File test_stack.f

 	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