1
0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-01-31 19:31:14 +00:00

Add LATEST and UNLOOP to clean up scripts

This commit is contained in:
David Schmenk 2024-01-25 17:46:04 -08:00
parent 8d92e854ae
commit a9cadd9fda
13 changed files with 34 additions and 19 deletions

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -1,6 +1,7 @@
SRC" plasma.4th" SRC" plasma.4th"
SRC" conio.4th" SRC" conio.4th"
: RESUME> ; ( PLACE HOLDER TO RESUME EXECUTION )
: RESUME> ; INTERPONLY ( PLACE HOLDER TO RESUME EXECUTION )
: ?EXEC ( F -- ) : ?EXEC ( F -- )
NOT IF ( SKIP CODE IN BETWEEN ?EXEC AND RESUME> ) NOT IF ( SKIP CODE IN BETWEEN ?EXEC AND RESUME> )
1 >R 1 >R
@ -13,7 +14,7 @@ SRC" conio.4th"
THEN THEN
>R >R
ENDOF ENDOF
' ?EXEC OF ( CHECK FOR NESTED ?EXEC ) [ LATEST ] LITERAL OF ( CHECK FOR NESTED ?EXEC )
R> 1+ >R R> 1+ >R
ENDOF ENDOF
ENDCASE ENDCASE
@ -22,7 +23,7 @@ SRC" conio.4th"
THEN THEN
AGAIN AGAIN
THEN THEN
; ; INTERPONLY
: STRINPUT ( STR -- ) : STRINPUT ( STR -- )
DUP 1+ 255 ACCEPT -TRAILING SWAP C! DUP 1+ 255 ACCEPT -TRAILING SWAP C!

View File

@ -1,24 +1,20 @@
SRC" plasma.4th" SRC" plasma.4th"
SRC" conio.4th" SRC" conio.4th"
0 VARIABLE RESUMEXT
0 VARIABLE EXECXT
: RESUME> ; ( PLACE HOLDER TO RESUME EXECUTION )
' RESUME> RESUMEXT !
: RESUME> ; INTERPONLY ( PLACE HOLDER TO RESUME EXECUTION )
: ?EXEC ( F -- ) : ?EXEC ( F -- )
NOT IF ( SKIP CODE IN BETWEEN ?EXEC AND RESUME> ) NOT IF ( SKIP CODE IN BETWEEN ?EXEC AND RESUME> )
1 >R 1 >R
BEGIN BEGIN
BL WORD FIND IF BL WORD FIND IF
CASE CASE
RESUMEXT @ OF ' RESUME> OF
R> 1- ?DUP 0= IF ( EXIT IF FINAL RESUME> ) R> 1- ?DUP 0= IF ( EXIT IF FINAL RESUME> )
DROP EXIT DROP EXIT
THEN THEN
>R >R
ENDOF ENDOF
EXECXT @ OF ( CHECK FOR NESTED ?EXEC ) [ LATEST ] LITERAL OF ( CHECK FOR NESTED ?EXEC )
R> 1+ >R R> 1+ >R
ENDOF ENDOF
ENDCASE ENDCASE
@ -27,8 +23,7 @@ SRC" conio.4th"
THEN THEN
AGAIN AGAIN
THEN THEN
; ; INTERPONLY
' ?EXEC EXECXT !
: STRING CREATE 256 ALLOT DOES> ; ( JUST ALLOCATE THE BIGGEST STRING POSSIBLE ) : STRING CREATE 256 ALLOT DOES> ; ( JUST ALLOCATE THE BIGGEST STRING POSSIBLE )

View File

@ -28,9 +28,9 @@ SRC" CONIO.4TH"
FMK @ J PLOT FMK @ J PLOT
?TERMINAL IF ( if keypressed ) ?TERMINAL IF ( if keypressed )
KEY DROP KEY DROP
R> DROP R> DROP ( clean up DO-OKIE ) UNLOOP ( clean up DO-OKIE )
R> DROP R> DROP UNLOOP
R> DROP R> DROP UNLOOP
EXIT ( return ) EXIT ( return )
THEN THEN
LOOP LOOP

View File

@ -103,11 +103,12 @@ predef _ffa_(a)#1, _lfa_(a)#1, _hfa_(a)#1, _cfa_(a)#1, _pfa_(a)#1, _allot_(a)#0
predef _branch_#0, _0branch_(a)#0, _if_#0, _else_#0, _then_#0 predef _branch_#0, _0branch_(a)#0, _if_#0, _else_#0, _then_#0
predef _begin_#0, _again_#0, _until_#0, _while_#0, _repeat_#0 predef _begin_#0, _again_#0, _until_#0, _while_#0, _repeat_#0
predef _case_#0, _of_#0, _endof_#0, _endcase_#0 predef _case_#0, _of_#0, _endof_#0, _endcase_#0
predef _dodo_(a,b)#0, _do_#0, _doloop_#0, _doplusloop_(a)#0, _plusloop_#0, _loop_#0, _leave_#0, _j_#1 predef _dodo_(a,b)#0, _do_#0, _doloop_#0, _doplusloop_(a)#0, _plusloop_#0, _loop_#0
predef _unloop_#0, _leave_#0, _j_#1
predef _create_#0, _itcdoes_(a)#0, _does_#0, _compoff_#0, _compon_#0, _state_#1 predef _create_#0, _itcdoes_(a)#0, _does_#0, _compoff_#0, _compon_#0, _state_#1
predef _compile_#0, _forcecomp_#0, _dictaddw_(a)#0, _dictaddb_(a)#0, _colon_#0, _semi_#0 predef _compile_#0, _forcecomp_#0, _dictaddw_(a)#0, _dictaddb_(a)#0, _colon_#0, _semi_#0
predef _componly_#0, _interponly_#0, _immediate_#0, _exit_#0, _pad_#1, _trailing_(a,b)#2 predef _componly_#0, _interponly_#0, _immediate_#0, _exit_#0, _pad_#1, _trailing_(a,b)#2
predef _tors_(a)#0, _fromrs_#1, _toprs_#1, _lookup_#1 predef _tors_(a)#0, _fromrs_#1, _toprs_#1, _lookup_#1, _latest_#1
predef _cmove_(a,b,c)#0, _move_(a,b,c)#0, _fill_(a,b,c)#0, _plasma_(a)#0 predef _cmove_(a,b,c)#0, _move_(a,b,c)#0, _fill_(a,b,c)#0, _plasma_(a)#0
predef _var_(a)#0, _const_(a)#0, _lit_#1, _slit_#1, _find_(a)#2 predef _var_(a)#0, _const_(a)#0, _lit_#1, _slit_#1, _find_(a)#2
predef _tick_#0, _forget_#0, _terminal_#1, _key_#1, _prat_(a)#0 predef _tick_#0, _forget_#0, _terminal_#1, _key_#1, _prat_(a)#0
@ -320,10 +321,14 @@ word = @d_cmove, 0, @_move_
char d_fill = "FILL" char d_fill = "FILL"
byte = showcr_flag byte = showcr_flag
word = @d_cmove, 0, @_fill_ word = @d_cmove, 0, @_fill_
// LATEST
char d_latest = "LATEST"
byte = 0
word = @d_fill, 0, @_latest_
// HERE // HERE
char d_here = "HERE" char d_here = "HERE"
byte = 0 byte = 0
word = @d_fill, 0, @heapmark word = @d_latest, 0, @heapmark
// PAD // PAD
char d_pad = "PAD" char d_pad = "PAD"
byte = 0 byte = 0
@ -380,6 +385,10 @@ word = @d_endcase, 0, @_do_
char d_leave = "LEAVE" char d_leave = "LEAVE"
byte = componly_flag | showcr_flag byte = componly_flag | showcr_flag
word = @d_do, 0, @_leave_ word = @d_do, 0, @_leave_
// UNLOOP
char d_unloop = "UNLOOP"
byte = componly_flag | showcr_flag
word = @d_leave, 0, @_unloop_
// COMPILED LOOP ( not in vocabulary ) // COMPILED LOOP ( not in vocabulary )
char d_doloop = "(DOLOOP)" char d_doloop = "(DOLOOP)"
byte = param_flag | showcr_flag byte = param_flag | showcr_flag
@ -387,7 +396,7 @@ word = 0, 0, @_doloop_
// LOOP // LOOP
char d_loop = "LOOP" char d_loop = "LOOP"
byte = imm_flag | componly_flag byte = imm_flag | componly_flag
word = @d_leave, 0, @_loop_ word = @d_unloop, 0, @_loop_
// COMPILED LOOP+ ( not in vocabulary ) // COMPILED LOOP+ ( not in vocabulary )
char d_doplusloop = "(+DOLOOP)" char d_doplusloop = "(+DOLOOP)"
byte = param_flag | showcr_flag byte = param_flag | showcr_flag
@ -1177,6 +1186,9 @@ def _trailing_(a,b)#2
loop loop
return a, b return a, b
end end
def _latest_#1
return vlist
end
def newdict#0 def newdict#0
word bldptr, plist, namechars, namelen word bldptr, plist, namechars, namelen
@ -1488,6 +1500,13 @@ def _plusloop_#0
fin fin
_dictaddw_(_fromrs_) _dictaddw_(_fromrs_)
end end
def _unloop_#0
if RSP > RSTK_SIZE-1
puts("Return stack underflow\n")
_quit_
fin
RSP = RSP + 2
end
def _j_#1 def _j_#1
return RSTACK[RSP + 2] return RSTACK[RSP + 2]
end end