Commit: dea0f6fa9cda295be8b1307f79d40c74f0c478ee - fig_sh (git)

Implementing figFORTH on SH3 assembler

Commit MetaInfo

• Revisión: dea0f6fa9cda295be8b1307f79d40c74f0c478ee (tree)
• Tiempo: 2014-03-10 21:11:07
• Autor: Joel Matthew Rees <reiisi@user...>
• Commiter: Joel Matthew Rees

Log Message

U/ fixed, more tests, added through definition 26 (or so?)

Cambiar Resumen

• modified: evaluator.inc
• modified: initialize.inc
• modified: main.src
• modified: primitive.inc

Diferencia incremental

--- a/evaluator.inc
+++ b/evaluator.inc
@@ -80,7 +80,7 @@
 	sts.l	mach, @-fSP
 	
 
-; Put this close to the test, so that we don't worry about the .AREPEAT
+; Put this close to the test, so that we don't worry about the .AREPEAT length
 PUDIVover:
 	mov.b	#-1, r0		; Or we could trap this, if we take the time to define traps.
 	mov.l	r0, @fSP
@@ -102,11 +102,12 @@ PUDIVover:
 ;
 ;         ***** FORTH order for double wide is most-significant-first!
 ;
-	.AIFDEF	PRIORITY_SIZE
-DIVIDELENGTH:	.DEFINE	"16"		; repeat count * 2 cycles * count in r3
-	.AELSE
+; Using a loop that messes with the carry won't work.
+;	.AIFDEF	PRIORITY_SIZE
+;DIVIDELENGTH:	.DEFINE	"16"		; repeat count * 2 cycles * count in r3
+;	.AELSE
 DIVIDELENGTH:	.DEFINE	"32"		; repeat count * 2 cycles
-	.AENDI
+;	.AENDI
 ;
 	HEADER	(UDIV), PUDIV
 	mov.l	@fSP+, r2	; divisor
@@ -114,19 +115,19 @@ DIVIDELENGTH:	.DEFINE	"32"		; repeat count * 2 cycles
 	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
+;	.AIFDEF	PRIORITY_SIZE
+;	mov.b	#2, r3		; Trade speed for size
+;	.AENDI
 	div0u	; Get the flags ready
-PUDIVloop:
+;PUDIVloop:
 	.AREPEAT	DIVIDELENGTH
 	rotcl	r1
 	div1	r2, r0
 	.AENDR
-	.AIFDEF	PRIORITY_SIZE
-	dt		r3			; + 4 cycles * count in r3
-	bf  	PUDIVloop
-	.AENDI
+;	.AIFDEF	PRIORITY_SIZE
+;	dt		r3			; + 4 cycles * count in r3
+;	bf  	PUDIVloop
+;	.AENDI
 	rotcl	r1
 	rts
 	mov.l	r1, @fSP
@@ -143,26 +144,72 @@ PUDIVloop:
 ;         ***** FORTH order for double wide is most-significant-first!
 ;
 	HEADER	U/, USLASH
+	sts.l	pr, @-fRP
 	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	r0, @-fSP		; Push 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
+	mov.l	@fSP+, r0	; grab the quotient
+	mov.l	@fSP+, r1	; grab the divisor (unsigned double dividend still on stack)
+	mov 	r0, fW		; hold the quotient
+	and 	r1, r0
+	cmp/eq	#-1, r0		; both max unsigned? (fW == r0 == max unsigned)
+	bf  	USLASHremainder
+	bra  	USLASHexitstore
+	mov.l	r0, @(NATURAL_SIZE,fSP)	; remainder (max) as we go
+;
+; The SH-3 manual recommends this approach
+USLASHremainder:
+	mov 	fW, r0
+	dmulu.l	r1, r0		; multiply quotient by divisor
 	sts.l	macl, @-fSP
 	bsr 	_fDSUB
 	sts.l	mach, @-fSP	; Store most significant as we go.
+; The low part is in the right place for the remainder.
 ; 
-	mov.l	@fSP, r0	; remainder
-	mov.l	r0, @(NATURAL_SIZE,fSP)
+USLASHexitstore:
+	lds.l	@fRP+, pr
 	rts
-	mov.l	fW, @fSP
+	mov.l	fW, @fSP	; Store the quotient as we go
+
+
+; AND     ( n1 n2 --- n )
+;         Bitwise and the top two integers.
+;
+	HEADER	AND, AND
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
+	and 	r1, r0
+	rts
+	mov.l	r0, @fSP
+
+
+; OR      ( n1 n2 --- n )
+;         Bitwise or.
+;
+	HEADER	OR, OR
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
+	or 	r1, r0
+	rts
+	mov.l	r0, @fSP
+
+
+; XOR     ( n1 n2 --- n )
+;         Bitwise exclusive or.
+;
+	HEADER	XOR, XOR
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
+	xor 	r1, r0
+	rts
+	mov.l	r0, @fSP
+
+
 
 
 ; +       ( n1 n2 --- n1+n2 )

--- a/initialize.inc
+++ b/initialize.inc
@@ -37,6 +37,78 @@
 ;	.section	initialize, code
 
 
+	HEADER	COLD, CENT
+; WENT will also move, eventually.
+WENT:
+	mov.l	#PER_USER, fUP
+;
+; Eventually want to initialize these from the COLD_PARAMETERS table --
+;
+	mov.l	#fSP_BASE, fSP
+	mov.l	fSP, @(XSPZER, fUP)
+	mov.l	#fRP_BASE, fRP
+	mov.l	fRP, @(XRZERO, fUP)
+;
+	mov 	#0, r0
+	mov.l	r0, @(XOUT,fUP)	; clear EMIT count.
+;
+	mov.l	#TEST_THINGY, fIP
+	mov.l	#NEXT, r0
+	jmp 	@r0
+	nop
 
 
 
+;COLD	FDB	*+2
+;CENT	LDS	#REND-1	top of destination
+;	LDX	#ERAM	top of stuff to move
+;COLD2	DEX
+;	LDA A	0,X
+;	PSH A		move TASK & FORTH to ram
+;	CPX	#RAM
+;	BNE	COLD2
+;*
+;	LDS	#XFENCE-1	put stack at a safe place for now
+;	LDX	COLINT
+;	STX	XCOLUM
+;	LDX	DELINT
+;	STX	XDELAY
+;	LDX	VOCINT
+;	STX	XVOCL
+;	LDX	DPINIT
+;	STX	XDP
+;	LDX	FENCIN
+;	STX	XFENCE
+;
+;
+;WENT	LDS	#XFENCE-1	top of destination
+;	LDX	#FENCIN		top of stuff to move
+;WARM2	DEX
+;	LDA A	0,X
+;	PSH A
+;	CPX	#SINIT
+;	BNE	WARM2
+;*
+;	LDS	SINIT
+;	LDX	UPINIT
+;	STX	UP		init user ram pointer
+;	LDX	#ABORT
+;	STX	IP
+;	NOP		Here is a place to jump to special user
+;	NOP		initializations such as I/0 interrups
+;	NOP
+;*
+;* For systems with TRACE:
+;	LDX	#00
+;	STX	TRLIM	clear trace mode
+;	LDX	#0
+;	STX	BRKPT	clear breakpoint address
+;	JMP	RPSTOR+2 start the virtual machine running !
+;*
+;* Here is the stuff that gets copied to ram :
+;* at address $140:
+;*
+;* Thus, MAGIC numbers that initialize USE and PREV, magically! (JMR)
+;* RAM	FDB	$3000,$3000,0,0
+;RAM	FDB	$4000+132,$4000+132,0,0
+;	

--- a/main.src
+++ b/main.src
@@ -36,14 +36,58 @@
 	.section	main,    code,  locate=h'8c000000
 
 	.org	$
-COLD:
-	mov.l	#PER_USER, fUP
-	mov.l	#fSP_BASE, fSP
-	mov.l	#fRP_BASE, fRP
-	mov.l	#TEST_THINGY, fIP
-	mov.l	#NEXT, r0
+
+;***************************
+;**  C O L D   E N T R Y  **
+;***************************
+; 0 offset into the ROMmable code
+ORIG:
+	mov.l	#_fCENT, r0
+	jmp 	@r0
+;***************************
+;**  W A R M   E N T R Y  **
+;***************************
+; 
+; 4 offset into the ROMmable code
+	nop 	; Conveniently left over from the COLD entry point.
+	mov.l	#WENT, r0	; warm-start code, keeps current dictionary intact
 	jmp 	@r0
 	nop
+;
+;*
+;******* startup parmeters **************************
+;*
+; All of this is essentially place-holder values:
+COLD_PARAMETERS:
+	.data.l	"SH-3"	; cpu
+	.data.l 0		; revision 
+	.data.l	0		; topmost word in FORTH vocabulary
+BACKSP:
+	.data.l	h'7f	; backspace character for editing
+UPINIT:
+	.data.l	PER_USER	; UORIG	; initial user area
+SINIT:
+	.data.l	fSP_BASE	; ORIG-$210	; initial top of data stack
+RINIT:
+	.data.l	fRP_BASE	; ORIG-$10	; initial top of return stack
+	.data.l	fSP_LIMIT-h'200	; ORIG-$200	; terminal input buffer
+	.data.l	31	; initial name field width
+	.data.l	0	; initial warning mode (0 = no disc)
+FENCIN:
+	.data.l	fSP_LIMIT-h'400	; REND	; initial fence
+DPINIT:
+	.data.l	fSP_LIMIT-h'400	; REND	; cold start value for DP
+VOCINT:
+	.data.l	fSP_LIMIT-h'400	; FORTH+8	
+COLINT:
+	.data.l	132	; initial terminal carriage width
+DELINT:
+	.data.l	4	; initial carriage return delay
+;****************************************************
+;*
+
+
+
 	
 TEST_THINGY:
 	.data.l	LIT, 1
@@ -73,10 +117,36 @@ LOOP_THINGY:
 	.data.l LIT, h'f0f0f0f0
 	.data.l LIT, h'0f0f0f0f
 	.data.l USTAR
+	.data.l	LIT, h'6A4C2E10, LIT, h'E2C4A68, DSUB, OR
+	.data.l ZBRAN
+	mTARGET UPRODUCTOK
+	.data.l	-5
+UPRODUCTOK:
 	.data.l LIT, h'10010000
 	.data.l LIT, h'10011001
 	.data.l LIT, h'10010
 	.data.l USLASH
+	.data.l AND, LIT, -1, SUB
+	.data.l ZBRAN
+	mTARGET UOVERFLOWOK
+	.data.l -1
+UOVERFLOWOK:
+	.data.l LIT, h'1000fe76
+	.data.l LIT, h'00000100
+	.data.l LIT, h'00010010
+	.data.l USLASH
+	.data.l LIT, H'01000000
+	.data.l SUB
+	.data.l ZBRAN
+	mTARGET UQUOTIENTOK
+	.data.l 1
+UQUOTIENTOK:
+	.data.l LIT, H'fe76
+	.data.l SUB
+	.data.l ZBRAN
+	mTARGET UREMAINDEROK
+	.data.l 3
+UREMAINDEROK:
 	.data.l	BRAN
 	mTARGET TEST_THINGY
 

--- a/primitive.inc
+++ b/primitive.inc
@@ -212,6 +212,45 @@ CMOVEdone:
 	add 	#3*NATURAL_SIZE, fSP	; Drop the parameters as we go.
 
 
+; SP@     ( --- adr )
+; SPAT    Fetch the parameter stack pointer (before it is pushed).
+;
+	HEADER	SP@, SPAT
+	rts
+	mov.l	fSP, @-fSP
+
+
+; SP!     ( whatever --- nothing )
+; SPSTOR  Initialize the parameter stack pointer from the USER variable
+;         S0.  Effectively clears the stack.
+;
+	HEADER	SP!, SPSTOR
+	mov.l	@(XSPZER,fUP), r0
+	rts
+	mov.l	r0, fSP
+
+
+; RP!     ( whatever *** nothing )
+; RPSTOR  Initialize the return stack pointer from the USER variable R0.
+;         Effectively aborts all in process definitions, except the active
+;         one.  An emergency measure, to be sure.
+;
+;         Deferring to the glossary, rather than the 6800 model, 
+;         and getting the initializer from the PER_USER table.
+;
+	HEADER	RP!, RPSTOR
+	mov.l	@(XRZERO,fUP), r0	
+	rts
+	mov.l	r0, fSP
+
+
+; ;S      ( ip *** )
+; SEMIS   Pop IP from return stack (return from high-level definition).
+;         Can be used in a screen to force interpretion to terminate.
+;
+	HEADER	";S", SEMIS
+	rts
+	mov.l	@fRP+, fIP