Commit: deab3b82bdeda15f36b40adf7a9e29e5471a6203 - fig_sh (git)

Implementing figFORTH on SH3 assembler

Commit MetaInfo

• Revision: deab3b82bdeda15f36b40adf7a9e29e5471a6203 (tree)
• Time: 2014-03-17 21:13:31
• Author: Joel Matthew Rees <reiisi@user...>
• Commiter: Joel Matthew Rees

Log Message

Through ?STACK.
May be my last edits for a while -- I've run out of time.

Change Summary

• modified: compiler.inc
• modified: error.inc
• modified: evaluator.inc
• modified: inout.inc
• modified: symbol.inc
• modified: teststuff.inc

Incremental Difference

--- a/compiler.inc
+++ b/compiler.inc
@@ -203,6 +203,26 @@ _fDOUSER:
 	.data.l	SEMIS
 
 
+; 0,  ( n --- )
+;        Add NULs to the dictionary, to the alignment boundary.
+;
+	HIHEADER	"0,", NULCOMMA, DOCOL
+	mov.l	@(XDP,fUP), r0		; XDP is within range.
+	mov.l	r0, r1
+	mALIGNr0
+	mov 	#0, r2
+NULCOMMAloop:
+	cmp/hi	r1, r0	; aligned in r0 higher than r1?
+	bf  NULCOMMAend
+	mov.b	r2, @r1
+	bra NULCOMMAloop
+	add 	#1, r1
+;
+NULCOMMAend:
+	mov.l	r0, @(XDP,fUP)
+	rts
+
+
 ; ,      ( n --- )
 ;        Store natural word n at DP+.
 ;        (Store and allocate, which is the wrong order for things.)
@@ -318,6 +338,173 @@ COMPILE_MODE:	.equ	h'C0
 	.data.l	SEMIS
 
 
+
+; (;CODE) ( --- )         ( IP *** )                              C
+;         Compile the latest symbol as a reference to a ;CODE definition.
+;         Overwrite the code field of the symbol referenced by LATEST 
+;         with a jump to the low-level characteristic code provided 
+;         in the defining definition.
+;         The machine-level code which follows (;CODE) in the
+;         instruction stream is not executed by the defining symbol, 
+;         but becomes the characteristic of the defined symbol. See ;CODE.
+;
+;         Note that IP is popped in the process, 
+;         so the assembler level code (or machine code) 
+;         which follows ;CODE is assembled in interpretive mode.
+;
+	HIHEADER	"(;CODE)", PSCODE, DOCOL
+	.data.l	FROMR,NATPLUS,LATEST,PFA,CFA,STORE
+	.data.l	SEMIS
+
+
+; ;CODE   ( --- )                                                 P,C
+;         { : name preparatory-stuff ;CODE defining-machine-level-code C, .... } or
+;         { : name preparatory-stuff ;CODE defining-assembler-code .... } typical use
+;         ?CSP to see if there are loose ends in the defining definition
+;         before shifting to the assembler, compile (;CODE) 
+;         in the defining definition's instruction stream,
+;         shift to interpreting.
+;
+;         When the assembler has been implemented, this should 
+;         set the ASSEMBLER vocabulary CURRENT.
+;
+;         Note that ;CODE, unlike DOES>, is IMMEDIATE, and compiles 
+;         (;CODE), which will do the actual work of changing the LATEST
+;         definition's characteristic when the defining word runs.
+;         Assembly is then done by the interpreter rather than the compiler.
+;
+;         Note also that I would be inclined to check the stack here (QSTACK) 
+;         and mark it again, to be checked at the end of the assembly 
+;         language code by a word called ";ASM" or some such.
+;         The 6800 model, on the other hand, suggests just replacing the 
+;
+	HIHEADER	";CODE", SEMIC, DOCOL, MIMM
+	.data.l	QCSP,COMPIL,PSCODE,SMUDGE,LBRAK,QSTACK
+	.data.l	NOOP, NOOP
+	.data.l	SEMIS
+; note: "QSTACK" can be replaced by "ASSEMBLER" later, 
+; or stack-checking performed here and at the end of assembly, too.
+; For the present, we can still hand-assemble code and use , and C, 
+; to "poke" it in after the ;CODE .
+
+
+; <BUILDS ( --- )
+;         { : name <BUILDS preparatory-stuff 
+;                   DOES> defining-stuff ; } typical use
+;         Build a header for DOES> definitions.
+;         The defining code is high-level.
+;
+;         Actually <BUILDS just compiles a CONSTANT zero 
+;         which can be overwritten later by DOES>.
+;
+;         Note that <BUILDS is not IMMEDIATE, 
+;         and therefore executes during a definition's run-time, 
+;         rather than its compile-time.  
+;         It is not intended to be used directly, 
+;         but rather so that one definition can build another.
+;         Also, note that nothing particularly special
+;         happens in the defining definition until DOES> executes.
+;         The name <BUILDS seems intended to be a reminder 
+;         of what is about to occur.
+;
+	HIHEADER	"<BUILDS", BUILDS, DOCOL
+	.data.l	ZERO,CON
+	.data.l	SEMIS
+
+
+; DOES>   ( --- )         ( IP *** )                              C
+;         Define run-time behavior of definitions at the high level
+;         -- could be called the FORTH equivalent of a compiler-compiler,
+;         but not-quite-the-same.
+;         DOES> assumes that the LATEST symbol table entry has 
+;         at least one word of parameter field, which <BUILDS provides.
+;
+;         Note that DOES> is also not IMMEDIATE.  
+;         When the defining word containing DOES> executes the DOES> icode, 
+;         it overwrites the LATEST symbol's CFA with the DOES> 
+;         (hidden) characteristic (DODOES), 
+;         overwrites the first word of that symbol's parameter field 
+;         with its own IP, and pops the previous IP from the return stack.
+;         The icodes which follow DOES> in the stream do not execute 
+;         at the defining word's run-time, 
+;         but at the run-time of the word which is being CREATEd.
+;
+;         This is similar to ;CODE, but at the high-level.
+;
+;         The advantage of this kind of behaviour is that the defined word
+;         can contain both operations and data to be operated on.
+;         This is how FORTH data objects define their own behavior.
+;
+;         Finally, note that the effective code field for DOES> definitions 
+;         is two natural words, rather than the usual on. This means that  
+;         the effective parameter field is one word farther from the header 
+;         than with ;CODE.
+;
+	HIHEADER	"DOES>", DOES, DOCOL
+	.data.l	FROMR,NATPLUS,LATEST,PFA,STORE
+	.data.l	PSCODE
+DODOES:
+_fDODOES:
+	mov.l	fIP, @-fRP	; ready to resume caller
+	add 	#NATURAL_SIZE, fW	; point to characteristic being invoked
+	mov.l	@fW, fIP	; Ready to start high-level characteristic.
+	add 	#NATURAL_SIZE, fW	; high-level parameter field
+	rts 	; Back to the inner interpreter
+	mov.l	fW, @-fSP	; push the address as we go
+
+
+; ."      ( --- )                                                 P
+;         { ." something-to-be-printed " } typical input
+;         Use WORD to parse to trailing quote.
+;         If compiling, compile XDOTQ and string parsed, 
+;         otherwise, TYPE string.
+;
+;         Maximum length is installation dependent and not well-defined.
+;         Note that WORD uses unallocated space in the dictionary as a 
+;         convenient parsing buffer, 
+;         so all that is needed after the scan is an allot 
+;         to finish compiling the string into the instruction stream.
+;         But on the SH-3, we must then ALIGN the dictionary with NULs.
+;         (I suppose ASCII SPACE might do as well, relative to the high bit.)
+;
+	HIHEADER	".""", DOTQ, DOCOL, MIMM
+	.data.l	LIT
+	.data.l	""""
+	.data.l	STATE,AT,ZBRAN
+	mTARGET	DOTQinterp
+	.data.l	COMPIL,PDOTQ,WORD
+	.data.l	HERE,CAT,ONEP,ALLOT,NULCOMMA
+	.data.l	BRAN
+	mTARGET	DOTQleave
+DOTQinterp:
+	.data.l	WORD,HERE,COUNT,TYPE
+DOTQleave:
+	.data.l	SEMIS
+
+
+; ?STACK  ( --- )
+;         Check paramater stack and ERROR if out of bounds.
+;
+;         Checks that the stack hasn't entered the buffer region.
+;
+	HIHEADER	"?STACK", QSTACK, DOCOL
+	.data.l	LIT
+	.data.l	SINIT-ORIG	; Why not the USER S0?
+	.data.l	PORIG,AT,PTRWIDTH,SUB,SPAT,LESS,LIT
+	.data.l	errSTACK_UNDERFLOW
+	.data.l	QERR	; stack underflow?
+;
+	.data.l	SPAT
+	.data.l	HERE,LIT
+	.data.l	h'80		; hard-wired buffer zone of 128
+	.data.l	PLUS,LESS,ZBRAN
+	.data.l	QSTACleave
+	.data.l	LIT
+	.data.l	errDICTIONARY_FULL	; at least 128 higher than dictionary pointer?
+	.data.l	QERR	; stack overflow?
+QSTACleave:
+	.data.l	SEMIS
+
 
 ; [COMPILE]       ( --- )                                         P
 ;         { [COMPILE] name } typical use

--- a/error.inc
+++ b/error.inc
@@ -42,7 +42,8 @@
 errNONE:				.equ	0
 ;	FCC	"DATA STACK UNDERFLOW                                            " 1
 errSTACK_UNDERFLOW:		.equ	1
-;	FCC	"DICTIONARY FULL                                                 " 2
+;	FCC	"DICTIONARY FULL                                                 " 2
+errDICTIONARY_FULL:		.equ	2
 ;	FCC	"ADDRESS RESOLUTION ERROR                                        " 3
 ;	FCC	"HIDES DEFINITION IN                                             " 4
 ;	FCC	"NULL VECTOR WRITTEN                                             " 5

--- a/evaluator.inc
+++ b/evaluator.inc
@@ -764,6 +764,35 @@ DDUPzero:
 	.data.l	SEMIS
 
 
+; COUNT   ( strptr --- strptr+1 count )
+;         Convert counted string to string and count.  (Fetch the byte at
+;         strptr, post-increment and leave the pointer under the count.)
+;         COUNT is typically used to set up the arguments for TYPE.
+;
+	HIHEADER	COUNT, COUNT, DOCOL
+	.data.l	DUP,ONEP,SWAP,CAT
+	.data.l	SEMIS
+
+
+; -TRAILING       ( strptr count1 --- strptr count2 )
+;         Supress trailing blanks.
+;         (Subtract count of trailing blanks from count1.)
+;
+	HIHEADER	"-TRAILING", DTRAIL, DOCOL
+	.data.l	DUP,ZERO,XDO
+DTRALloop:
+	.data.l	OVER,OVER,PLUS,ONE,SUB,CAT,BL
+	.data.l	SUB,ZBRAN
+	mTARGET	DTRALbackup
+	.data.l	LEAVE,BRAN
+	mTARGET	DTRALend
+DTRALbackup:
+	.data.l	ONE,SUB
+DTRALend:
+	.data.l	XLOOP
+	mTARGET	DTRALloop
+	.data.l	SEMIS
+
 
 
 ; D-       ( d1 d2 --- d1+d2 )

--- a/inout.inc
+++ b/inout.inc
@@ -233,3 +233,32 @@
 	.data.l	QERR
 	.data.l	SEMIS
 
+
+; TYPE    ( strptr count --- )
+;         EMIT count characters at strptr.
+;
+	HIHEADER	TYPE, TYPE, DOCOL
+	.data.l	DDUP,ZBRAN
+	mTARGET	TYPEdrop
+	.data.l	OVER,PLUS,SWAP,XDO
+TYPEloop:
+	.data.l	I,CAT,EMIT,XLOOP
+	mTARGET	TYPEloop
+	.data.l	BRAN
+	mTARGET	TYPEleave
+TYPEdrop:
+	.data.l	DROP
+TYPEleave:
+	.data.l	SEMIS
+
+
+; (.")    ( --- )
+;         TYPE counted string out of instruction stream (updating IP).
+;
+	HIHEADER	"(."")", PDOTQ, DOCOL
+	.data.l	R,COUNT,DUP,ONEP
+	.data.l	FROMR,PLUS,ALIGN,TOR,TYPE
+	.data.l	SEMIS
+
+
+

--- a/symbol.inc
+++ b/symbol.inc
@@ -297,7 +297,7 @@ TRAVloop:
 	.data.l	_fPFA-_lPFA		; Use the offsets in its own header.
 	.data.l	PLUS
 	.data.l	SEMIS
-
+
 
 ;	HEADER	, 
 ;	HIHEADER	, , 

--- a/teststuff.inc
+++ b/teststuff.inc
@@ -50,15 +50,18 @@
 ; CONTXT:	.define	"NOOP"	; used in COLON
 CREATE:	.define	"NOOP"	; used in COLON
 ; RBRAK:	.define	"NOOP"	; used in COLON
-PSCODE:	.define	"NOOP"	; used in COLON
+; PSCODE:	.define	"NOOP"	; used in COLON
 ; QCSP:	.define	"NOOP"	; used in SEMI
 ; COMPIL:	.define	"NOOP"	; used in SEMI
 ; SMUDGE:	.define	"NOOP"	; used in SEMI
 ; LBRAK:	.define	"NOOP"	; used in SEMI
 ; COMMA:	.define	"NOOP"	; used in CONSTANT
-DODOES:	.define	"NOOP"	; used in ROMFORTH
+; DODOES:	.define	"NOOP"	; used in ROMFORTH
 DOVOC:	.define	"NOOP"	; used in ROMFORTH
 ERROR:	.define	"NOOP"	; used in QERROR
+; QSTACK:	.define	"NOOP"	; used in ;CODE
+WORD:	.define	"NOOP"	; used in DOTQ
+
 ; :	.define	"NOOP"