6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2024-10-18 07:24:16 +00:00
Code Issues Projects Releases Wiki Activity

Further source cleanup and calling it an Alpha

Browse Source
This commit is contained in:
David Schmenk 2024-01-08 15:55:07 -08:00
parent bc1cf8368d
commit b3f6c7970a
3 changed files with 132 additions and 189 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
images/apple/PLFORTH.PO
View File

Binary file not shown.

76
src/scripts/plasma.4th
View File

@ -1,73 +1,29 @@
' IFACE ENDSRC ( Avoid multiple loads ) ' IFACE ENDSRC ( Avoid multiple loads )
: IFACE 2 * + @ ; : IFACE 2 * + @ ;
LOOKUP CMDSYS 0 IFACE CONSTANT PLASMAVER LOOKUP CMDSYS 0 IFACE CONSTANT PLASMAVER
LOOKUP CMDSYS 2 IFACE CONSTANT CMDLINE LOOKUP CMDSYS 2 IFACE CONSTANT CMDLINE
LOOKUP CMDSYS 3 IFACE PLASMA EXECMOD LOOKUP CMDSYS 3 IFACE PLASMA EXECMOD
LOOKUP STRCPY PLASMA STRCPY LOOKUP STRCPY PLASMA STRCPY
LOOKUP STRCAT PLASMA STRCAT LOOKUP STRCAT PLASMA STRCAT
LOOKUP TOUPPER PLASMA TOUPPER
LOOKUP HEAPAVAIL PLASMA FREEMEM LOOKUP HEAPAVAIL PLASMA FREEMEM
: PLASMAVER.
PLASMAVER 12 RSHIFT $0F AND CHAR 0 + EMIT
PLASMAVER 8 RSHIFT $0F AND CHAR 0 + EMIT
CHAR . EMIT
PLASMAVER 4 RSHIFT $0F AND CHAR 0 + EMIT
PLASMAVER $0F AND CHAR 0 + EMIT
;
: LOADMOD ( modulename paramstr -- ) : LOADMOD ( modulename paramstr -- )
CMDLINE " . " STRCPY DROP ( Dummy parameter for module name ) CMDLINE " . " STRCPY DROP ( Module name )
CMDLINE SWAP STRCAT DROP CMDLINE SWAP STRCAT DROP ( Parameter string )
EXECMOD 0< ABORT" Failed to load module" EXECMOD 0< ABORT" Failed to load module" ;
;
: LOADMOD" ( modulename -- ) : LOADMOD" ( modulename -- )
PAD SWAP STRCPY ( Move module name out of the way in case its immediate ) PAD SWAP STRCPY ( Move module name out of the way in case its immediate )
34 WORD ( Build a string from input ) CHAR " WORD ( Build a string from input )
LOADMOD LOADMOD ;
; : EDIT " ED" " " LOADMOD ;
: EDIT" " ED" LOADMOD" ;
: EDIT : CAT " CAT" " " LOADMOD ;
" ED" " " LOADMOD : CAT" " CAT" LOADMOD" ;
; : DEL" " DEL" LOADMOD" ;
: REN" " REN" LOADMOD" ;
: EDIT" : COPY" " COPY" LOADMOD" ;
" ED" LOADMOD" : NEWDIR" " NEWDIR" LOADMOD" ;
;
: CAT
" CAT" " " LOADMOD
;
: CAT"
" CAT" LOADMOD"
;
: DEL"
" DEL" LOADMOD"
;
: REN"
" REN" LOADMOD"
;
: COPY"
" COPY" LOADMOD"
;
: NEWDIR"
" NEWDIR" LOADMOD"
;
LOOKUP FILEIO 0 IFACE PLASMA GETPFX LOOKUP FILEIO 0 IFACE PLASMA GETPFX
LOOKUP FILEIO 1 IFACE PLASMA SETPFX LOOKUP FILEIO 1 IFACE PLASMA SETPFX
: PFX. HERE GETPFX DROP HERE (.") ;
: PFX. : PFX" 34 WORD SETPFX DROP ;
HERE GETPFX DROP HERE (.")
;
: PFX"
34 WORD SETPFX DROP
;

245
src/toolsrc/plforth.pla
View File

@ -103,25 +103,24 @@ predef _ffa_(a)#1, _lfa_(a)#1, _hfa_(a)#1, _cfa_(a)#1, _pfa_(a)#1, _allot_(a)#0
predef _eq_(a,b)#1, _gt_(a,b)#1, _lt_(a,b)#1, _0lt_(a)#1, _0eq_(a)#1 predef _eq_(a,b)#1, _gt_(a,b)#1, _lt_(a,b)#1, _0lt_(a)#1, _0eq_(a)#1
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, _literal_(a)#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, _leave_#0, _j_#1
predef _create_#0, _itcdoes_(a)#0, _does_#0, _compoff_#0, _compon_#0 predef _create_#0, _itcdoes_(a)#0, _does_#0, _compoff_#0, _compon_#0
predef _compile_#0, pfillw(a)#0, pfillb(a)#0, _colon_#0, _semi_#0 predef _compile_#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
predef _move_(a,b,c)#0, _fill_(a,b,c)#0, _plasma_(a)#0 predef _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, _prat_(a)#0 predef _tick_#0, _forget_#0, _terminal_#1, _prat_(a)#0
predef _blank_#0, _char_#0, _str_#0, _prstr_#0, _prpstr_#0 predef _blank_#0, _char_#0, _str_#0, _prstr_#0, _prpstr_#0
predef _prval_(a)#0, _prbyte_(a)#0, _prhex_(a)#0 predef _prval_(a)#0, _prbyte_(a)#0, _prhex_(a)#0, _accept_(a,b)#1, _type_(a,b)#0
predef _accept_(a,b)#1, _query_#0, _type_(a,b)#0
predef _vlist_#0, _tron_#0, _troff_#0, _stepon_#0, _stepoff_#0 predef _vlist_#0, _tron_#0, _troff_#0, _stepon_#0, _stepoff_#0
predef _itc_#0, _pbc_#0, _comment_#0, _src_(a)#0, _srcstr_#0, _endsrc_(a)#0 predef _itc_#0, _pbc_#0, _comment_#0, _src_(a)#0, _srcstr_#0, _endsrc_(a)#0
predef _brk_#0, _brkon_#0, _brkoff_#0, _word_(a)#1, _count_(a)#2 predef _brk_#0, _brkon_#0, _brkoff_#0, _word_(a)#1, _count_(a)#2
predef _space_#0, _spaces_(a)#0, _show_#0, _showstack_#0, _showrstack_#0 predef _space_#0, _spaces_(a)#0, _show_#0, _showstack_#0, _showrstack_#0
predef _cont_#0, _restart_#0, _bye_#0, _quit_#0 predef _cont_#0, _restart_#0, _bye_#0, _quit_#0
predef _abort_(a)#0, _doabortstr_(a,b)#0, _abortstr_#0 predef _abort_(a)#0, _doabortstr_(a,b)#0, _abortstr_#0
predef compword(dentry)#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
@ -281,7 +280,7 @@ word = @d_cget, 0, @_wget_, $62
// EXECUTE // EXECUTE
char d_execute = "EXECUTE" char d_execute = "EXECUTE"
byte = 0 byte = 0
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 = 0
@ -441,11 +440,11 @@ word = @d_create, 0, @_does_
// COMMA // COMMA
char d_comma = "," char d_comma = ","
byte = 0 byte = 0
word = @d_does, 0, @pfillw word = @d_does, 0, @_dictaddw_
// COMMA // COMMA
char d_commab = "C," char d_commab = "C,"
byte = 0 byte = 0
word = @d_comma, 0, @pfillb word = @d_comma, 0, @_dictaddb_
// COLON // COLON
char d_colon = ":" char d_colon = ":"
byte = interponly_flag byte = interponly_flag
@ -501,7 +500,7 @@ word = 0, 0, @_lit_
// COMPILED LITERAL VALUE FROM STACK // COMPILED LITERAL VALUE FROM STACK
char d_literal = "LITERAL" char d_literal = "LITERAL"
byte = imm_flag byte = imm_flag
word = @d_tick, 0, @_literal_ word = @d_tick, 0, @_compliteral_
// ?TERMINAL // ?TERMINAL
char d_terminal = "?TERMINAL" char d_terminal = "?TERMINAL"
byte = 0 byte = 0
@ -510,26 +509,22 @@ word = @d_literal, 0, @_terminal_
char d_key = "KEY" char d_key = "KEY"
byte = 0 byte = 0
word = @d_terminal, 0, @getc word = @d_terminal, 0, @getc
// QUERY
char d_query = "QUERY"
byte = 0
word = @d_key, 0, @_query_
// ACCEPT // ACCEPT
char d_accept = "ACCEPT" char d_accept = "ACCEPT"
byte = 0 byte = 0
word = @d_query, 0, @_accept_ word = @d_key, 0, @_accept_
// WORD // WORD
char d_word = "WORD" char d_word = "WORD"
byte = 0 byte = 0
word = @d_accept, 0, @_word_ word = @d_accept, 0, @_word_
// ISNUM // _isnum_
char d_isnum = "?NUM" char d__isnum_ = "?NUM"
byte = 0 byte = 0
word = @d_word, 0, @isnum word = @d_word, 0, @_isnum_
// -TRAILING // -TRAILING
char d_trailing = "-TRAILING" char d_trailing = "-TRAILING"
byte = 0 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 = 0
@ -699,14 +694,14 @@ word = @d_pbc, 0, @_vlist_
// //
// Helper routines // Helper routines
// //
predef interpret#0 predef _interpret_#0
def push(a)#1 // Stack hack - call as (@push)(a)#0 to leave a on eval stack def push(a)#1 // Stack hack - call as (@push)(a)#0 to leave a on eval stack
return a return a
end end
def pfillw(a)#0 def _dictaddw_(a)#0
*(heapalloc(2)) = a *(heapalloc(2)) = a
end end
def pfillb(a)#0 def _dictaddb_(a)#0
*(heapalloc(1)) = a *(heapalloc(1)) = a
end end
// //
@ -859,7 +854,7 @@ end
// //
// Convert input into number // Convert input into number
// //
def isnum(numchars, numlen)#2 def _isnum_(numchars, numlen)#2
word num, sign word num, sign
byte numchar byte numchar
@ -924,7 +919,7 @@ def brkhandle(dentry)#0
brk_state = state & comp_flag brk_state = state & comp_flag
state = state & ~comp_flag state = state & ~comp_flag
brk++ brk++
interpret _interpret_
brk-- brk--
state = brk_state | state state = brk_state | state
IIP = brk_iip IIP = brk_iip
@ -934,7 +929,7 @@ end
// //
// Execute code in CFA // Execute code in CFA
// //
def execword(dentry)#0 def _execword_(dentry)#0
when conio:keypressed() when conio:keypressed()
is $83 // CTRL-C is $83 // CTRL-C
getc // Clear KB getc // Clear KB
@ -968,7 +963,7 @@ def execwords(wlist)#0
dentry = *IIP dentry = *IIP
while dentry while dentry
IIP = IIP + 2 IIP = IIP + 2
execword(dentry) _execword_(dentry)
dentry = *IIP dentry = *IIP
loop loop
IIP = prevIP IIP = prevIP
@ -976,57 +971,57 @@ end
// //
// Compile a word/literal into the dictionary: ITC and PBC // Compile a word/literal into the dictionary: ITC and PBC
// //
def compword(dentry)#0 def _compword_(dentry)#0
if ^_ffa_(dentry) & interponly_flag if ^_ffa_(dentry) & interponly_flag
puts("INTERP only word\n") puts("INTERP only word\n")
_quit_ _quit_
elsif state & comp_itc_flag elsif state & comp_itc_flag
pfillw(dentry) _dictaddw_(dentry)
elsif state & comp_pbc_flag elsif state & comp_pbc_flag
if ^_ffa_(dentry) & itc_flag // Check if calling ITC word if ^_ffa_(dentry) & itc_flag // Check if calling ITC word
pfillb($2C) // CONSTANT WORD _dictaddb_($2C) // CONSTANT WORD
pfillw(dentry) // Pointer to dictionary entry _dictaddw_(dentry) // Pointer to dictionary entry
pfillb($54) // CALL execword _dictaddb_($54) // CALL _execword_
pfillw(@execword) _dictaddw_(@_execword_)
elsif ^_ffa_(dentry) & inline_flag // inline bytecode elsif ^_ffa_(dentry) & inline_flag // inline bytecode
pfillb(^_pfa_(dentry)) _dictaddb_(^_pfa_(dentry))
elsif ^_ffa_(dentry) & inlinew_flag // inline 2 bytecodes elsif ^_ffa_(dentry) & inlinew_flag // inline 2 bytecodes
pfillw(*_pfa_(dentry)) _dictaddw_(*_pfa_(dentry))
else else
pfillb($54) // CALL CFA directly _dictaddb_($54) // CALL CFA directly
pfillw(*_cfa_(dentry)) _dictaddw_(*_cfa_(dentry))
fin fin
fin fin
if state & trace_flag if state & trace_flag
putc('['); puts(dentry); puts("] ") putc('['); puts(dentry); puts("] ")
fin fin
end end
def compliteral(value)#0 def _compliteral_(value)#0
if state & comp_itc_flag if state & comp_itc_flag
pfillw(@d_lit) _dictaddw_(@d_lit)
pfillw(value) // Poke literal value into dictionary _dictaddw_(value) // Poke literal value into dictionary
else // comp_pbc_flag else // comp_pbc_flag
if value >= 0 and value <= 255 if value >= 0 and value <= 255
if value <= 15 if value <= 15
pfillb(value << 1) // CONSTANT NIBBLE _dictaddb_(value << 1) // CONSTANT NIBBLE
else else
pfillb($2A) // CONSTANT BYTE _dictaddb_($2A) // CONSTANT BYTE
pfillb(value) // Poke literal value into dictionary _dictaddb_(value) // Poke literal value into dictionary
fin fin
elsif value < 0 and value >= -256 elsif value < 0 and value >= -256
if value == -1 if value == -1
pfillb($20) // CONSTANT MINUS_ONE _dictaddb_($20) // CONSTANT MINUS_ONE
else else
pfillb($5E) // CONSTANT NEGATIVE BYTE _dictaddb_($5E) // CONSTANT NEGATIVE BYTE
pfillb(value) // Poke literal value into dictionary _dictaddb_(value) // Poke literal value into dictionary
fin fin
else else
pfillb($2C) // CONSTANT WORD _dictaddb_($2C) // CONSTANT WORD
pfillw(value) // Poke literal value into dictionary _dictaddw_(value) // Poke literal value into dictionary
fin fin
fin fin
end end
def interpret#0 def _interpret_#0
word inchars, dentry, value word inchars, dentry, value
byte inlen, valid byte inlen, valid
@ -1043,12 +1038,12 @@ def interpret#0
puts(" : Compile only word\n") puts(" : Compile only word\n")
_quit_ _quit_
fin fin
execword(dentry) _execword_(dentry)
else else
compword(dentry) _compword_(dentry)
fin fin
else else
value, valid = isnum(inchars, inlen) value, valid = _isnum_(inchars, inlen)
if not valid if not valid
inchars-- inchars--
^inchars = inlen ^inchars = inlen
@ -1057,7 +1052,7 @@ def interpret#0
warmstart warmstart
else else
if state & comp_flag if state & comp_flag
compliteral(value) _compliteral_(value)
else else
(@push)(value)#0 (@push)(value)#0
fin fin
@ -1277,31 +1272,31 @@ def _plasma_(a)#0
end end
def _var_(a)#0 def _var_(a)#0
newdict newdict
pfillb($20) // Hack - get VM entry vector from divmod _dictaddb_($20) // Hack - get VM entry vector from divmod
pfillw(*(@divmod + 1)) _dictaddw_(*(@divmod + 1))
pfillb($2C) // CONSTANT WORD _dictaddb_($2C) // CONSTANT WORD
pfillw(heapmark + 3) // Poiner to variable in PFA _dictaddw_(heapmark + 3) // Poiner to variable in PFA
pfillb($5C) // RET _dictaddb_($5C) // RET
pfillw(a) // Variable storage _dictaddw_(a) // Variable storage
addhash(vlist) addhash(vlist)
end end
def _const_(a)#0 def _const_(a)#0
newdict newdict
pfillb($20) // Hack - get VM entry vector from divmod _dictaddb_($20) // Hack - get VM entry vector from divmod
pfillw(*(@divmod + 1)) _dictaddw_(*(@divmod + 1))
pfillb($2C) // CONSTANT WORD _dictaddb_($2C) // CONSTANT WORD
pfillw(a) _dictaddw_(a)
pfillb($5C) // RET _dictaddb_($5C) // RET
addhash(vlist) addhash(vlist)
end end
def _create_#0 def _create_#0
newdict newdict
pfillb($20) // Hack - get VM entry vector from divmod _dictaddb_($20) // Hack - get VM entry vector from divmod
pfillw(*(@divmod + 1)) _dictaddw_(*(@divmod + 1))
pfillb($2C) // CONSTANT WORD _dictaddb_($2C) // CONSTANT WORD
pfillw(heapmark + 5) // Pointer to rest of PFA _dictaddw_(heapmark + 5) // Pointer to rest of PFA
pfillb($5C) // RET _dictaddb_($5C) // RET
pfillw(0) // reserved word for DOES> _dictaddw_(0) // reserved word for DOES>
// //
// 9 bytes after PFA, data follows... // 9 bytes after PFA, data follows...
// //
@ -1329,23 +1324,20 @@ def _pbcdoes_(a)#0
end end
def _does_#0 def _does_#0
if state & comp_itc_flag if state & comp_itc_flag
pfillw(@d_lit) _dictaddw_(@d_lit)
pfillw(heapmark + 6) // Pointer to DOES code _dictaddw_(heapmark + 6) // Pointer to DOES code
pfillw(@d_createdoes) _dictaddw_(@d_createdoes)
pfillw(0) _dictaddw_(0)
// End of <BUILDS, beginning of DOES> // End of <BUILDS, beginning of DOES>
else // comp_pbc_flag else // comp_pbc_flag
pfillb($2C) // CONSTANT WORD _dictaddb_($2C) // CONSTANT WORD
pfillw(heapmark + 6) // Pointer to DOES code _dictaddw_(heapmark + 6) // Pointer to DOES code
pfillb($54) // CALL _dictaddb_($54) // CALL
pfillw(@_pbcdoes_) // Fills in code address reserved in _compbuilds_ _dictaddw_(@_pbcdoes_) // Fills in code address reserved in _compbuilds_
pfillb($5C) // RET _dictaddb_($5C) // RET
// End of BUILDS, beginning of DOES> code // End of BUILDS, beginning of DOES> code
fin fin
end end
def _literal_(a)#0
compliteral(a)
end
def _docolon_#0 def _docolon_#0
execwords(W + 2) // Exec PFA execwords(W + 2) // Exec PFA
end end
@ -1356,8 +1348,8 @@ def _colon_#0
^(_ffa_(vlist)) = itc_flag ^(_ffa_(vlist)) = itc_flag
*(_cfa_(vlist)) = @_docolon_ *(_cfa_(vlist)) = @_docolon_
else // comp_pbc_flag else // comp_pbc_flag
pfillb($20) // Hack - get VM entry vector from divmod _dictaddb_($20) // Hack - get VM entry vector from divmod
pfillw(*(@divmod + 1)) _dictaddw_(*(@divmod + 1))
fin fin
if state & trace_flag if state & trace_flag
puts(vlist); putc(' ') puts(vlist); putc(' ')
@ -1365,9 +1357,9 @@ def _colon_#0
end end
def _exit_#0 def _exit_#0
if state & comp_itc_flag if state & comp_itc_flag
pfillw(0) _dictaddw_(0)
elsif state & comp_pbc_flag elsif state & comp_pbc_flag
pfillb($5C) // RET _dictaddb_($5C) // RET
else else
puts("; Not compiling\n") puts("; Not compiling\n")
_quit_ _quit_
@ -1383,7 +1375,7 @@ def _compile_#0
dentry = find(nextword(' ')) dentry = find(nextword(' '))
if dentry if dentry
compword(dentry) _compword_(dentry)
else else
puts("No match\n") puts("No match\n")
_quit_ _quit_
@ -1426,14 +1418,14 @@ def _0branch_(a)#0
fin fin
end end
def _if_#0 def _if_#0
compword(@d_0branch) _compword_(@d_0branch)
_tors_(heapalloc(2)) // Save backfill address _tors_(heapalloc(2)) // Save backfill address
end end
def _else_#0 def _else_#0
word backref word backref
backref = _fromrs_ backref = _fromrs_
compword(@d_branch) _compword_(@d_branch)
_tors_(heapalloc(2)) _tors_(heapalloc(2))
*backref = heapmark *backref = heapmark
end end
@ -1441,15 +1433,15 @@ def _then_#0
*_fromrs_ = heapmark *_fromrs_ = heapmark
end end
def _case_#0 def _case_#0
compword(@d_dup) _compword_(@d_dup)
_tors_(0) // Linked address list _tors_(0) // Linked address list
end end
def _of_#0 def _of_#0
if state & comp_itc_flag if state & comp_itc_flag
pfillw(@d_eq) _dictaddw_(@d_eq)
pfillw(@d_0branch) _dictaddw_(@d_0branch)
else // comp_pbc_flag else // comp_pbc_flag
pfillb($24) // BRNE _dictaddb_($24) // BRNE
fin fin
_tors_(heapalloc(2)) // Save backfill address _tors_(heapalloc(2)) // Save backfill address
end end
@ -1458,27 +1450,27 @@ def _endof_#0
backref = _fromrs_ backref = _fromrs_
link = _fromrs_ link = _fromrs_
compword(@d_branch) _compword_(@d_branch)
_tors_(heapmark) _tors_(heapmark)
pfillw(link) _dictaddw_(link)
if state & comp_itc_flag if state & comp_itc_flag
*backref = heapmark *backref = heapmark
else // comp_pbc_flag else // comp_pbc_flag
*backref = heapmark - backref // Relative branch *backref = heapmark - backref // Relative branch
fin fin
compword(@d_dup) _compword_(@d_dup)
end end
def _endcase_#0 def _endcase_#0
word backref, link word backref, link
compword(@d_drop) _compword_(@d_drop)
backref = _fromrs_ backref = _fromrs_
while backref while backref
link = *backref link = *backref
*backref = heapmark *backref = heapmark
backref = link backref = link
loop loop
compword(@d_drop) _compword_(@d_drop)
end end
def _dodo_(a,b)#0 def _dodo_(a,b)#0
if RSP < 2 if RSP < 2
@ -1490,7 +1482,7 @@ def _dodo_(a,b)#0
RSTACK[RSP] = b RSTACK[RSP] = b
end end
def _do_#0 def _do_#0
compword(@d_dodo) _compword_(@d_dodo)
_tors_(heapmark) _tors_(heapmark)
end end
def _leave_#0 def _leave_#0
@ -1532,23 +1524,23 @@ def _dopbcplusloop_(a)#1
end end
def _loop_#0 def _loop_#0
if state & comp_itc_flag if state & comp_itc_flag
pfillw(@d_doloop) _dictaddw_(@d_doloop)
else // comp_pbc_flag else // comp_pbc_flag
pfillb($54) // CALL _dictaddb_($54) // CALL
pfillw(@_dopbcloop_) _dictaddw_(@_dopbcloop_)
pfillb($C2) // JUMPZ _dictaddb_($C2) // JUMPZ
fin fin
pfillw(_fromrs_) _dictaddw_(_fromrs_)
end end
def _plusloop_#0 def _plusloop_#0
if state & comp_itc_flag if state & comp_itc_flag
pfillw(@d_doplusloop) _dictaddw_(@d_doplusloop)
else // comp_pbc_flag else // comp_pbc_flag
pfillb($54) // CALL _dictaddb_($54) // CALL
pfillw(@_dopbcplusloop_) _dictaddw_(@_dopbcplusloop_)
pfillb($C2) // JUMPZ _dictaddb_($C2) // JUMPZ
fin fin
pfillw(_fromrs_) _dictaddw_(_fromrs_)
end end
def _j_#1 def _j_#1
return RSTACK[RSP + 2] return RSTACK[RSP + 2]
@ -1557,23 +1549,23 @@ def _begin_#0
_tors_(heapmark) _tors_(heapmark)
end end
def _again_#0 def _again_#0
compword(@d_branch) _compword_(@d_branch)
pfillw(_fromrs_) _dictaddw_(_fromrs_)
end end
def _until_#0 def _until_#0
compword(@d_0branch) _compword_(@d_0branch)
pfillw(_fromrs_) _dictaddw_(_fromrs_)
end end
def _while_#0 def _while_#0
compword(@d_0branch) _compword_(@d_0branch)
_tors_(heapalloc(2)) // Save backfill address _tors_(heapalloc(2)) // Save backfill address
end end
def _repeat_#0 def _repeat_#0
word backref word backref
backref = _fromrs_ // Backref from WHILE backref = _fromrs_ // Backref from WHILE
compword(@d_branch) _compword_(@d_branch)
pfillw(_fromrs_) _dictaddw_(_fromrs_)
*backref = heapmark // Backref to BEGIN *backref = heapmark // Backref to BEGIN
end end
def _count_(a)#2 def _count_(a)#2
@ -1593,7 +1585,7 @@ def _tick_#0
dentry = find(nextword(' ')) dentry = find(nextword(' '))
if state & comp_flag if state & comp_flag
compliteral(dentry) _compliteral_(dentry)
else else
(@push)(dentry)#0 (@push)(dentry)#0
fin fin
@ -1616,11 +1608,6 @@ def _forget_#0
_quit_ _quit_
fin fin
end end
def _query_#0
inptr = gets('?'|$80)
^(inptr + ^inptr + 1) = 0
inptr++
end
def _accept_(a,b)#1 def _accept_(a,b)#1
word saveinptr word saveinptr
byte len byte len
@ -1673,7 +1660,7 @@ def _prat_(a)#0
end end
def _blank_#0 def _blank_#0
if state & comp_flag if state & comp_flag
compliteral(32) _compliteral_(32)
else else
(@push)(32)#0 (@push)(32)#0
fin fin
@ -1684,7 +1671,7 @@ def _char_#0
str, len = nextword(' ') str, len = nextword(' ')
if state & comp_flag if state & comp_flag
compliteral(^str) _compliteral_(^str)
else else
(@push)(^str)#0 (@push)(^str)#0
fin fin
@ -1698,7 +1685,7 @@ def _str_#0
^str = len ^str = len
len++ len++
if state & comp_flag if state & comp_flag
compword(@d_slit) _compword_(@d_slit)
memcpy(heapalloc(len), str, len) // Add to dictionary memcpy(heapalloc(len), str, len) // Add to dictionary
else else
(@push)(heapmark)#0 (@push)(heapmark)#0
@ -1718,7 +1705,7 @@ def _prstr_#0
if state & comp_flag if state & comp_flag
_str_ _str_
compword(@d_doprstr) _compword_(@d_doprstr)
else else
str, len = nextword('"') str, len = nextword('"')
str-- str--
@ -1732,7 +1719,7 @@ def _prpstr_#0
if state & comp_flag if state & comp_flag
_str_ _str_
compword(@d_doprstr) _compword_(@d_doprstr)
else else
str, len = nextword(')') str, len = nextword(')')
str-- str--
@ -1799,7 +1786,7 @@ def _srcstr_#0
if state & comp_flag if state & comp_flag
_str_ _str_
compword(@d_src) _compword_(@d_src)
else else
filename, len = nextword('"') filename, len = nextword('"')
filename-- filename--
@ -1962,7 +1949,7 @@ def _abortstr_#0
_str_ _str_
if state & comp_flag if state & comp_flag
compword(@d_doabortstr) _compword_(@d_doabortstr)
else else
(@_doabortstr_)()#0 (@_doabortstr_)()#0
fin fin
@ -1981,7 +1968,7 @@ def _bye_#0
throw(@exitforth, TRUE) throw(@exitforth, TRUE)
end end
puts("FORTH WIP for PLASMA 2.1\n") puts("FORTH (Alpha) for PLASMA 2.1\n")
if cmdsys:sysver < $0201 if cmdsys:sysver < $0201
puts("PLASMA >= 2.01 required\n") puts("PLASMA >= 2.01 required\n")
return return
@ -1994,6 +1981,6 @@ coldstart
inptr = argNext(argFirst) inptr = argNext(argFirst)
if not except(@exitforth) if not except(@exitforth)
if ^inptr; inptr++; _srcstr_; fin if ^inptr; inptr++; _srcstr_; fin
interpret _interpret_
fin fin
done done