Commit: e1e44e82d09c4a090d82195ddd07e19bbe97036e - fig_sh (git)

Implementing figFORTH on SH3 assembler

Commit MetaInfo

• Revision: e1e44e82d09c4a090d82195ddd07e19bbe97036e (tree)
• Time: 2014-03-07 14:08:02
• Author: Joel Matthew Rees <reiisi@user...>
• Commiter: Joel Matthew Rees

Log Message

U*, U/ (buggy)

Change Summary

• modified: context.inc
• modified: evaluator.inc
• modified: inout.inc
• modified: main.src
• modified: primitive.inc
• modified: symbol.inc

Incremental Difference

--- a/context.inc
+++ b/context.inc
@@ -33,11 +33,61 @@
 
 	.cpu	sh3
 
+; For huge things, like U/ (USLASH)
+PRIORITY_SIZE:	.DEFINE	"1"
+
+
 NATURAL_SIZE:	.equ	4	; 4 byte word
 HALF_SIZE:		.equ	( NATURAL_SIZE / 2 )
 ALIGN_MASK: 	.equ	( H'FF & ~(NATURAL_SIZE - 1) )
 ALL_BITS8:		.equ	( H'FF & -1 )
 
+; byte offsets for various parts of significance
+; In the SH3, natural width is 32 bits, half-width is 16, byte is 8.
+;
+	.AIFDEF	_LIT	; (least significant byte first)
+LSHALF:			.equ	0
+LSBYTEinNAT:	.equ	0
+LSBYTEinHALF:	.equ	0
+MSHALF:			.equ	HALF_SIZE
+MSBYTEinNAT:	.equ	( NATURAL_SIZE - 1 )
+MSBYTEinHALF:	.equ	( HALF_SIZE - 1 )
+	.AELSE	; _BIG is default	; (most significant byte first)
+LSHALF:			.equ	HALF_SIZE
+LSBYTEinNAT:	.equ	( NATURAL_SIZE - 1 )
+LSBYTEinHALF:	.equ	( HALF_SIZE - 1 )
+MSHALF:			.equ	0
+MSBYTEinNAT:	.equ	0
+MSBYTEinHALF:	.equ	0
+	.AENDI
+; 
+; Convenience definitions? -- Or just confusing?
+BYTE_hLO_bLO:	.equ	LSBYTEinNAT
+BYTE_hLO_bHI:	.equ	( LSHALF + MSBYTEinHALF )	; high byte of low half
+BYTE_hHI_bLO:	.equ	( MSHALF + LSBYTEinHALF )	; low byte of high half
+BYTE_hHI_bHI:	.equ	MSBYTEinNAT
+;
+; The word "word" is soooooo confusing! 
+; (Word == half in many people's minds, but "word" has other meanings, especially here.)
+; (Long == natural in many people's minds, but what happens when 64 bits happen?)
+;
+; ******************************************************************************
+; *             ***** VERY IMPORTANT NOTE on byte/word order *****
+; * 
+; * FORTH allows the CPU's natural byte order. 
+; *
+; * ****** BUT! ******
+; *
+; * fig-FORTH assumes that 
+; * DOUBLE natural width integers 
+; * will be Most-Significant-word-First in memory.
+; * 
+; * So, even on CPUs running least-significant-byte-first, 
+; * DOUBLE words will still be stored most-significant-natural-word-first.
+; * 
+; * (Don't play games with this. It's bad mojo.)
+; ******************************************************************************
+
 
 ; The SH-3 has modern dev tools, so we don't have to pay much attention 
 ; to memory layout,
@@ -214,9 +264,9 @@ _s\characteristic:	.sdata	.substr("\name", 0, .len("\name")-1)
 _PREVNAME:	.assign _s\characteristic
 ; Point to the characteristic code for this Word (symbol) to execute.
 \characteristic	.equ	$
-	.data.l	_p\characteristic
+	.data.l	_f\characteristic
 ; Point to the "parameter" area of the symbol.
-_p\characteristic	.equ $
+_f\characteristic	.equ $
 ; This area will contain executable code for primitive (leaf) definitions.
 ; It will contain a list of virtual instructions for non-primitive (non-leaf) definitions.
 ; For language global/static constants and variables, it will contain the actual value.
@@ -240,6 +290,13 @@ exit\@:
 	.endm
 
 
+; Utility macros:
+; These should help reduce errors.
+	.macro	mTARGET	target
+	.data.l	\target-$-NATURAL_SIZE
+	.endm
+
+
 ; Convenience macros:
 ; *** Use these instead of stealing code. 
 ; Branch to address is limited to +- 4k, 

--- a/evaluator.inc
+++ b/evaluator.inc
@@ -41,31 +41,161 @@
 ; U*      ( u1 u2 --- ud )
 ;         Multiplies the top two unsigned integers, yielding a double
 ;         integer product.
-;         SH3 MAC is a signed multiply/add, so we can't cheat on U*.
-;         If we cheat and use memory access to grab half words, 
-;         we have to know whether we are LSB or MSB first.
+;
+;         Rejoice, there is a double unsigned multiply! 
+;
+;         ***** FORTH order for double wide is most-significant-first!
 ;
 	HEADER	U*, USTAR
-	.AIFDEF	_LIT
-	mov.w	@fSP, r0
-	mov.w	@(NATURAL_SIZE,fSP), r1
-	.etc
-	.AELSE	; _BIG is default
-	mov.w	@(HALF_SIZE,fSP), r0
-	mov.w	@(NATURAL_SIZE+HALF_SIZE,fSP), r1
+	mov.l	@fSP+, r1
+	mov.l	@fSP+, r0
+	dmulu.l	r1, r0
+	sts.l	macl, @-fSP
+	rts
+	sts.l	mach, @-fSP
 	
-	.AENDI
+
+; Put this close to the test, so that we don't worry about the .AREPEAT
+PUDIVover:
+	mov.b	#-1, r0		; Or we could trap this, if we take the time to define traps.
+	mov.l	r0, @fSP
+	rts
+	mov.l	r0, @(NATURAL_SIZE,fSP)
+;
+; (UDIV)  ( ud u --- uquotient )
+;         Divides the top unsigned integer into the second and third words
+;         on the stack as a single unsigned double integer, 
+;         leaving only the quotient as an unsigned integer.
+; 
+;		  The smaller the divisor, the more likely dropping the high word 
+;		  of the quotient loses significant bits.
+;
+;         The SH3 manual seems to indicate that we can't trust the remainder
+;         to remain a true remainder to the end.
+;         It strongly recommends using multiply-subtract instead, 
+;         to get the remainder.
+;
+;         ***** FORTH order for double wide is most-significant-first!
+;
+	.AIFDEF	PRIORITY_SIZE
+DIVIDELENGTH:	.DEFINE	"16"		; repeat count * 2 cycles * count in r3
+	.AELSE
+DIVIDELENGTH:	.DEFINE	"32"		; repeat count * 2 cycles
+	.AENDI
+;
+	HEADER	(UDIV), PUDIV
+	mov.l	@fSP+, r2	; divisor
+	mov.l	@fSP+, r0	; dividend high part
+	cmp/hs	r2, r0		; zero divide or overflow?
+	bt  	PUDIVover
+	mov.l	@fSP, r1	; dividend low part
+	.AIFDEF	PRIORITY_SIZE
+	mov.b	#2, r3		; Trade speed for size
+	.AENDI
+	div0u	; Get the flags ready
+PUDIVloop:
+	.AREPEAT	DIVIDELENGTH
+	rotcl	r1
+	div1	r2, r0
+	.AENDR
+	.AIFDEF	PRIORITY_SIZE
+	dt		r3			; + 4 cycles * count in r3
+	bf  	PUDIVloop
+	.AENDI
+	rotcl	r1
+	rts
+	mov.l	r1, @fSP
+
+
+; U/      ( ud u --- uremainder uquotient )
+;         Divides the top unsigned integer into the second and third words
+;         on the stack as a single unsigned double integer, leaving the
+;         remainder and quotient (quotient on top) as unsigned integers.
+;		
+;		  The smaller the divisor, the more likely dropping the high word 
+;		  of the quotient loses significant bits.
+;
+;         ***** FORTH order for double wide is most-significant-first!
+;
+	HEADER	U/, USLASH
+	mov.l	@(2*NATURAL_SIZE,fSP), r0
+	mov.l	r0, @-fSP
+	mov.l	@(2*NATURAL_SIZE,fSP), r0
+	mov.l	r0, @-fSP
+	mov.l	@(2*NATURAL_SIZE,fSP), r0
+	bsr 	_fPUDIV
+	mov.l	r0, @-fSP		; Save the divisor as we go.
+; 
+	mov.l	@fSP+, fW	; grab the quotient
+	mov		fW, r2
+	mov.l	@fSP+, r1	; grab the divisor
+	dmulu.l	r1, r2		; multiply quotient * divisor
+	sts.l	macl, @-fSP
+	bsr 	_fDSUB
+	sts.l	mach, @-fSP	; Store most significant as we go.
+; 
+	mov.l	@fSP, r0	; remainder
+	mov.l	r0, @(NATURAL_SIZE,fSP)
+	rts
+	mov.l	fW, @fSP
+
 
 ; +       ( n1 n2 --- n1+n2 )
 ;         Add top two words.
 ;
 	HEADER	+, PLUS
-	mov.l	@fSP+, r0
-	mov.l	@fSP, r1
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
 	add 	r1, r0
 	rts
 	mov.l	r0, @fSP
 	
 
+; D+       ( d1 d2 --- d1+d2 )
+;         Add top two double words, leaving the double sum.
+;
+;         ***** FORTH order for double wide is most-significant-first!
+;
+	HEADER	D+, DPLUS
+	mov.l	@fSP+, r2	; high part
+	mov.l	@fSP+, r3	; low part
+	mov.l	@(NATURAL_SIZE,fSP), r1	; high part
+	mov.l	@fSP, r0	; low part
+	clrt
+	addc	r3, r1
+	addc	r2, r0
+	mov.l	r1, @(NATURAL_SIZE,fSP)
+	rts
+	mov.l	r0, @fSP
+	
 
+; -       ( n1 n2 --- n1-n2 )
+;         Subtract top word from second, leaving the difference.
+;
+	HEADER	-, SUB
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
+	sub 	r1, r0
+	rts
+	mov.l	r0, @fSP
+	
+
+; D-       ( d1 d2 --- d1+d2 )
+;         Subtract top double from second, leaving the double difference.
+;
+;         ***** FORTH order for double wide is most-significant-first!
+;
+	HEADER	D-, DSUB
+	mov.l	@fSP+, r2	; high part
+	mov.l	@fSP+, r3	; low part
+	mov.l	@(NATURAL_SIZE,fSP), r1	; high part
+	mov.l	@fSP, r0	; low part
+	clrt
+	subc	r3, r1
+	subc	r2, r0
+	mov.l	r1, @(NATURAL_SIZE,fSP)
+	rts
+	mov.l	r0, @fSP
+
+
 

--- a/inout.inc
+++ b/inout.inc
@@ -28,12 +28,14 @@
 ;         Increment the OUT per USER variable.
 ;
 	HEADER	EMIT, EMIT
-	mov.l	#PEMIT, r1	; May be within range of absolute call?
+	sts.l	PR, @-fRP
+	mov.l	#_fPEMIT, r1	; May be within range of absolute call?
 	jsr 	@r1
 	nop
 	mov.l	#XOUT, r0	; We defined XOUT as the offset itself.
 	mov.l	@(r0,fUP), r1
 	add 	#1, r1
+	lds.l	@fRP+, PR
 	rts
 	mov.l	r1, @(r0,fUP)
 	
@@ -42,12 +44,14 @@
 ;         Leave the ascii value of the next terminal key struck.
 ;
 	HEADER	KEY, KEY
-	mov.l	#PKEY, r1	; May be within range of absolute call?
+	sts.l	PR, @-fRP
+	mov.l	#_fPKEY, r1	; May be within range of absolute call?
 	jsr 	@r1
 	nop
 	mov.l	@fSP, r1
 	mov.l	#H'000000ff, r0
 	and 	r1, r0
+	lds.l	@fRP+, PR
 	rts
 	mov.l	r0, @fSP
 
@@ -62,9 +66,11 @@
 ;        and may not give exactly these results.
 ;
 	HEADER	?TERMINAL, QTERM
-	mov.l	#PQTER, r1	; May be within range of absolute call?
+	sts.l	PR, @-fRP
+	mov.l	#_fPQTER, r1	; May be within range of absolute call?
 	jsr 	@r1
 	nop		; Might need to filter results?
+	lds.l	@fRP+, PR
 	rts
 	nop
 
@@ -74,9 +80,11 @@
 ;         device.
 ;
 	HEADER	CR, CR
-	mov.l	#PCR, r1	; May be within range of absolute call?
+	sts.l	PR, @-fRP
+	mov.l	#_fPCR, r1	; May be within range of absolute call?
 	jsr 	@r1
 	nop		; Might push a CR and EMIT, then a LF and EMIT?
+	lds.l	@fRP+, PR
 	rts
 	nop
 

--- a/main.src
+++ b/main.src
@@ -5,9 +5,10 @@
 ; 2014.02.28
 
 	.include	"context.inc"
-	
+
 
 	.section	main,    code,  locate=h'8c000000
+
 	.org	$
 COLD:
 	mov.l	#PER_USER, fUP
@@ -19,13 +20,39 @@ COLD:
 	nop
 	
 TEST_THINGY:
-	.data.l	LIT
-	.data.l	1
-	.data.l	LIT
-	.data.l	-1
+	.data.l	LIT, 1
+	.data.l	LIT, -1
+	.data.l BRAN
+	mTARGET BRAN_THINGY
+	.data.l 4, 3, 2, 1, 0	; should branch over these
+BRAN_THINGY:
 	.data.l	PLUS
+	.data.l ZBRAN
+	mTARGET ZBRAN_THINGY0
+	.data.l 0, 1, 2, 3	; should branch over these
+ZBRAN_THINGY0:
+	.data.l LIT, 20
+	.data.l LIT, 19
+	.data.l SUB
+	.data.l ZBRAN
+	mTARGET ZBRAN_THINGY0
+	.data.l LIT, 15
+	.data.l	LIT, 10
+	.data.l XDO
+LOOP_THINGY:
+	.data.l LIT, "*"
+	.data.l EMIT
+	.data.l XLOOP
+	mTARGET LOOP_THINGY
+	.data.l LIT, h'f0f0f0f0
+	.data.l LIT, h'0f0f0f0f
+	.data.l USTAR
+	.data.l LIT, h'10010000
+	.data.l LIT, h'10011001
+	.data.l LIT, h'10010
+	.data.l USLASH
 	.data.l	BRAN
-	.data.l $+NATURAL_SIZE-TEST_THINGY
+	mTARGET TEST_THINGY
 
 	
 ; For various reasons, including the above "locate" declaration, 
@@ -48,12 +75,12 @@ PER_USER:	.equ $
 	
 	.section	pstack,  stack, locate=PER_USER+h'E000
 fSP_LIMIT:	.equ $
-	.res.b		h'1800
+	.res.b		h'1F00
 fSP_BASE:	.equ $
 
-	.section	rstack,  stack, locate=h'8c01F800
+	.section	rstack,  stack, locate=h'8c01FF00
 fRP_LIMIT:	.equ $
-	.res.b		h'800
+	.res.b		h'100
 fRP_BASE:	.equ $
 	
 	.section	thevoid, dummy, locate=h'8c020000

--- a/primitive.inc
+++ b/primitive.inc
@@ -171,17 +171,18 @@ XPLOOPminus:
 ;
 	HEADER	CMOVE, CMOVE
 	mov.l	@fSP, r0					; count
+	cmp/eq	#0, r0
+	bt  	CMOVEdone
 	mov.l	@(NATURAL_SIZE,fSP), r2		; target
-	bra 	CMOVEenter
-	mov.l	@(2*NATURAL_SIZE,fSP), r1	; source (as we jump)
+	mov.l	@(2*NATURAL_SIZE,fSP), r1	; source
 CMOVEloop:
 	mov.b	@r1+, r3
-	mov.b	r3, @r2+
-	add 	#-1, r0
-CMOVEenter:
-	cmp/eq	#0, r0
-	bf  	CMOVEloop
+	mov.b	r3, @r2
+	dt  	r0
+	bf/s  	CMOVEloop
+	add 	#1, r2		; Inc as we loop, since there is no auto-inc store.
 ;
+CMOVEdone:
 	rts
 	add 	#3*NATURAL_SIZE, fSP	; Drop the parameters as we go.
 

--- a/symbol.inc
+++ b/symbol.inc
@@ -62,7 +62,7 @@ PCHKNAMEloop:
 PCHKNAMEno:
 	mov 	#0, r3		; r3 is not touched by xNAMESCAN
 PCHKNAMEret:
-	bsr 	PNAMESCAN
+	bsr 	_fPNAMESCAN
 	mov.l	r2, @fSP	; save it as we go
 	lds.l	@fRP+, pr	; Gotta have that return address!
 	rts
@@ -90,7 +90,7 @@ PCHKNAMElast:
 	mov.l	@fSP, r0
 PFINDloop:
 	mov.b	@r0, fW		; We aren't using fW anyway, and it doesn't get walked in.
-	bsr 	PCHKNAME
+	bsr 	_fPCHKNAME
 	mov.l	@fSP+, r0	; Did we find it?
 	cmp/eq	#0, r0
 	bf/s  	PFINDfound	; Use the true flag in r0