Commit: 98b1462b18e381bd047560e77e0c5cb9df01a094 - fig_sh (git)

Implementing figFORTH on SH3 assembler

Commit MetaInfo

• Revisão: 98b1462b18e381bd047560e77e0c5cb9df01a094 (tree)
• Hora: 2014-03-07 13:52:52
• Autor: Joel Matthew Rees <reiisi@user...>
• Commiter: Joel Matthew Rees

Mensagem de Log

up to around (FIND)

Mudança Sumário

• modified: context.inc
• modified: evaluator.inc
• add: initialize.inc
• add: main.src
• modified: parser.inc
• add: primitive.inc
• modified: primitive.src
• add: symbol.inc

Diff

--- a/context.inc
+++ b/context.inc
@@ -63,6 +63,20 @@ ALL_BITS:		.equ	H'FFFFFFFF
 ; -----------------------------
 
 
+; r0 must be used for many intermediate values.
+; r0 -- r7 are bank-switched on interrupt.
+; r8 -- r15 are not bank-switched on interrupt.
+; All registers have to be explicitly saved during a full task-switch, 
+; but the supervisor monitor code can keep a lot of context in the bank-switched part.
+
+; Registers that should be in r8 -- r15 are (as much as possible)
+; * temporaries that we agree to explicitly save;
+; * true globals (global contant tables, global library pointers, etc.);
+; * and per-task globals that have no parallel in the supervisor, if there are any.
+; * And the flow-of-control stack pointer, maybe.
+
+; For system calls, accessing the switched bank is not too hard.
+
 ; FORTH tracks the call/return sequence in a separate stack from the parameters.
 fRP:	.reg	r15	; control/Return stack Pointer
 fSP:	.reg	r7	; parameter Stack Pointer
@@ -114,3 +128,18 @@ _p\characteristic	.equ $
 	.endm
 
 
+; More as an example than to be actually used:
+	.macro	fSAFECALL	cfa
+	sts.l	pr, @-fRP
+	mov.l	imm\@, fW
+	jsr 	@fW
+	nop
+	bra 	exit\@
+	nop
+imm\@:
+	.data.l		\cfa
+exit\@:
+	lds.l	@fRP+
+	.endm
+
+

--- a/evaluator.inc
+++ b/evaluator.inc
@@ -3,13 +3,21 @@
 ; Expression evaluator definitions for fig-FORTH for SH-3
 ; Joel Matthew Rees, Hyougo Polytec Center
 ; 2014.03.01
+
 
-	.include	"context.inc"
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
+;	.section	evaluator, code
 
-	.section	evaluator, code, locate=h'8c000000
 
-
-; I -- It's tempting to put it in a dedicated register, but don't optimize too early.
+; It's tempting to put I in a dedicated register, 
+; but we don't want to optimize too early.
+;
+; I       ( --- index )           ( limit index *** limit index )
+;         Copy the loop index from the return stack.  Synonym for R, here.
+;
 	HEADER	I, xI
 	mov.l	@fRP, r0	; I (loop counter)
 	rts
@@ -19,4 +27,3 @@
 
 
 
-	.end

--- /dev/null
+++ b/initialize.inc
@@ -0,0 +1,17 @@
+	.list ON, EXP
+	
+; Initializations for fig-FORTH for SH-3
+; Joel Matthew Rees, Hyougo Polytec Center
+; 2014.02.28
+
+
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
+;	.section	initialize, code
+
+
+
+
+

--- /dev/null
+++ b/main.src
@@ -0,0 +1,27 @@
+	.list ON, EXP
+	
+; Primitive (kernel) definitions for fig-FORTH for SH-3
+; Joel Matthew Rees, Hyougo Polytec Center
+; 2014.02.28
+
+	.include	"context.inc"
+
+	.section	initialize, code, locate=h'8c000000
+; For various reasons, including the above "locate" declaration, 
+; this will be assembled monolithically, rather than separately.
+; Thus:
+;
+	.include	"initialize.inc"
+	.include	"primitive.inc"
+	.include	"parser.inc"
+	.include	"evaluator.inc"
+	.include	"symbol.inc"
+
+
+
+
+
+
+
+
+	.end
\ No newline at end of file

--- a/parser.inc
+++ b/parser.inc
@@ -3,25 +3,49 @@
 ; Parser definitions for fig-FORTH for SH-3
 ; Joel Matthew Rees, Hyougo Polytec Center
 ; 2014.03.01
+
 
-	.include	"context.inc"
-
-	.section	parser, code, locate=h'8c000000
-
-
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
+;	.section	parser, code
 
 
+; DIGIT   ( c base --- ff )
+;         ( c base --- n tf )
+;         Translate C in base, yielding a translation valid flag.  If the
+;         translation is not valid in the specified base, only the false
+;         flag is returned.
+;
 	HEADER	DIGIT, xDIGIT
-	mov.l	@fSP, r0
-	add.l	#-'0', r0
+	mov.l	@(NATURAL_SIZE,fSP), r0	; ７ビット文字
 	mov.b	#"0", r1
-	cmp/lt	r1, r0 	; r0 < r1
-	bt	xDIGITno
-	sub.l	r1, r0
-;	mov.b	#"9", 
-
+	cmp/ge	r1, r0 		; character (r0) >= "0"
+	bf	xDIGITno
+	add.l	#-"0", r0
+	mov.b	#9, r1
+	cmp/gt	r1, r0		; digit (r0) > 9
+	bf	xDIGITbase
+	mov.b	#"A"-"0", r1
+	cmp/ge	r1, r0		; was it between "9" and "A"?
+	bf	xDIGITno
+	add.l	#"9"-"A"+1, r0
+xDIGITbase:
+	mov.l	@fSP, r1
+	cmp/ge	r1, r0		; digit (r0) >= base
+	bt xDIGITno
+	mov.l	r0, @(NATURAL_SIZE,fSP)
+	mov.b	#-1, r0 	; store the converted digit
+	rts
+	mov.l	r0, @fSP	; set the flag on our way out
+;
+xDIGITno:
+	mov.b	#0, r0
+	add.l	#NATURAL_SIZE, fSP
+	rts
+	mov.l	r0, @fSP	; set the flag on our way out
 
 
 
 
-	.end

--- /dev/null
+++ b/primitive.inc
@@ -0,0 +1,168 @@
+	.list ON, EXP
+	
+; Primitive (kernel) definitions for fig-FORTH for SH-3
+; Joel Matthew Rees, Hyougo Polytec Center
+; 2014.02.28
+
+
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
+;	.section	primitives, code, align=4
+
+
+; ***** Need to load the return register with something safe.
+; Probably the call to next from warm?
+;
+; Anyway, this is the inner interpreter.
+;
+next:
+	mov.l	@fIP+, fW	; get the pointer to the next definition to execute
+	mov.l	@fW, r0		; get the defitinition characteristic
+	jsr		@r0
+; 3 cycles to get back to the top of the loop.
+	nop	
+	bra		next
+	nop
+; Note that, since jumps to absolute addresses have limits on constant-width instruction sets,
+; using the subroutine call mode for the virtual machine is not as much a penalty as it might seem.
+; It also has the advantage of being more compatible with more conventional code.
+; Ways to make an absolute jump work might include 
+; * the address of next in a table of constants (and reserving a register for the table base), or
+; * reserving a register for the address of next.
+
+
+; LIT     ( --- n )                                               C
+;         Push the following word from the instruction stream as a
+;         literal, or immediate value.
+;
+	HEADER	LIT, LIT
+	mov.l	@fIP+, r0
+	mov.l	r0, @-fSP
+	rts
+	nop
+
+
+; "character" (byte or word) literal doesn't work on SH3
+; It'll cause alignment problems.
+
+
+; EXECUTE ( adr --- )                                             C
+;         Jump to address on stack.  Used by the "outer" interpreter to
+;         interactively invoke routines.  (Not compile-only in fig.)
+;
+	HEADER	EXECUTE, EXECUTE
+	mov.l	@fSP+, fW
+	mov.l	@fW, r0
+	jmp 	@r0		; borrow the return there
+	nop
+
+
+; BRANCH  ( --- )                                                 C
+;         Add the following word from the instruction stream to the
+;         instruction pointer (Y++).  Causes a program branch.
+;
+	HEADER	BRANCH, BRANCH
+	mov.l	@fIP+, r0
+BRANCHgo:
+	add.l	r0, fIP
+	rts
+	nop
+
+
+; 0BRANCH ( f --- )                                               C
+;         BRANCH if flag is zero.
+;
+	HEADER	0BRANCH, ZBRANCH
+	mov.l	@fSP+, r0
+	cmp/eq	#0, r0	
+	bt/s	BRANCHgo
+	mov.l	@fIP+, r0
+	rts
+	nop
+	
+
+; fig-FORTH puts temporaries on the control stack. I prefer a third stack.
+; But if we put I in registers, (DO) is affected.
+; One might put I and the loop limit in, say, r8 and r9, 
+; but then they must be saved and restored,
+; and interrupts have to avoid r8 and r9 or save them.
+;
+; Note: fig-FORTH +LOOP has an un-signed loop counter, but a signed increment.
+; (JMR: but the increment is signed!)
+
+
+; (LOOP)  ( --- )         ( limit index *** limit index+1)        C
+;                         ( limit index *** )
+;         Counting loop primitive.  The counter and limit are the top two
+;         words on the return stack.  If the updated index/counter does
+;         not exceed the limit, a branch occurs.  If it does, the branch
+;         does not occur, and the index and limit are dropped from the
+;         return stack.
+;
+	HEADER	(LOOP), xLOOP
+	mov.l	@fRP, r0	; I (loop counter)
+	add.l	#1, r0
+	mov.l	r0, @fRP	; update I
+	mov.l	@(NATURAL_SIZE,fRP), r1	; limit
+	cmp/ge	r1, r0		; r0 >= r1 ?
+	bf/s	BRANCHgo	; not yet
+	mov.l	@fIP+, r0
+	rts
+	add.l	#2*NATURAL_SIZE, fRP
+	
+
+; (+LOOP) ( n --- )       ( limit index *** limit index+n )       C
+;                         ( limit index *** )
+;         Loop with a variable increment.  Terminates when the index
+;         crosses the boundary from one below the limit to the limit.  A
+;         positive n will cause termination if the result index equals the
+;         limit.  A negative n must cause the index to become less than
+;         the limit to cause loop termination.
+;
+	HEADER	(+LOOP), xPLOOP
+	mov.l	@fSP+, r1	; increment
+	mov.l	@fRP, r0	; I (loop counter)
+	add.l	r1, r0
+	mov.l	r0, @fRP	; update I
+	shal	r1		 	; increment negative or positive?
+	bt/s	xPLOOPminus
+	mov.l	@(NATURAL_SIZE,fRP), r1	; limit
+;
+; Stealing too much code would cost more than it would save.
+xPLOOPplus:
+	cmp/ge	r0, r1		; limit (r1) >= counter (I=r0) ?
+	bf/s	BRANCHgo	; not yet
+	mov.l	@fIP+, r0	; grab offset and bump fIP before we go
+	rts
+	add.l	#2*NATURAL_SIZE, fRP	; drop I and limit before we return
+;
+xPLOOPminus:
+	cmp/ge	r0, r1		; limit (r1) >= counter (I=r0) ?
+	bt/s	BRANCHgo	; not yet
+	mov.l	@fIP+, r0	; grab offset and bump fIP before we go
+	rts
+	add.l	#2*NATURAL_SIZE, fRP	; drop I and limit before we return
+
+
+; Putting I and limit in registers would require (DO) to save the registers first 
+; and it would require LOOP and +LOOP to restore the registers on exit.
+; That would cost more than it would save.
+; 
+; (DO)    ( limit index --- )     ( *** limit index )
+;         Move the loop parameters to the return stack.  Synonym for D>R, here.
+; 
+	HEADER (DO), xDO
+	mov.l	@fSP+, r0
+	mov.l	@fSP+, r1
+	add.l	#-2*NATURAL_SIZE, fRP
+	mov.l	r1, @(NATURAL_SIZE,fRP)
+	mov.l	r0, @fRP
+	rts
+
+
+
+
+
+

--- a/primitive.src
+++ b/primitive.src
@@ -4,22 +4,39 @@
 ; Joel Matthew Rees, Hyougo Polytec Center
 ; 2014.02.28
 
-	.include	"context.inc"
 
-	.section	kernel, code, locate=h'8c000000
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
+;	.section	primitives, code, align=4
+
 
 ; ***** Need to load the return register with something safe.
 ; Probably the call to next from warm?
-
+;
+; Anyway, this is the inner interpreter.
+;
 next:
 	mov.l	@fIP+, fW	; get the pointer to the next definition to execute
 	mov.l	@fW, r0		; get the defitinition characteristic
 	jsr		@r0
-	nop
+; 3 cycles to get back to the top of the loop.
+	nop	
 	bra		next
 	nop
+; Note that, since jumps to absolute addresses have limits on constant-width instruction sets,
+; using the subroutine call mode for the virtual machine is not as much a penalty as it might seem.
+; It also has the advantage of being more compatible with more conventional code.
+; Ways to make an absolute jump work might include 
+; * the address of next in a table of constants (and reserving a register for the table base), or
+; * reserving a register for the address of next.
 
 
+; LIT     ( --- n )                                               C
+;         Push the following word from the instruction stream as a
+;         literal, or immediate value.
+;
 	HEADER	LIT, LIT
 	mov.l	@fIP+, r0
 	mov.l	r0, @-fSP
@@ -31,6 +48,10 @@ next:
 ; It'll cause alignment problems.
 
 
+; EXECUTE ( adr --- )                                             C
+;         Jump to address on stack.  Used by the "outer" interpreter to
+;         interactively invoke routines.  (Not compile-only in fig.)
+;
 	HEADER	EXECUTE, EXECUTE
 	mov.l	@fSP+, fW
 	mov.l	@fW, r0
@@ -38,6 +59,10 @@ next:
 	nop
 
 
+; BRANCH  ( --- )                                                 C
+;         Add the following word from the instruction stream to the
+;         instruction pointer (Y++).  Causes a program branch.
+;
 	HEADER	BRANCH, BRANCH
 	mov.l	@fIP+, r0
 BRANCHgo:
@@ -46,6 +71,9 @@ BRANCHgo:
 	nop
 
 
+; 0BRANCH ( f --- )                                               C
+;         BRANCH if flag is zero.
+;
 	HEADER	0BRANCH, ZBRANCH
 	mov.l	@fSP+, r0
 	cmp/eq	#0, r0	
@@ -55,6 +83,24 @@ BRANCHgo:
 	nop
 	
 
+; fig-FORTH puts temporaries on the control stack. I prefer a third stack.
+; But if we put I in registers, (DO) is affected.
+; One might put I and the loop limit in, say, r8 and r9, 
+; but then they must be saved and restored,
+; and interrupts have to avoid r8 and r9 or save them.
+;
+; Note: fig-FORTH +LOOP has an un-signed loop counter, but a signed increment.
+; (JMR: but the increment is signed!)
+
+
+; (LOOP)  ( --- )         ( limit index *** limit index+1)        C
+;                         ( limit index *** )
+;         Counting loop primitive.  The counter and limit are the top two
+;         words on the return stack.  If the updated index/counter does
+;         not exceed the limit, a branch occurs.  If it does, the branch
+;         does not occur, and the index and limit are dropped from the
+;         return stack.
+;
 	HEADER	(LOOP), xLOOP
 	mov.l	@fRP, r0	; I (loop counter)
 	add.l	#1, r0
@@ -67,44 +113,47 @@ BRANCHgo:
 	add.l	#2*NATURAL_SIZE, fRP
 	
 
-; fig-FORTH puts temporaries on the control stack. I prefer a third stack.
-; But if we put I in registers, (DO) is affected.
-; One might put I and the loop limit in, say, r8 and r9, 
-; but then they must be saved and restored,
-; and interrupts have to avoid r8 and r9 or save them.
+; (+LOOP) ( n --- )       ( limit index *** limit index+n )       C
+;                         ( limit index *** )
+;         Loop with a variable increment.  Terminates when the index
+;         crosses the boundary from one below the limit to the limit.  A
+;         positive n will cause termination if the result index equals the
+;         limit.  A negative n must cause the index to become less than
+;         the limit to cause loop termination.
 ;
-; Note: fig-FORTH +LOOP has an un-signed loop counter.
-; (JMR: but the increment is signed!)
 	HEADER	(+LOOP), xPLOOP
 	mov.l	@fSP+, r1	; increment
 	mov.l	@fRP, r0	; I (loop counter)
 	add.l	r1, r0
 	mov.l	r0, @fRP	; update I
-	shl	r1, r0 	; increment negative or positive?
+	shal	r1		 	; increment negative or positive?
 	bt/s	xPLOOPminus
-	mov.l	@(NATURAL_SIZE,fRP), r0	; limit
+	mov.l	@(NATURAL_SIZE,fRP), r1	; limit
 ;
+; Stealing too much code would cost more than it would save.
 xPLOOPplus:
-	cmp/ge	r1, r0		; r0 >= r1 ?
+	cmp/ge	r0, r1		; limit (r1) >= counter (I=r0) ?
 	bf/s	BRANCHgo	; not yet
-	mov.l	@fIP+, r0
+	mov.l	@fIP+, r0	; grab offset and bump fIP before we go
 	rts
-	add.l	#2*NATURAL_SIZE, fRP
+	add.l	#2*NATURAL_SIZE, fRP	; drop I and limit before we return
 ;
 xPLOOPminus:
-	cmp/lt	r1, r0		; r0 < r1 ?
-; Stealing code from xPLOOPplus would cost 2 cycles for 4 bytes saved.
-	bf/s	BRANCHgo	; not yet
-	mov.l	@fIP+, r0
+	cmp/ge	r0, r1		; limit (r1) >= counter (I=r0) ?
+	bt/s	BRANCHgo	; not yet
+	mov.l	@fIP+, r0	; grab offset and bump fIP before we go
 	rts
-	add.l	#2*NATURAL_SIZE, fRP
+	add.l	#2*NATURAL_SIZE, fRP	; drop I and limit before we return
 
 
-; As it is, (DO) is an alias for D>R,
-; but if we put I and the limit in registers, 
-; (DO) ceases to be so.
+; Putting I and limit in registers would require (DO) to save the registers first 
+; and it would require LOOP and +LOOP to restore the registers on exit.
+; That would cost more than it would save.
 ; 
-	HEADER (DO), xDO
+; (DO)    ( limit index --- )     ( *** limit index )
+;         Move the loop parameters to the return stack.  Synonym for D>R, here.
+; 
+	HEADER (DO), xPDO
 	mov.l	@fSP+, r0
 	mov.l	@fSP+, r1
 	add.l	#-2*NATURAL_SIZE, fRP
@@ -116,4 +165,4 @@ xPLOOPminus:
 
 
 
-	.end
+

--- /dev/null
+++ b/symbol.inc
@@ -0,0 +1,30 @@
+	.list ON, EXP
+	
+; Symbol table definitions for fig-FORTH for SH-3
+; Joel Matthew Rees, Hyougo Polytec Center
+; 2014.03.01
+
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
+;	.section	evaluator, code
+
+
+; (FIND)  ( name vocptr --- locptr f )
+;         Search vocabulary for a symbol called name.  Name is a pointer
+;         to a NUL terminated string of characters without count, vocptr
+;         is a pointer to a pointer to a definition (the length byte of a
+;         symbol table entry).  Locptr is also a pointer to a pointer to a
+;         definition, such that, if the flag is false, a symbol with the
+;         name searched for may be inserted in proper order at that point.
+;         Vocptr and locptr may point to either the right or left entry of
+;         the order-parent entry in the symbol table, or to pointer to the
+;         root of a vocabulary.  HIDDEN (smudged) definitions are
+;         lexically less than their name strings.  Searches only the local
+;         vocabulary, from the order-parent node passed.  Uses (REFIND).
+; 
+;         vocptr is a pointer to the parameter field of a vocabulary 
+;         header.
+;
+	HEADER	(FIND), xPFIND