6502/of816
1
0
Fork 0
mirror of https://github.com/mgcaret/of816.git synced 2025-01-09 13:29:41 +00:00
Code Issues Projects Releases Wiki Activity

resolve #7

Browse Source
This commit is contained in:
mgcaret 2020-01-05 21:53:07 -08:00
parent aca5015e1c
commit 4f41c94ee6
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
asm/forth-dictionary.s
View File

@ -2405,7 +2405,7 @@ eword
; ( limit start -- ) ( R: -- loop-sys ) ; ( limit start -- ) ( R: -- loop-sys )
; Run-time semantics for DO ; Run-time semantics for DO
; loop-sys = ( leave-IP index limit ) ; loop-sys = ( -- leave-IP index limit )
hword _DO,"_DO" hword _DO,"_DO"
jsr _2parm jsr _2parm
lda IP+2 ; put IP on stack for LEAVE target lda IP+2 ; put IP on stack for LEAVE target
@ -2541,7 +2541,7 @@ dword PLOOP,"+LOOP",F_IMMED|F_CONLY
.dword PLUS ; ( loop-sys loop-sys' -- loop-sys loop-sys'' ) get target of loop jump .dword PLUS ; ( loop-sys loop-sys' -- loop-sys loop-sys'' ) get target of loop jump
.dword COMMA ; ( loop-sys loop-sys'' -- loop-sys ) and compile as target of _PLOOP .dword COMMA ; ( loop-sys loop-sys'' -- loop-sys ) and compile as target of _PLOOP
.dword HERE ; ( loop-sys -- loop-sys t ) .dword HERE ; ( loop-sys -- loop-sys t )
.dword SWAP ; ( t -- loop-sys .dword SWAP ; ( loop-sys t -- t loop-sys )
.dword _COMP_LIT ; compile in an UNLOOP .dword _COMP_LIT ; compile in an UNLOOP
.dword UNLOOP .dword UNLOOP
ONLIT 4 ; one cell ONLIT 4 ; one cell
@ -6048,7 +6048,7 @@ dword dTEMPCOLON,":TEMP"
.dword DEPTH ; save stack depth (data stack is control stack) .dword DEPTH ; save stack depth (data stack is control stack)
.dword dCSDEPTH .dword dCSDEPTH
.dword STORE .dword STORE
EXIT done: EXIT
eword eword
; word to end temporary colon definition and run it ; word to end temporary colon definition and run it
@ -6067,13 +6067,13 @@ dosemi: .dword DEPTH ; ( -- u1 )
.dword ULTE ; ( u1 u2 -- f ) is less than or equal to? .dword ULTE ; ( u1 u2 -- f ) is less than or equal to?
.dword _IFFALSE ; ( f -- ) .dword _IFFALSE ; ( f -- )
.dword tmpdone ; true branch, finish up temp def .dword tmpdone ; true branch, finish up temp def
.dword TWODROP
notmp: EXIT notmp: EXIT
tmpdone: ;SLIT "Ending temp def... " tmpdone: ;SLIT "Ending temp def... "
;.dword TYPE ;.dword TYPE
.dword DEPTH ; ( -- u1 ) .dword DEPTH ; ( -- u1 )
.dword dCSDEPTH ; ( u1 -- u1 c-addr1 ) verify stack depth is what it should be .dword dCSDEPTH ; ( u1 -- u1 c-addr1 ) verify stack depth is what it should be
.dword FETCH ; ( u1 c-addr1 -- u1 u2 ) .dword FETCH ; ( u1 c-addr1 -- u1 u2 )
;.dword DOTS
.dword EQUAL ; ( u1 u2 -- f ) .dword EQUAL ; ( u1 u2 -- f )
.dword _IF ; ( f -- ) .dword _IF ; ( f -- )
.dword csmm ; if not, we have a problem .dword csmm ; if not, we have a problem
@ -6091,17 +6091,17 @@ tmpdone: ;SLIT "Ending temp def... "
.dword DROP ; ( xt xt -- xt ) now we worry about ( xt xt ) consume colon-sys .dword DROP ; ( xt xt -- xt ) now we worry about ( xt xt ) consume colon-sys
.dword CATCH ; ( xt -- * r ) execute the temporary definition within catch .dword CATCH ; ( xt -- * r ) execute the temporary definition within catch
.dword RtoP ; ( r -- r c-addr ) ( R: c-addr -- ) .dword RtoP ; ( r -- r c-addr ) ( R: c-addr -- )
dofree: ONLIT max_tempdef ; ( r c-addr -- r c-addr u ) dofree: ONLIT max_tempdef ; ( r c-addr -- r c-addr u )
.dword FREE ; ( r c-addr u -- r ) .dword FREE ; ( r c-addr u -- r )
.dword THROW ; ( r -- ) re-throw any error in temp def .dword THROW ; ( r -- ) re-throw any error in temp def
EXIT EXIT ; this really is an exit
csmm: .dword STATEI ; ( -- ) csmm: .dword STATEI ; ( -- )
.dword dSAVEHERE ; ( -- a-addr ) restore HERE .dword dSAVEHERE ; ( -- a-addr ) restore HERE
.dword FETCH ; ( a-addr -- c-addr ) .dword FETCH ; ( a-addr -- c-addr )
.dword toHERE ; ( c-addr -- ) .dword toHERE ; ( c-addr -- )
ONLIT -22 ; ( -- -22 ) will be thrown ONLIT -22 ; ( -- -22 ) will be thrown
.dword dTMPDEF ; ( -22 -- -22 c-addr ) .dword dTMPDEF ; ( -22 -- -22 c-addr )
JUMP dofree JUMP dofree ; note that thrown error will clean up dTMPDEF
eword eword
; ( xt -- ) make definition at xt visible ; ( xt -- ) make definition at xt visible