6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-08-11 13:25:02 +00:00
Code Issues Projects Releases Wiki Activity

Attempt better formatting for SHOW

Browse Source
This commit is contained in:
David Schmenk
2024-01-09 07:28:22 -08:00
parent de4d6fb104
commit a755df496c
2 changed files with 48 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
images/apple/PLFORTH.PO
View File

Binary file not shown.

83
src/toolsrc/plforth.pla
View File

@@ -86,6 +86,7 @@ byte = $60 // RTS
const inline_flag = $01 const inline_flag = $01
const inlinew_flag = $02 const inlinew_flag = $02
const param_flag = $04 const param_flag = $04
const showcr_flag = $08 // Help pretty print SHOW
const itc_flag = $10 const itc_flag = $10
const imm_flag = $20 const imm_flag = $20
const componly_flag = $40 const componly_flag = $40
@@ -118,7 +119,7 @@ predef _abort_(a)#0, _doabortstr_(a,b)#0, _abortstr_#0
predef _compword_(dentry)#0, _compliteral_(a)#0, _execword_(dentry)#0, _isnum_(a,b)#2 predef _compword_(dentry)#0, _compliteral_(a)#0, _execword_(dentry)#0, _isnum_(a,b)#2
// DROP // DROP
char d_drop = "DROP" char d_drop = "DROP"
byte = inline_flag byte = inline_flag | showcr_flag
word = 0, 0, 0, $30 word = 0, 0, 0, $30
// SWAP // SWAP
char d_swap = "SWAP" char d_swap = "SWAP"
@@ -254,15 +255,15 @@ byte = 0
word = @d_min, 0, @_max_ word = @d_min, 0, @_max_
// CHAR PUT // CHAR PUT
char d_cset = "C!" char d_cset = "C!"
byte = inline_flag byte = inline_flag | showcr_flag
word = @d_max, 0, 0, $70 word = @d_max, 0, 0, $70
// WORD PUT // WORD PUT
char d_wset = "!" char d_wset = "!"
byte = inline_flag byte = inline_flag | showcr_flag
word = @d_cset, 0, 0, $72 word = @d_cset, 0, 0, $72
// WORD PLUS PUT // WORD PLUS PUT
char d_wplusset = "+!" char d_wplusset = "+!"
byte = 0 byte = showcr_flag
word = @d_wset, 0, @_wplusset_ word = @d_wset, 0, @_wplusset_
// CHAR GET // CHAR GET
char d_cget = "C@" char d_cget = "C@"
@@ -274,11 +275,11 @@ byte = inline_flag
word = @d_cget, 0, 0, $62 word = @d_cget, 0, 0, $62
// EXECUTE // EXECUTE
char d_execute = "EXECUTE" char d_execute = "EXECUTE"
byte = 0 byte = showcr_flag
word = @d_wget, 0, @_execword_ word = @d_wget, 0, @_execword_
// TO RSTACK // TO RSTACK
char d_torstk = ">R" char d_torstk = ">R"
byte = 0 byte = showcr_flag
word = @d_execute, 0, @_tors_ word = @d_execute, 0, @_tors_
// FROM RSTACK // FROM RSTACK
char d_fromrstk = "R>" char d_fromrstk = "R>"
@@ -326,11 +327,11 @@ byte = 0
word = @d_pad, 0, @_allot_ word = @d_pad, 0, @_allot_
// BRANCH ( not in vocabulary ) // BRANCH ( not in vocabulary )
char d_branch = "(BRANCH)" char d_branch = "(BRANCH)"
byte = param_flag | inline_flag byte = param_flag | inline_flag | showcr_flag
word = 0, 0, @_branch_, $C4 word = 0, 0, @_branch_, $C4
// BRANCH IF 0 ( not in vocabulary ) // BRANCH IF 0 ( not in vocabulary )
char d_0branch = "(0BRANCH)" char d_0branch = "(0BRANCH)"
byte = param_flag | inline_flag byte = param_flag | inline_flag | showcr_flag
word = 0, 0, @_0branch_, $C2 word = 0, 0, @_0branch_, $C2
// IF // IF
char d_if = "IF" char d_if = "IF"
@@ -362,7 +363,7 @@ byte = imm_flag | componly_flag
word = @d_endof, 0, @_endcase_ word = @d_endof, 0, @_endcase_
// COMPILED DO ( not in vocabulary ) // COMPILED DO ( not in vocabulary )
char d_dodo = "(DO)" char d_dodo = "(DO)"
byte = 0 byte = showcr_flag
word = 0, 0, @_dodo_ word = 0, 0, @_dodo_
// DO // DO
char d_do = "DO" char d_do = "DO"
@@ -374,7 +375,7 @@ byte = componly_flag
word = @d_do, 0, @_leave_ word = @d_do, 0, @_leave_
// COMPILED LOOP ( not in vocabulary ) // COMPILED LOOP ( not in vocabulary )
char d_doloop = "(DOLOOP)" char d_doloop = "(DOLOOP)"
byte = param_flag byte = param_flag | showcr_flag
word = 0, 0, @_doloop_ word = 0, 0, @_doloop_
// LOOP // LOOP
char d_loop = "LOOP" char d_loop = "LOOP"
@@ -382,7 +383,7 @@ byte = imm_flag | componly_flag
word = @d_leave, 0, @_loop_ word = @d_leave, 0, @_loop_
// COMPILED LOOP+ ( not in vocabulary ) // COMPILED LOOP+ ( not in vocabulary )
char d_doplusloop = "(+DOLOOP)" char d_doplusloop = "(+DOLOOP)"
byte = param_flag byte = param_flag | showcr_flag
word = 0, 0, @_doplusloop_ word = 0, 0, @_doplusloop_
// LOOP // LOOP
char d_plusloop = "+LOOP" char d_plusloop = "+LOOP"
@@ -418,15 +419,15 @@ byte = imm_flag | componly_flag
word = @d_while, 0, @_repeat_ word = @d_while, 0, @_repeat_
// FORGET // FORGET
char d_forget = "FORGET" char d_forget = "FORGET"
byte = 0 byte = interponly_flag
word = @d_repeat, 0, @_forget_ word = @d_repeat, 0, @_forget_
// CREATE // CREATE
char d_create = "CREATE" char d_create = "CREATE"
byte = 0 byte = showcr_flag
word = @d_forget, 0, @_create_ word = @d_forget, 0, @_create_
// RECREATE/DOES COMPILE TIME ( not in vocabulary ) // RECREATE/DOES COMPILE TIME ( not in vocabulary )
char d_createdoes = "(CREATEDOES)" char d_createdoes = "(CREATEDOES)"
byte = 0 byte = showcr_flag
word = 0, 0, @_itcdoes_ word = 0, 0, @_itcdoes_
// DOES // DOES
char d_does = "DOES>" char d_does = "DOES>"
@@ -434,11 +435,11 @@ byte = imm_flag | componly_flag
word = @d_create, 0, @_does_ word = @d_create, 0, @_does_
// COMMA // COMMA
char d_comma = "," char d_comma = ","
byte = 0 byte = showcr_flag
word = @d_does, 0, @_dictaddw_ word = @d_does, 0, @_dictaddw_
// COMMA // COMMA
char d_commab = "C," char d_commab = "C,"
byte = 0 byte = showcr_flag
word = @d_comma, 0, @_dictaddb_ word = @d_comma, 0, @_dictaddb_
// COLON // COLON
char d_colon = ":" char d_colon = ":"
@@ -470,7 +471,7 @@ byte = imm_flag
word = @d_interponly, 0, @_immediate_ word = @d_interponly, 0, @_immediate_
// EXIT // EXIT
char d_exit = "EXIT" char d_exit = "EXIT"
byte = imm_flag | componly_flag byte = imm_flag | componly_flag | showcr_flag
word = @d_immediate, 0, @_exit_ word = @d_immediate, 0, @_exit_
// SEMI // SEMI
char d_semi = ";" char d_semi = ";"
@@ -522,19 +523,19 @@ byte = 0
word = @d__isnum_, 0, @_trailing_ word = @d__isnum_, 0, @_trailing_
// PRINT @TOS // PRINT @TOS
char d_prat = "?" char d_prat = "?"
byte = 0 byte = showcr_flag
word = @d_trailing, 0, @_prat_ word = @d_trailing, 0, @_prat_
// PRINT TOS // PRINT TOS
char d_prtos = "." char d_prtos = "."
byte = 0 byte = showcr_flag
word = @d_prat, 0, @_prval_ word = @d_prat, 0, @_prval_
// PRINT TOS HEX // PRINT TOS HEX
char d_prtoshex = "$." char d_prtoshex = "$."
byte = 0 byte = showcr_flag
word = @d_prtos, 0, @_prhex_ word = @d_prtos, 0, @_prhex_
// PRINT TOS HEX BYTE // PRINT TOS HEX BYTE
char d_prtosbyte = "C$." char d_prtosbyte = "C$."
byte = 0 byte = showcr_flag
word = @d_prtoshex, 0, @_prbyte_ word = @d_prtoshex, 0, @_prbyte_
// EMIT // EMIT
char d_emit = "EMIT" char d_emit = "EMIT"
@@ -574,7 +575,7 @@ byte = param_flag | inline_flag
word = 0, 0, @_slit_, $2E word = 0, 0, @_slit_, $2E
// PRINT STRING FROM STACK // PRINT STRING FROM STACK
char d_doprstr = "(.\")" char d_doprstr = "(.\")"
byte = 0 byte = showcr_flag
word = @d_str, 0, @puts word = @d_str, 0, @puts
// PRINT STRING // PRINT STRING
char d_prstr = ".\"" char d_prstr = ".\""
@@ -586,7 +587,7 @@ byte = imm_flag
word = @d_prstr, 0, @_prpstr_ word = @d_prstr, 0, @_prpstr_
// READ SOURCE FILE FROM STACK // READ SOURCE FILE FROM STACK
char d_src = "SRC" char d_src = "SRC"
byte = 0 byte = showcr_flag
word = @d_prpstr, 0, @_src_ word = @d_prpstr, 0, @_src_
// READ SOURCE FILE FROM INPUT // READ SOURCE FILE FROM INPUT
char d_srcstr = "SRC\"" char d_srcstr = "SRC\""
@@ -594,7 +595,7 @@ byte = imm_flag
word = @d_src, 0, @_srcstr_ word = @d_src, 0, @_srcstr_
// END SOURCE FILE // END SOURCE FILE
char d_endsrc = "ENDSRC" char d_endsrc = "ENDSRC"
byte = 0 byte = showcr_flag
word = @d_srcstr, 0, @_endsrc_ word = @d_srcstr, 0, @_endsrc_
// CONTINUE AFTER BRK // CONTINUE AFTER BRK
char d_cont = "CONT" char d_cont = "CONT"
@@ -602,15 +603,15 @@ byte = interponly_flag
word = @d_endsrc, 0, @_cont_ word = @d_endsrc, 0, @_cont_
// QUIT // QUIT
char d_quit = "QUIT" char d_quit = "QUIT"
byte = 0 byte = showcr_flag
word = @d_cont, 0, @_quit_ word = @d_cont, 0, @_quit_
// ABORT IF <> 0 // ABORT IF <> 0
char d_abort = "ABORT" char d_abort = "ABORT"
byte = 0 byte = showcr_flag
word = @d_quit, 0, @_abort_ word = @d_quit, 0, @_abort_
// DOABORTSTR // DOABORTSTR
char d_doabortstr = "(ABORT\")" char d_doabortstr = "(ABORT\")"
byte = 0 byte = showcr_flag
word = @d_abort, 0, @_doabortstr_ word = @d_abort, 0, @_doabortstr_
// ABORTSTR // ABORTSTR
char d_abortstr = "ABORT\"" char d_abortstr = "ABORT\""
@@ -618,11 +619,11 @@ byte = imm_flag
word = @d_doabortstr, 0, @_abortstr_ word = @d_doabortstr, 0, @_abortstr_
// COLD exitforth // COLD exitforth
char d_exitforth = "COLD" char d_exitforth = "COLD"
byte = 0 byte = showcr_flag
word = @d_abortstr, 0, @_restart_ word = @d_abortstr, 0, @_restart_
// COMMENT // COMMENT
char d_comment = "(" char d_comment = "("
byte = imm_flag byte = imm_flag | showcr_flag
word = @d_exitforth, 0, @_comment_ word = @d_exitforth, 0, @_comment_
// //
// PLFORTH custom words // PLFORTH custom words
@@ -1233,8 +1234,9 @@ end
def _does_#0 def _does_#0
if state & comp_itc_flag if state & comp_itc_flag
_dictaddw_(@d_lit) _dictaddw_(@d_lit)
_dictaddw_(heapmark + 6) // Pointer to DOES code _dictaddw_(heapmark + 8) // Pointer to DOES code
_dictaddw_(@d_createdoes) _dictaddw_(@d_createdoes)
_dictaddw_(0) // Double zero for SHOW
_dictaddw_(0) _dictaddw_(0)
// End of <BUILDS, beginning of DOES> // End of <BUILDS, beginning of DOES>
else // comp_pbc_flag else // comp_pbc_flag
@@ -1253,7 +1255,7 @@ def _colon_#0
newdict newdict
state = state | comp_mode state = state | comp_mode
if state & comp_itc_flag if state & comp_itc_flag
^(_ffa_(vlist)) = itc_flag ^(_ffa_(vlist)) = itc_flag | showcr_flag
*(_cfa_(vlist)) = @_docolon_ *(_cfa_(vlist)) = @_docolon_
else // comp_pbc_flag else // comp_pbc_flag
_dictaddb_(JSR); _dictaddw_(vmvect) _dictaddb_(JSR); _dictaddw_(vmvect)
@@ -1274,6 +1276,9 @@ def _exit_#0
end end
def _semi_#0 def _semi_#0
_exit_ _exit_
if state & comp_itc_flag // Add double zero at end of definition for SHOW
_dictaddw_(0)
fin
addhash(vlist) addhash(vlist)
state = state & ~comp_flag state = state & ~comp_flag
end end
@@ -1718,7 +1723,7 @@ def _show_#0
fin fin
w = *pfa w = *pfa
while w while w
puts(" ") puts(" ")
if ^_ffa_(w) & param_flag if ^_ffa_(w) & param_flag
pfa = pfa + 2 pfa = pfa + 2
fin fin
@@ -1732,9 +1737,17 @@ def _show_#0
else else
puts(w) puts(w)
fin fin
putln if ^_ffa_(w) & showcr_flag; putln; fin
pfa = pfa + 2 pfa = pfa + 2
w = *pfa w = *pfa
if !w
puts(" EXIT\n")
pfa = pfa + 2
w = *pfa
fin
if conio:keypressed()
getc; getc
fin
loop loop
fin fin
end end
@@ -1891,9 +1904,9 @@ while vlist
if *_cfa_(vlist) == 0 if *_cfa_(vlist) == 0
*_cfa_(vlist) = heapmark *_cfa_(vlist) = heapmark
_dictaddb_(JSR); _dictaddw_(vmvect) _dictaddb_(JSR); _dictaddw_(vmvect)
if ^_ffa_(vlist) == inline_flag if ^_ffa_(vlist) & inline_flag
_dictaddb_(^_pfa_(vlist)) _dictaddb_(^_pfa_(vlist))
elsif ^_ffa_(vlist) == inlinew_flag elsif ^_ffa_(vlist) & inlinew_flag
_dictaddw_(*_pfa_(vlist)) _dictaddw_(*_pfa_(vlist))
else else
puts(vlist); puts(": Invalid dictionary\n") puts(vlist); puts(": Invalid dictionary\n")