Commit: 9b5a66bd60ec110a45576f8b46600fa8b2a0dd70 - fig_sh (git)

Implementing figFORTH on SH3 assembler

Commit MetaInfo

• Revision: 9b5a66bd60ec110a45576f8b46600fa8b2a0dd70 (tree)
• Time: 2014-03-07 14:01:56
• Author: Joel Matthew Rees <reiisi@user...>
• Commiter: Joel Matthew Rees

Log Message

Making sure stuff will work like it should, maybe?

Change Summary

• modified: context.inc
• modified: evaluator.inc
• modified: parser.inc
• modified: primitive.inc
• modified: symbol.inc

Incremental Difference

--- a/context.inc
+++ b/context.inc
@@ -34,7 +34,8 @@
 	.cpu	sh3
 
 NATURAL_SIZE:	.equ	4	; 4 byte word
-ALL_BITS:		.equ	H'FFFFFFFF
+ALIGN_MASK: 	.equ	( H'FF & ~(NATURAL_SIZE - 1) )
+ALL_BITS8:		.equ	( H'FF & -1 )
 
 
 ; The SH-3 has modern dev tools, so we don't have to pay much attention 
@@ -94,12 +95,42 @@ fW:		.reg	r4	; currently executing Word definition pointer
 ; we can save a lot of time during interrupt processing.
 
 
+; Structure of the symbol table entry:
+; Length byte of the symbol name (NFA)
+; 	high bit set to flag the start byte
+;	next bit is MIMM 
+;	next bit is MHID
+;	5 bits of length, 0 really does mean zero.
+; Length - 1 bytes of name, 7 bit characters. (Woe unto ye who use UTF-8, shift-JIS, etc.)
+; Last byte, high bit set to flag the end byte.
+; In alignment sensitive architectures, 0 to alignment - 1 padding. (SH3 has 0 to 3.)
+; Link to the previous name in the vocabulary. (LFA)
+; Link to the (machine language level) characteristic definition for the symbol table entry.
+;   With "low-level words", this just links to the code that follows. (CFA)
+; Parameter field(s). (PFA)
+;   For "low-level words", this is machine code.
+;   For global constants and variables, this contains the value.
+;   For per-USER (task) constants and variables, the offset into
+;     the current per-USER table.
+;   For "high-level words", this is a list of virtual instruction pointers,
+;     in other words, pointers to the characterictics (CFA) of the symbols 
+;     compiled into the definition.
+;
+
+
 ; mode flags (to go with the length byte):
-MIMM	.equ H'40	; precedence is IMMEDIATE execution (in length byte -- NFA)
-MHID	.equ H'20	; SMUDGEd definition (in length byte -- NFA)
+CTFLAG:	.equ H'80	; Count byte in dictionary has high bit set.
+MIMM:	.equ H'40	; precedence is IMMEDIATE execution (in length byte -- NFA)
+MHID:	.equ H'20	; SMUDGEd definition (in length byte -- NFA)
+CTMASK:	.equ ( H'FF & ~( CTFLAG | MIMM ) )	; MHID hides SMUDGEd definitions this way.
+; MHID limits length to 31
+;
+TAILFLAG:	.equ H'80	; Trailing character in dictionary has high bit set.
+TAILMASK:	.equ ( H'FF & ~TAILFLAG )	; Expose the tail character.
+
 
 
-_LASTNAME:	.assign	0	; allocation/dictionary link (terminated by zero)
+_PREVNAME:	.assign	0	; allocation/dictionary link (terminated by zero)
 
 	.macro	HEADER	name, characteristic, mode=0
 ; Symbol name length and mode (Too much stuff in one byte, really.)
@@ -111,10 +142,10 @@ _s\characteristic:	.sdata	.substr("\name", 0, .len("\name")-1)
 ; Symbol names float, yes this is a bit awkward.
 	.align	NATURAL_SIZE
 ; Link to previously defined symbol's header.
-	.data.l	_LASTNAME
+	.data.l	_PREVNAME
 ; Use the SH-3 assembler to track the last symbol. 
 ; (This is not always a good idea.)
-_LASTNAME:	.assign _s\characteristic
+_PREVNAME:	.assign _s\characteristic
 ; Point to the characteristic code for this Word (symbol) to execute.
 \characteristic	.equ	$
 	.data.l	_p\characteristic
@@ -143,3 +174,18 @@ exit\@:
 	.endm
 
 
+; Convenience macros:
+; *** Use these instead of stealing code. 
+; Branch to address is limited to +- 4k, 
+; and stolen code is easy to lose track of.
+; Or, maybe you can let an optimizer move the code more reliably for you!
+
+; See xPALIGN
+; Immediate masks are only available for r0!
+	.macro	mALIGNr0
+	add 	#NATURAL_SIZE-1, r0		; Only works where NATURAL_SIZE is a power of 2.
+	and 	#ALIGN_MASK, r0		; SH3's NATURAL_SIZE is 4, or 2^2, so it works.
+	.endm
+
+
+

--- a/evaluator.inc
+++ b/evaluator.inc
@@ -11,6 +11,20 @@
 ;
 ;	.section	evaluator, code
 
+
+; Not in the 6800 fig model, I've just re-factored it for fun.
+; (ALIGN)  ( ptr1 --- ptr2 )
+;         Adjust ptr1 to the nearest aligned address not lower.
+;         In other words, if ptr1 is aligned at a NATURAL_SIZE boundary, do nothing.
+;         Otherwise, adjust it up until it is aligned.
+;
+	HEADER ALIGN, xPALIGN
+	mov.l	@fSP, r0
+	mALIGNr0
+	rts
+	mov.l	r0, @fSP
+
+
 
 ; It's tempting to put I in a dedicated register, 
 ; but we don't want to optimize too early.

--- a/parser.inc
+++ b/parser.inc
@@ -23,14 +23,14 @@
 	mov.b	#"0", r1
 	cmp/ge	r1, r0 		; character (r0) >= "0"
 	bf	xDIGITno
-	add.l	#-"0", r0
+	add 	#-"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
+	add 	#"9"-"A"+1, r0
 xDIGITbase:
 	mov.l	@fSP, r1
 	cmp/ge	r1, r0		; digit (r0) >= base
@@ -42,10 +42,113 @@ xDIGITbase:
 ;
 xDIGITno:
 	mov.b	#0, r0
-	add.l	#NATURAL_SIZE, fSP
+	add 	#NATURAL_SIZE, fSP
 	rts
 	mov.l	r0, @fSP	; set the flag on our way out
-
-
-
+
+
+; ENCLOSE ( buffer c --- buffer off1 off2 off3 )
+;         Scan buffer for a symbol delimited by c or ASCII NUL; 
+;         return the offsets to the first character of the symbol,
+;         the last character of the symbol,
+;         and the next character after the symbol.
+;
+	HEADER	ENCLOSE, xENCLOSE
+	mov.l	@fSP, r2	; delimiter
+	mov.b	#0, r3		; start the count at zero
+	mov.l	@(NATURAL_SIZE,fSP), r1
+xENCLOSEloopwhite:
+	mov.b	@r1+, r0
+	cmp/eq	#0, r0		; NUL character before symbol?
+	bt  	xENCLOSEnone
+	cmp/eq	r2, r0		; leading delimiter? (Usually SPACE.)
+	bt  	xENCLOSEloopwhite
+	add 	#1, r3		; Count it as we go.
+;
+	add 	#-1, r3		; Counted too far.
+	mov.l	r3, @fSP	; Save offset to symbol or NUL.
+	add 	#-1, r1		; Back up to what stopped us.
+xENCLOSEloopword:
+	cmp/eq	#0, r0		; NUL?
+	bt  	xENCLOSEnul
+	****
+	add 	#1, r3
+	bra 	xENCLOSEloopword
+	mov.l	@r1+, r0
+;
+		
+; found NUL before non-delimiter, therefore there is no word
+xENCLOSEnone:
+	mov.l	r3, @fSP
+	add 	#1, r3
+	mov.l	r3, @-fSP
+	add 	#-1, r3
+	rts
+	mov.l	r3, @-fSP
+; delimited by NUL
+xENCLOSEnul:
+	mov.l	r3, @-fSP
+	rts
+	mov.l	r3, @-fSP
+
+
+
+;* ######>> screen 20 <<
+;* ======>>  12  <<
+;	FCB	$87
+;	FCC	6,ENCLOSE
+;	FCB 	$C5
+;	FDB	PFIND-9
+;* NOTE :
+;* FC means offset (bytes) to First Character of next word
+;* EW  "     "   to End of Word
+;* NC  "     "   to Next Character to start next enclose at
+;ENCLOS	FDB	*+2
+;	INS
+;	PUL B		now, get the low byte, for an 8-bit delimiter
+;	TSX
+;	LDX	0,X
+;	CLR	N
+;*	wait for a non-delimiter or a NUL
+;ENCL2	LDA A	0,X
+;	BEQ	ENCL6
+;	CBA		CHECK FOR DELIM
+;	BNE	ENCL3
+;	INX
+;	INC	N
+;	BRA	ENCL2
+;*	found first character. Push FC
+;ENCL3	LDA A	N	found first char.
+;	PSH A
+;	CLR A
+;	PSH A
+;*	wait for a delimiter or a NUL
+;ENCL4	LDA A	0,X
+;	BEQ	ENCL7
+;	CBA		ckech for delim.
+;	BEQ	ENCL5
+;	INX
+;	INC	N
+;	BRA	ENCL4
+;*	found EW. Push it
+;ENCL5	LDA B	N
+;	CLR A
+;	PSH B
+;	PSH A
+;*	advance and push NC
+;	INC B
+;	JMP	PUSHBA
+;
+;ENCL6	LDA B	N	found NUL
+;	PSH B
+;	PSH A
+;	INC B
+;	BRA	ENCL7+2	
+;*	found NUL following the word instead of SPACE
+;ENCL7	LDA B	N
+;	PSH B		save EW
+;	PSH A
+;ENCL8	LDA B	N	save NC
+;	JMP	PUSHBA
+;
 

--- a/primitive.inc
+++ b/primitive.inc
@@ -25,7 +25,7 @@ next:
 	nop	
 	bra		next
 	nop
-; Note that, since jumps to absolute addresses have limits on constant-width instruction sets,
+; Note that, since jumps to absolute addresses have limits in 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 
@@ -61,12 +61,12 @@ next:
 
 ; BRANCH  ( --- )                                                 C
 ;         Add the following word from the instruction stream to the
-;         instruction pointer (Y++).  Causes a program branch.
+;         instruction pointer (postincrement).  Causes a program branch.
 ;
 	HEADER	BRANCH, BRANCH
 	mov.l	@fIP+, r0
 BRANCHgo:
-	add.l	r0, fIP
+	add 	r0, fIP
 	rts
 	nop
 
@@ -103,14 +103,14 @@ BRANCHgo:
 ;
 	HEADER	(LOOP), xLOOP
 	mov.l	@fRP, r0	; I (loop counter)
-	add.l	#1, r0
+	add 	#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
+	add 	#2*NATURAL_SIZE, fRP
 	
 
 ; (+LOOP) ( n --- )       ( limit index *** limit index+n )       C
@@ -124,7 +124,7 @@ BRANCHgo:
 	HEADER	(+LOOP), xPLOOP
 	mov.l	@fSP+, r1	; increment
 	mov.l	@fRP, r0	; I (loop counter)
-	add.l	r1, r0
+	add 	r1, r0
 	mov.l	r0, @fRP	; update I
 	shal	r1		 	; increment negative or positive?
 	bt/s	xPLOOPminus
@@ -156,10 +156,10 @@ xPLOOPminus:
 	HEADER (DO), xPDO
 	mov.l	@fSP+, r0
 	mov.l	@fSP+, r1
-	add.l	#-2*NATURAL_SIZE, fRP
+	add 	#-2*NATURAL_SIZE, fRP
 	mov.l	r1, @(NATURAL_SIZE,fRP)
-	mov.l	r0, @fRP
 	rts
+	mov.l	r0, @fRP
 
 
 

--- a/symbol.inc
+++ b/symbol.inc
@@ -9,22 +9,115 @@
 ;	.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.
+
+
+; Not in the 6800 fig model, I've just re-factored it for fun.
+; (NAME-SCAN)  ( ptr1 --- ptr2 )
+;         Scan ptr1 to a byte with the high bit set,
+;         leave ptr2 pointing to the next byte.
+;         Walks all over r0 and r1. Must leave fW untouched.
+;
+	HEADER	(NAME-SCAN), xNAMESCAN
+	mov.l	@fSP, r1 
+	mov.b	@r1+, r0
+xNAMESCANloop:
+	and 	#CTFLAG, r0
+	cmp/eq	#CTFLAG, r0
+xNAMESCANstart:
+	bf/s 	xNAMESCANloop
+	mov.b	@r1+, r0
+;
+	add 	#-1, r1
+	mov 	r1, r0
+	mALIGNr0
+	rts
+	mov.l	r0, @fSP
+	
+
+
+; Not in the 6800 fig model, I've just re-factored it for fun.
+; (CHK-NAME)  ( name nfa --- name link f )
+;         Compare a name in a buffer to a name in the symbol table.
+;         Leave an equality flag and a pointer to the link field for the next name.
+;         Names in the dictionary are terminated with the high bit set. 
+;         (Names only save 3 significant characters in some FORTHs.)
+;         Walks all over r0 - r3. Must leave fW untouched.
+;
+	HEADER	(CHK-NAME), xCHKNAME
+	sts.l	pr, @-fRP	; so we can call stuff
+	mov.l	@fSP, r2	; name in dictionary
+	mov.l	@(NATURAL_SIZE, fSP), r3	; name in buffer
+	mov.b	@r2+, r0	; count byte in dictionary, plus flags
+	and 	#CTMASK, r0	; Extract the actual count.
+	mov.b	@r3+, r1	; count byte in buffer
+	cmp/eq	r0, r1
+	bf  	xCHKNAMEno
+xCHKNAMEloop:
+	mov.b	@r2+, r0	; character in dictionary
+	tst 	#TAILFLAG, r0
+	bt  	xCHKNAMElast
+	mov.b	@r3+, r1	; character in buffer
+	cmp/eq	r0, r1
+	bt  	xCHKNAMEloop
+;
+xCHKNAMEno:
+	mov 	#0, r3		; r3 is not touched by xNAMESCAN
+xCHKNAMEret:
+	bsr 	 xNAMESCAN
+	mov.l	r2, @fSP	; save it as we go
+	lds.l	@fRP+, pr	; Gotta have that return address!
+	rts
+	mov.l	r3, @-fSP	; flag it as we go
+;
+xCHKNAMElast:	
+	mov.b	@r3+, r1	; last character in buffer
+	and		#TAILMASK, r0
+	cmp/eq	r0, r1
+	bf  	xCHKNAMEno
+;
+	bra 	xCHKNAMEret	
+	mov 	#ALL_BITS8, r3	; Set the flag as we go.
+	
+	
+; (FIND)  ( name nfa --- pfa b tf )
+;         ( name nfa --- ff )
+;         Search vocabulary for a symbol called name.  
+;         name is a pointer to a counted string.
+;         nfa is the NFA of the last entry in the vocabulary to be searched.
+;         Walks all over r0 - r3, and fW.
 ;
 	HEADER	(FIND), xPFIND
+	sts.l	pr, @-fRP	; so we can call stuff
+	mov.l	@fSP, r0
+xPFINDloop:
+	mov.b	@r0, fW		; We aren't using fW anyway, and it doesn't get walked in.
+	bsr 	xCHKNAME
+	mov.l	@fSP+, r0	; Did we find it?
+	cmp/eq	#0, r0
+	bf/s  	xPFINDfound	; Use the true flag in r0
+	mov.l	@fSP, r1	; LFA needed either way
+;
+	mov.l	@r1, r0
+	cmp/eq	#0, r0
+	bt  	xPFINDnot
+	bra 	xPFINDloop
+	mov.l	r0, @fSP	; Store the next one to check as we go.
+;
+xPFINDnot:
+;	mov 	#0, r0		; use the NULL pointer as a false flag
+	bra 	xPFINDret
+	add 	#2*NATURAL_SIZE, fSP	; bump as we go
+;
+xPFINDfound:
+	add 	#2*NATURAL_SIZE, r1		; pfa
+	mov.l	r1, @(NATURAL_SIZE,fSP)
+	mov.l	fW, @fSP	; Store the saved count byte, with mode bits.
+;	mov 	#ALL_BITS8, r0	; We can reuse the flag that sent us here.
+xPFINDret:
+	lds.l	@fRP+, pr	; Gotta have that return address!
+	rts
+	mov.l	r0, @-fSP	; Flag it as we go.
+
+
+; *** Sometime check whether there are extra (unused) instructions in the 6800 code about here.
+