fig FORTH on SH3

Fork

	.list ON, EXP
	
; Expression evaluator definitions for fig-FORTH for SH-3
; Joel Matthew Rees, Hyougo Polytec Center
; 2014.03.01

; Licensed extended under GPL v. 2 or 3, or per the following:
; ------------------------------------LICENSE-------------------------------------
;
; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in
; all copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
; THE SOFTWARE.
;
; --------------------------------END-OF-LICENSE----------------------------------


; Monolithic, not separate assembly:
; context.inc must be included before this file.
;	.include	"context.inc"
;
;	.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, ALIGN
	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.
;
; I       ( --- index )           ( limit index *** limit index )
;         Copy the loop index from the return stack.  Synonym for R, here.
;
;         It's convenient to have the current return address 
;         out-of-the-way in PR
;
	HEADER	I, I
	mov.l	@fRP, r0	; I (loop counter)
	rts
	mov.l	r0, @-fSP	


; U*      ( u1 u2 --- ud )
;         Multiplies the top two unsigned integers, yielding a double
;         integer product.
;
;         Rejoice, there is a double unsigned multiply! 
;
;         ***** FORTH order for double wide is most-significant-first!
;
	HEADER	"U*", USTAR
	mov.l	@fSP+, r1
	mov.l	@fSP+, r0
	dmulu.l	r1, r0
	sts.l	macl, @-fSP
	rts
	sts.l	mach, @-fSP
	

; 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
	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!
;
; 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
;
	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
	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		; Push the divisor as we go.
; 
	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.
; 
USLASHexitstore:
	lds.l	@fRP+, pr
	rts
	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


; LEAVE   ( limit index *** index index )
;         Force the terminating condition for the innermost loop by
;         copying its index to its limit.  Termination is postponed until
;         the next LOOP or +LOOP instruction is executed.  The index
;         remains available for use until the LOOP or +LOOP instruction is
;         encountered.
;
;         It's convenient to have the current return address 
;         out-of-the-way in PR
;
	HEADER	LEAVE, LEAVE
	mov.l	@fSP, r0
	rts
	mov.l	r0, @(NATURAL_SIZE,fSP)


; >R      ( n --- )               ( *** n )                       C
;         Move top of parameter stack to top of return stack.
;
;         It's convenient to have the current return address 
;         out-of-the-way in PR
;
	HEADER	">R", TOR
	mov.l	@fSP+, r0
	rts
	mov.l	r0, @-fRP


; R>      ( --- n )               (n *** )                        C
;         Move top of return stack to top of parameter stack.
;
;         It's convenient to have the current return address 
;         out-of-the-way in PR
; 
	HEADER	"R>", FROMR
	mov.l	@fRP+, r0
	rts
	mov.l	r0, @-fSP


; R       ( --- n )               ( n *** n )
;         Copy the top of return stack to top of parameter stack.  A
;         synonym for I.
;
;         It's convenient to have the current return address 
;         out-of-the-way in PR
;
	HIHEADER	R, R, I
;	mov.l	@fRP, r0
;	rts
;	mov.l	r0, @-fSP


; 0=      ( n --- n=0 )
;         Logically invert top of stack; or flag true if top is zero,
;         otherwise false.
;
	HEADER	"0=", ZEQU
	mov.l	@fSP, r0
	cmp/eq	#0, r0		; Bit inversion leaves an incomplete flag.
	bt  ZEQUequal
	mov 	#0, r0
	rts
	mov.l	r0, @fSP
ZEQUequal:
	mov 	#-1, r0		; not r0, r0 would also work, but why bother?
	rts
	mov.l	r0, @fSP	


;0<      ( n --- n<0 )
;       Flag true if top is negative (MSbit set), otherwise false.
;
	HEADER	"0<", ZLESS
	mov.l	@fSP, r0
	shal	r0			; Sign bit to T (and why are shal and shll different opcodes?)
	bt  ZLESSneg
	mov 	#0, r0
	rts
	mov.l	r0, @fSP
ZLESSneg:
	mov 	#-1, r0		; not r0, r0 would also work, but why bother?
	rts
	mov.l	r0, @fSP	


; +       ( n1 n2 --- n1+n2 )
;         Add top two words.
;
	HEADER	"+", PLUS
	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
	

;MINUS   ( n --- -n )
;        Negate (two's complement) top of stack. 
;        (NOT the the opposite of PLUS!)
;
	HEADER	MINUS, MINUS
	mov.l	@fSP, r0
	neg 	r0, r0
	rts
	mov.l	r0, @fSP


;DMINUS  ( d --- -d )
;        Negate (two's complement) top two words on stack as a double
;        integer.
;        (NOT the the opposite of DPLUS!)
;
	HEADER	DMINUS, DMINUS
	mov.l	@(NATURAL_SIZE,fSP), r1
	mov.l	@fSP, r0
	clrt
	negc	r1, r1
	negc	r0, r0
	mov.l	r1, @(NATURAL_SIZE,fSP)
	rts
	mov.l	r0, @fSP


; OVER    ( n1 n2 --- n1 n2 n1 )
;         Push a copy of the second word on stack.
; 
	HEADER	OVER, OVER
	mov.l	@(NATURAL_SIZE,fSP), r0
	rts
	mov.l	r0, @-fSP


; DROP    ( n --- )
;         Discard the top word on stack.
;
	HEADER	DROP, DROP
	rts
	add 	#NATURAL_SIZE, fSP


; SWAP    ( n1 n2 --- n2 n1 )
;         Swap the top two words on stack.
;
	HEADER	SWAP, SWAP
	mov.l	@(NATURAL_SIZE,fSP), r0
	mov.l	@fSP, r1
	mov.l	r1, @(NATURAL_SIZE,fSP)
	rts
	mov.l	r0, @fSP


; DUP     ( n1 --- n1 n1 )
;         Push a copy of the top word on stack.
;
	HEADER	DUP, DUP
	mov.l	@fSP, r0
	rts
	mov.l	r0, @-fSP


; +!      ( n adr --- )
;         Add the second word on stack to the word at the adr on top of
;         stack.
;
	HEADER	"+!", PSTORE
	mov.l	@fSP+, r2
	mov.l	@r2, r0
	mov.l	@fSP+, r1
	add 	r1, r0
	rts
	mov.l	r0, @r2


myTOGGLE:	.DEFINE "1"

; TOGGLE  ( adr b --- )
;         Exclusive or byte at adr with low byte of top word.
;
	.AIFDEF	myTOGGLE
	HEADER	TOGGLE, TOGGLE
	mov.l	@fSP+, r1
	mov.l	@fSP+, r2
	mov.b	@r2, r0
	xor 	r1, r0
	rts
	mov.b	r0, @r2
	.AELSE	; It makes a good example, so I'll keep it here.
	HIHEADER	TOGGLE, TOGGLE, DOCOL
	.data.l	OVER,CAT,XOR,SWAP,CSTORE
	.data.l	SEMIS
	.AENDI


; @       ( adr --- n )
;         Replace address on stack with the word at the address.
;
	HEADER	"@", AT
	mov.l	@fSP, r1 
	mov.l	@r1, r0		; Would mov.l @r0, r0 cause a stall?
	rts
	mov.l	r0, @fSP


; C@      ( adr --- b )
; CFEH    Replace address on top of stack with the byte at the address.
;         High byte of result is clear.
;
	HEADER	"C@", CAT
	mov.l	@fSP, r1 
	mov.b	@r1, r0		; Would mov.b @r0, r0 cause a stall?
	rts
	mov.l	r0, @fSP


; !       ( n adr --- )
;         Store second word on stack at address on top of stack.
;
	HEADER	"!", STORE
	mov.l	@fSP+, r1
	mov.l	@fSP+, r0
	rts
	mov.l	r0, @r1


; C!      ( b adr --- )
; CSTO    Store low byte of second word on stack at address on top of
;        stack.  High byte is ignored.
;
	HEADER	"C!", CSTORE
	mov.l	@fSP+, r1
	mov.l	@fSP+, r0
	rts
	mov.b	r0, @r1


; Numeric constants mapping to themselves is primarily for speed.
; 
; 0       ( --- 0 )
	HIHEADER	"0", ZERO, DOCON
	.data.l	0

; 1       ( --- 1 )
	HIHEADER	"1", ONE, DOCON
	.data.l	1

; 2       ( --- 2 )
	HIHEADER	"2", TWO, DOCON
	.data.l 1

; 3       ( --- 3 )
	HIHEADER	"3", THREE, DOCON
	.data.l	3

; 4       ( --- 4 )
;         Not part of the fig-FORTH model.
	HIHEADER	"4", FOUR, DOCON
	.data.l	4

; NWIDTH  ( --- u )
;         Not part of the fig-FORTH model, should have been.
	HIHEADER	NWIDTH, NWIDTH, DOCON
	.data.l	NATURAL_SIZE

; PTRWIDTH  ( --- u )
;           Not part of the fig-FORTH model, should have been.
	HIHEADER	PTRWIDTH, PTRWIDTH, DOCON
	.data.l	NATURAL_SIZE

; These should be linear arrays, but there is no linear array in fig-FORTH model.
; NBYTEORDER  ( --- u )
;           Offsets of bytes in natural word, high byte is byte 0.
;           Access as byte array of length NWIDTH.
;           Not part of the fig-FORTH model, should have been.
;	HIHEADER	NBYTEORDER, NBYTEORDER, DOCON
;	.data.l	h'00010203
;
; PBYTEORDER  ( --- u )
;           Offsets of bytes in address/pointer, high byte is byte 0.
;           Access as byte array of length PTRWIDTH.
;           Not part of the fig-FORTH model, should have been.
;	HIHEADER	PBYTEORDER, PBYTEORDER, DOCON
;	.data.l	h'00010203
; But we can define them high-level, so hold them off until we need them.

; BL      ( --- u )
	HIHEADER	BL, BL, DOCON
	.data.l	" "	; ascii blank


; WARNING ( --- vadr )    Availability of error messages on disk.
;         Contains 1 if message text is available, 0 if not, 
;         -1 if a disk error has occurred.
;
;         Message text is assumed to be on screen 4 of drive 0.
;         When -1 is set, MESSAGEs (ABORT).
;
;         See also ERROR.
;
	HIHEADER	WARNING, WARN, DOUSER
	.data.l	XWARN


; CONTEXT ( --- addr )
;         Pointer (pointer?) to the current INTERPRETing context vocabulary.
;         See CURRENT for the compiling vocabulary.
;
	HIHEADER	CONTEXT, CONTXT, DOUSER
	.data.l	XCONT


; BASE    ( --- vadr )
;         Current numeric conversion base for text I/O.
;
	HIHEADER	BASE, BASE, DOUSER
	.data.l	XBASE


; DPL     ( --- vadr )
;         Output decimal point locator for interpreting DOUBLEs as fixed-point,
;         or otherwised formatting a decimal point.
;
;         -1 if not formatting fixed point.
;
	HIHEADER	DPL, DPL, DOUSER
	.data.l	XDPL


; FLD     ( --- vadr )
;         Field width for I/O formatting.
;
	HIHEADER	FLD, FLD, DOUSER
	.data.l	XFLD


; HLD     ( --- vadr )
;         Pointer to last character held in PAD for numeric conversion.
;         See HOLD.
;
	HIHEADER	HLD, HLD, DOCON
	.data.l	XHLD


; 1+      ( n --- n+1 )
;
	HIHEADER	"1+", ONEP, DOCOL
	.data.l	ONE,PLUS
	.data.l	SEMIS


; 2+      ( n --- n+2 )
;
	HIHEADER	"2+", TWOP, DOCOL
	.data.l	TWO,PLUS
	.data.l	SEMIS


; NAT+    ( --- u )
;         Not part of the fig-FORTH model, should have been.
	HIHEADER	"NAT+", NATPLUS, DOCOL
	.data.l	NWIDTH,PLUS
	.data.l	SEMIS


; PTR+    ( --- u )
;         Not part of the fig-FORTH model, should have been.
	HIHEADER	"PTR+", PTRPLUS, DOCOL
	.data.l	PTRWIDTH,PLUS
	.data.l	SEMIS


; -       ( 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
	

; =      ( n1 n2 --- n1=n2 )
;        Flag true if n1 and n2 are equal, otherwise false.
;
;        These really should be defined low-level
;        because of where they get used.
;
	HEADER	"=", EQUAL
	mov.l	@fSP+, r1
	mov.l	@fSP, r0
	cmp/eq	r1, r0		; Subtraction leaves an incomplete flag.
	bt  	EQUALequal
	mov 	#0, r0
	rts
	mov.l	r0, @fSP
EQUALequal:
	mov 	#-1, r0
	rts
	mov.l	r0, @fSP	


; <      ( n1 n2 --- n1<n2 )
;        Flag true if n1 is less than n2, otherwise false.
;
;        These really should be defined low-level,
;        because of where they get used.
;
	HEADER	"<", LESS
	mov.l	@fSP+, r1
	mov.l	@fSP, r0
	cmp/ge	r1, r0		; Subtraction leaves an incomplete flag.
	bf  	LESSless
	mov 	#0, r0
	rts
	mov.l	r0, @fSP
LESSless:
	mov 	#-1, r0
	rts
	mov.l	r0, @fSP	


; >      ( n1 n2 --- n1>n2 )
;        Flag true if n1 is greater than n2, false otherwise.
;
;        These really should be defined low-level,
;        because of where they get used.
;
	HEADER	">", GREAT
	mov.l	@fSP+, r1
	mov.l	@fSP, r0
	cmp/gt	r1, r0		; Subtraction leaves an incomplete flag.
	bt  	GREATgreat
	mov 	#0, r0
	rts
	mov.l	r0, @fSP
GREATgreat:
	mov 	#-1, r0
	rts
	mov.l	r0, @fSP	



; ROT     ( n1 n2 n3 --- n2 n3 n1 )
;         Rotate the top three natural words on stack, 
;         bringing the third word to the top, pushing the top two down in order.
;
;         For various reasons, I do not want to do this high-level:
;ROT	FDB	DOCOL,TOR,SWAP,FROMR,SWAP
;	FDB	SEMIS
;
	HEADER	ROT, ROT
	mov.l	@fSP, r0
	mov.l	@(NATURAL_SIZE,fSP), r1
	mov.l	@(2*NATURAL_SIZE,fSP), r2
	mov.l	r1, @(2*NATURAL_SIZE,fSP)
	mov.l	r0, @(NATURAL_SIZE,fSP)
	rts
	mov.l	r2, @fSP


; MIN     ( n0 n1 --- min(n0,n1) )
;         Leave the minimum of the top two natural integers.
;
	HIHEADER	MIN, MIN, DOCOL
	.data.l	OVER,OVER,GREAT,ZBRAN
	mTARGET	MINdrop
	.data.l	SWAP
MINdrop:
	.data.l	DROP
	.data.l	SEMIS


; MAX     ( n0 n1 --- max(n0,n1) )
;         Leave the maximum of the top two natural integers.
;
	HIHEADER	MAX, MAX, DOCOL
	.data.l	OVER,OVER,LESS,ZBRAN
	mTARGET	MAXdrop
	.data.l	SWAP
MAXdrop:
	.data.l	DROP
	.data.l	SEMIS


; -DUP    ( 0 --- 0 )
;         ( n --- n n )
;         DUP iff non-zero. 
;
;         Convenience definition for IF tests.
;         (Otherwise, many ELSE clauses would contain only a DROP.)
;
	HIHEADER	"-DUP", DDUP, DOCOL
	.data.l	DUP,ZBRAN
	mTARGET	DDUPzero
	.data.l	DUP
DDUPzero:
	.data.l	SEMIS


; ?EXEC   ( --- )                 ( *** )
;         ( --- IN BLK )          ( anything *** nothing )
;         ERROR if not executing.
;
	HIHEADER	"?EXEC", QEXEC, DOCOL
	.data.l	STATE,AT,LIT
	.data.l	errEXECUTE_ONLY
	.data.l	QERR
	.data.l	SEMIS


; HEX     ( --- ) 
;         Set the conversion base to sixteen (hexadecimal).
;
	HIHEADER	HEX, HEX, DOCOL
	.data.l	LIT
	.data.l	16
	.data.l	BASE,STORE
	.data.l	SEMIS


; DECIMAL ( --- )
;         Set the conversion base to ten.
;
;         (Note that "DEC" is a valid hexadecimal number. So is A.)
;
	HIHEADER	DECIMAL, DEC, DOCOL
	.data.l	LIT
	.data.l	10
	.data.l	BASE,STORE
	.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 )
;         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