mirror of
https://github.com/dschmenk/PLASMA.git
synced 2025-01-09 13:33:26 +00:00
Further source cleanup and calling it an Alpha
This commit is contained in:
David Schmenk
parent
bc1cf8368d
commit
b3f6c7970a
Binary file not shown.
@ -1,73 +1,29 @@
|
||||
' IFACE ENDSRC ( Avoid multiple loads )
|
||||
|
||||
: IFACE 2 * + @ ;
|
||||
|
||||
LOOKUP CMDSYS 0 IFACE CONSTANT PLASMAVER
|
||||
LOOKUP CMDSYS 2 IFACE CONSTANT CMDLINE
|
||||
LOOKUP CMDSYS 3 IFACE PLASMA EXECMOD
|
||||
LOOKUP STRCPY PLASMA STRCPY
|
||||
LOOKUP STRCAT PLASMA STRCAT
|
||||
LOOKUP TOUPPER PLASMA TOUPPER
|
||||
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 -- )
|
||||
CMDLINE " . " STRCPY DROP ( Dummy parameter for module name )
|
||||
CMDLINE SWAP STRCAT DROP
|
||||
EXECMOD 0< ABORT" Failed to load module"
|
||||
;
|
||||
|
||||
CMDLINE " . " STRCPY DROP ( Module name )
|
||||
CMDLINE SWAP STRCAT DROP ( Parameter string )
|
||||
EXECMOD 0< ABORT" Failed to load module" ;
|
||||
: LOADMOD" ( modulename -- )
|
||||
PAD SWAP STRCPY ( Move module name out of the way in case its immediate )
|
||||
34 WORD ( Build a string from input )
|
||||
LOADMOD
|
||||
;
|
||||
|
||||
: EDIT
|
||||
" ED" " " LOADMOD
|
||||
;
|
||||
|
||||
: EDIT"
|
||||
" ED" LOADMOD"
|
||||
;
|
||||
|
||||
: CAT
|
||||
" CAT" " " LOADMOD
|
||||
;
|
||||
|
||||
: CAT"
|
||||
" CAT" LOADMOD"
|
||||
;
|
||||
|
||||
: DEL"
|
||||
" DEL" LOADMOD"
|
||||
;
|
||||
|
||||
: REN"
|
||||
" REN" LOADMOD"
|
||||
;
|
||||
|
||||
: COPY"
|
||||
" COPY" LOADMOD"
|
||||
;
|
||||
|
||||
: NEWDIR"
|
||||
" NEWDIR" LOADMOD"
|
||||
;
|
||||
|
||||
CHAR " WORD ( Build a string from input )
|
||||
LOADMOD ;
|
||||
: EDIT " ED" " " LOADMOD ;
|
||||
: EDIT" " ED" 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 1 IFACE PLASMA SETPFX
|
||||
|
||||
: PFX.
|
||||
HERE GETPFX DROP HERE (.")
|
||||
;
|
||||
|
||||
: PFX"
|
||||
34 WORD SETPFX DROP
|
||||
;
|
||||
: PFX. HERE GETPFX DROP HERE (.") ;
|
||||
: PFX" 34 WORD SETPFX DROP ;
|
||||
@ -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 _branch_#0, _0branch_(a)#0, _if_#0, _else_#0, _then_#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 _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 _tors_(a)#0, _fromrs_#1, _toprs_#1, _lookup_#1
|
||||
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 _tick_#0, _forget_#0, _terminal_#1, _prat_(a)#0
|
||||
predef _blank_#0, _char_#0, _str_#0, _prstr_#0, _prpstr_#0
|
||||
predef _prval_(a)#0, _prbyte_(a)#0, _prhex_(a)#0
|
||||
predef _accept_(a,b)#1, _query_#0, _type_(a,b)#0
|
||||
predef _prval_(a)#0, _prbyte_(a)#0, _prhex_(a)#0, _accept_(a,b)#1, _type_(a,b)#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 _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 _cont_#0, _restart_#0, _bye_#0, _quit_#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
|
||||
char d_drop = "DROP"
|
||||
byte = inline_flag
|
||||
@ -281,7 +280,7 @@ word = @d_cget, 0, @_wget_, $62
|
||||
// EXECUTE
|
||||
char d_execute = "EXECUTE"
|
||||
byte = 0
|
||||
word = @d_wget, 0, @execword
|
||||
word = @d_wget, 0, @_execword_
|
||||
// TO RSTACK
|
||||
char d_torstk = ">R"
|
||||
byte = 0
|
||||
@ -441,11 +440,11 @@ word = @d_create, 0, @_does_
|
||||
// COMMA
|
||||
char d_comma = ","
|
||||
byte = 0
|
||||
word = @d_does, 0, @pfillw
|
||||
word = @d_does, 0, @_dictaddw_
|
||||
// COMMA
|
||||
char d_commab = "C,"
|
||||
byte = 0
|
||||
word = @d_comma, 0, @pfillb
|
||||
word = @d_comma, 0, @_dictaddb_
|
||||
// COLON
|
||||
char d_colon = ":"
|
||||
byte = interponly_flag
|
||||
@ -501,7 +500,7 @@ word = 0, 0, @_lit_
|
||||
// COMPILED LITERAL VALUE FROM STACK
|
||||
char d_literal = "LITERAL"
|
||||
byte = imm_flag
|
||||
word = @d_tick, 0, @_literal_
|
||||
word = @d_tick, 0, @_compliteral_
|
||||
// ?TERMINAL
|
||||
char d_terminal = "?TERMINAL"
|
||||
byte = 0
|
||||
@ -510,26 +509,22 @@ word = @d_literal, 0, @_terminal_
|
||||
char d_key = "KEY"
|
||||
byte = 0
|
||||
word = @d_terminal, 0, @getc
|
||||
// QUERY
|
||||
char d_query = "QUERY"
|
||||
byte = 0
|
||||
word = @d_key, 0, @_query_
|
||||
// ACCEPT
|
||||
char d_accept = "ACCEPT"
|
||||
byte = 0
|
||||
word = @d_query, 0, @_accept_
|
||||
word = @d_key, 0, @_accept_
|
||||
// WORD
|
||||
char d_word = "WORD"
|
||||
byte = 0
|
||||
word = @d_accept, 0, @_word_
|
||||
// ISNUM
|
||||
char d_isnum = "?NUM"
|
||||
// _isnum_
|
||||
char d__isnum_ = "?NUM"
|
||||
byte = 0
|
||||
word = @d_word, 0, @isnum
|
||||
word = @d_word, 0, @_isnum_
|
||||
// -TRAILING
|
||||
char d_trailing = "-TRAILING"
|
||||
byte = 0
|
||||
word = @d_isnum, 0, @_trailing_
|
||||
word = @d__isnum_, 0, @_trailing_
|
||||
// PRINT @TOS
|
||||
char d_prat = "?"
|
||||
byte = 0
|
||||
@ -699,14 +694,14 @@ word = @d_pbc, 0, @_vlist_
|
||||
//
|
||||
// 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
|
||||
return a
|
||||
end
|
||||
def pfillw(a)#0
|
||||
def _dictaddw_(a)#0
|
||||
*(heapalloc(2)) = a
|
||||
end
|
||||
def pfillb(a)#0
|
||||
def _dictaddb_(a)#0
|
||||
*(heapalloc(1)) = a
|
||||
end
|
||||
//
|
||||
@ -859,7 +854,7 @@ end
|
||||
//
|
||||
// Convert input into number
|
||||
//
|
||||
def isnum(numchars, numlen)#2
|
||||
def _isnum_(numchars, numlen)#2
|
||||
word num, sign
|
||||
byte numchar
|
||||
|
||||
@ -924,7 +919,7 @@ def brkhandle(dentry)#0
|
||||
brk_state = state & comp_flag
|
||||
state = state & ~comp_flag
|
||||
brk++
|
||||
interpret
|
||||
_interpret_
|
||||
brk--
|
||||
state = brk_state | state
|
||||
IIP = brk_iip
|
||||
@ -934,7 +929,7 @@ end
|
||||
//
|
||||
// Execute code in CFA
|
||||
//
|
||||
def execword(dentry)#0
|
||||
def _execword_(dentry)#0
|
||||
when conio:keypressed()
|
||||
is $83 // CTRL-C
|
||||
getc // Clear KB
|
||||
@ -968,7 +963,7 @@ def execwords(wlist)#0
|
||||
dentry = *IIP
|
||||
while dentry
|
||||
IIP = IIP + 2
|
||||
execword(dentry)
|
||||
_execword_(dentry)
|
||||
dentry = *IIP
|
||||
loop
|
||||
IIP = prevIP
|
||||
@ -976,57 +971,57 @@ end
|
||||
//
|
||||
// Compile a word/literal into the dictionary: ITC and PBC
|
||||
//
|
||||
def compword(dentry)#0
|
||||
def _compword_(dentry)#0
|
||||
if ^_ffa_(dentry) & interponly_flag
|
||||
puts("INTERP only word\n")
|
||||
_quit_
|
||||
elsif state & comp_itc_flag
|
||||
pfillw(dentry)
|
||||
_dictaddw_(dentry)
|
||||
elsif state & comp_pbc_flag
|
||||
if ^_ffa_(dentry) & itc_flag // Check if calling ITC word
|
||||
pfillb($2C) // CONSTANT WORD
|
||||
pfillw(dentry) // Pointer to dictionary entry
|
||||
pfillb($54) // CALL execword
|
||||
pfillw(@execword)
|
||||
_dictaddb_($2C) // CONSTANT WORD
|
||||
_dictaddw_(dentry) // Pointer to dictionary entry
|
||||
_dictaddb_($54) // CALL _execword_
|
||||
_dictaddw_(@_execword_)
|
||||
elsif ^_ffa_(dentry) & inline_flag // inline bytecode
|
||||
pfillb(^_pfa_(dentry))
|
||||
_dictaddb_(^_pfa_(dentry))
|
||||
elsif ^_ffa_(dentry) & inlinew_flag // inline 2 bytecodes
|
||||
pfillw(*_pfa_(dentry))
|
||||
_dictaddw_(*_pfa_(dentry))
|
||||
else
|
||||
pfillb($54) // CALL CFA directly
|
||||
pfillw(*_cfa_(dentry))
|
||||
_dictaddb_($54) // CALL CFA directly
|
||||
_dictaddw_(*_cfa_(dentry))
|
||||
fin
|
||||
fin
|
||||
if state & trace_flag
|
||||
putc('['); puts(dentry); puts("] ")
|
||||
fin
|
||||
end
|
||||
def compliteral(value)#0
|
||||
def _compliteral_(value)#0
|
||||
if state & comp_itc_flag
|
||||
pfillw(@d_lit)
|
||||
pfillw(value) // Poke literal value into dictionary
|
||||
_dictaddw_(@d_lit)
|
||||
_dictaddw_(value) // Poke literal value into dictionary
|
||||
else // comp_pbc_flag
|
||||
if value >= 0 and value <= 255
|
||||
if value <= 15
|
||||
pfillb(value << 1) // CONSTANT NIBBLE
|
||||
_dictaddb_(value << 1) // CONSTANT NIBBLE
|
||||
else
|
||||
pfillb($2A) // CONSTANT BYTE
|
||||
pfillb(value) // Poke literal value into dictionary
|
||||
_dictaddb_($2A) // CONSTANT BYTE
|
||||
_dictaddb_(value) // Poke literal value into dictionary
|
||||
fin
|
||||
elsif value < 0 and value >= -256
|
||||
if value == -1
|
||||
pfillb($20) // CONSTANT MINUS_ONE
|
||||
_dictaddb_($20) // CONSTANT MINUS_ONE
|
||||
else
|
||||
pfillb($5E) // CONSTANT NEGATIVE BYTE
|
||||
pfillb(value) // Poke literal value into dictionary
|
||||
_dictaddb_($5E) // CONSTANT NEGATIVE BYTE
|
||||
_dictaddb_(value) // Poke literal value into dictionary
|
||||
fin
|
||||
else
|
||||
pfillb($2C) // CONSTANT WORD
|
||||
pfillw(value) // Poke literal value into dictionary
|
||||
_dictaddb_($2C) // CONSTANT WORD
|
||||
_dictaddw_(value) // Poke literal value into dictionary
|
||||
fin
|
||||
fin
|
||||
end
|
||||
def interpret#0
|
||||
def _interpret_#0
|
||||
word inchars, dentry, value
|
||||
byte inlen, valid
|
||||
|
||||
@ -1043,12 +1038,12 @@ def interpret#0
|
||||
puts(" : Compile only word\n")
|
||||
_quit_
|
||||
fin
|
||||
execword(dentry)
|
||||
_execword_(dentry)
|
||||
else
|
||||
compword(dentry)
|
||||
_compword_(dentry)
|
||||
fin
|
||||
else
|
||||
value, valid = isnum(inchars, inlen)
|
||||
value, valid = _isnum_(inchars, inlen)
|
||||
if not valid
|
||||
inchars--
|
||||
^inchars = inlen
|
||||
@ -1057,7 +1052,7 @@ def interpret#0
|
||||
warmstart
|
||||
else
|
||||
if state & comp_flag
|
||||
compliteral(value)
|
||||
_compliteral_(value)
|
||||
else
|
||||
(@push)(value)#0
|
||||
fin
|
||||
@ -1277,31 +1272,31 @@ def _plasma_(a)#0
|
||||
end
|
||||
def _var_(a)#0
|
||||
newdict
|
||||
pfillb($20) // Hack - get VM entry vector from divmod
|
||||
pfillw(*(@divmod + 1))
|
||||
pfillb($2C) // CONSTANT WORD
|
||||
pfillw(heapmark + 3) // Poiner to variable in PFA
|
||||
pfillb($5C) // RET
|
||||
pfillw(a) // Variable storage
|
||||
_dictaddb_($20) // Hack - get VM entry vector from divmod
|
||||
_dictaddw_(*(@divmod + 1))
|
||||
_dictaddb_($2C) // CONSTANT WORD
|
||||
_dictaddw_(heapmark + 3) // Poiner to variable in PFA
|
||||
_dictaddb_($5C) // RET
|
||||
_dictaddw_(a) // Variable storage
|
||||
addhash(vlist)
|
||||
end
|
||||
def _const_(a)#0
|
||||
newdict
|
||||
pfillb($20) // Hack - get VM entry vector from divmod
|
||||
pfillw(*(@divmod + 1))
|
||||
pfillb($2C) // CONSTANT WORD
|
||||
pfillw(a)
|
||||
pfillb($5C) // RET
|
||||
_dictaddb_($20) // Hack - get VM entry vector from divmod
|
||||
_dictaddw_(*(@divmod + 1))
|
||||
_dictaddb_($2C) // CONSTANT WORD
|
||||
_dictaddw_(a)
|
||||
_dictaddb_($5C) // RET
|
||||
addhash(vlist)
|
||||
end
|
||||
def _create_#0
|
||||
newdict
|
||||
pfillb($20) // Hack - get VM entry vector from divmod
|
||||
pfillw(*(@divmod + 1))
|
||||
pfillb($2C) // CONSTANT WORD
|
||||
pfillw(heapmark + 5) // Pointer to rest of PFA
|
||||
pfillb($5C) // RET
|
||||
pfillw(0) // reserved word for DOES>
|
||||
_dictaddb_($20) // Hack - get VM entry vector from divmod
|
||||
_dictaddw_(*(@divmod + 1))
|
||||
_dictaddb_($2C) // CONSTANT WORD
|
||||
_dictaddw_(heapmark + 5) // Pointer to rest of PFA
|
||||
_dictaddb_($5C) // RET
|
||||
_dictaddw_(0) // reserved word for DOES>
|
||||
//
|
||||
// 9 bytes after PFA, data follows...
|
||||
//
|
||||
@ -1329,23 +1324,20 @@ def _pbcdoes_(a)#0
|
||||
end
|
||||
def _does_#0
|
||||
if state & comp_itc_flag
|
||||
pfillw(@d_lit)
|
||||
pfillw(heapmark + 6) // Pointer to DOES code
|
||||
pfillw(@d_createdoes)
|
||||
pfillw(0)
|
||||
_dictaddw_(@d_lit)
|
||||
_dictaddw_(heapmark + 6) // Pointer to DOES code
|
||||
_dictaddw_(@d_createdoes)
|
||||
_dictaddw_(0)
|
||||
// End of <BUILDS, beginning of DOES>
|
||||
else // comp_pbc_flag
|
||||
pfillb($2C) // CONSTANT WORD
|
||||
pfillw(heapmark + 6) // Pointer to DOES code
|
||||
pfillb($54) // CALL
|
||||
pfillw(@_pbcdoes_) // Fills in code address reserved in _compbuilds_
|
||||
pfillb($5C) // RET
|
||||
_dictaddb_($2C) // CONSTANT WORD
|
||||
_dictaddw_(heapmark + 6) // Pointer to DOES code
|
||||
_dictaddb_($54) // CALL
|
||||
_dictaddw_(@_pbcdoes_) // Fills in code address reserved in _compbuilds_
|
||||
_dictaddb_($5C) // RET
|
||||
// End of BUILDS, beginning of DOES> code
|
||||
fin
|
||||
end
|
||||
def _literal_(a)#0
|
||||
compliteral(a)
|
||||
end
|
||||
def _docolon_#0
|
||||
execwords(W + 2) // Exec PFA
|
||||
end
|
||||
@ -1356,8 +1348,8 @@ def _colon_#0
|
||||
^(_ffa_(vlist)) = itc_flag
|
||||
*(_cfa_(vlist)) = @_docolon_
|
||||
else // comp_pbc_flag
|
||||
pfillb($20) // Hack - get VM entry vector from divmod
|
||||
pfillw(*(@divmod + 1))
|
||||
_dictaddb_($20) // Hack - get VM entry vector from divmod
|
||||
_dictaddw_(*(@divmod + 1))
|
||||
fin
|
||||
if state & trace_flag
|
||||
puts(vlist); putc(' ')
|
||||
@ -1365,9 +1357,9 @@ def _colon_#0
|
||||
end
|
||||
def _exit_#0
|
||||
if state & comp_itc_flag
|
||||
pfillw(0)
|
||||
_dictaddw_(0)
|
||||
elsif state & comp_pbc_flag
|
||||
pfillb($5C) // RET
|
||||
_dictaddb_($5C) // RET
|
||||
else
|
||||
puts("; Not compiling\n")
|
||||
_quit_
|
||||
@ -1383,7 +1375,7 @@ def _compile_#0
|
||||
|
||||
dentry = find(nextword(' '))
|
||||
if dentry
|
||||
compword(dentry)
|
||||
_compword_(dentry)
|
||||
else
|
||||
puts("No match\n")
|
||||
_quit_
|
||||
@ -1426,14 +1418,14 @@ def _0branch_(a)#0
|
||||
fin
|
||||
end
|
||||
def _if_#0
|
||||
compword(@d_0branch)
|
||||
_compword_(@d_0branch)
|
||||
_tors_(heapalloc(2)) // Save backfill address
|
||||
end
|
||||
def _else_#0
|
||||
word backref
|
||||
|
||||
backref = _fromrs_
|
||||
compword(@d_branch)
|
||||
_compword_(@d_branch)
|
||||
_tors_(heapalloc(2))
|
||||
*backref = heapmark
|
||||
end
|
||||
@ -1441,15 +1433,15 @@ def _then_#0
|
||||
*_fromrs_ = heapmark
|
||||
end
|
||||
def _case_#0
|
||||
compword(@d_dup)
|
||||
_compword_(@d_dup)
|
||||
_tors_(0) // Linked address list
|
||||
end
|
||||
def _of_#0
|
||||
if state & comp_itc_flag
|
||||
pfillw(@d_eq)
|
||||
pfillw(@d_0branch)
|
||||
_dictaddw_(@d_eq)
|
||||
_dictaddw_(@d_0branch)
|
||||
else // comp_pbc_flag
|
||||
pfillb($24) // BRNE
|
||||
_dictaddb_($24) // BRNE
|
||||
fin
|
||||
_tors_(heapalloc(2)) // Save backfill address
|
||||
end
|
||||
@ -1458,27 +1450,27 @@ def _endof_#0
|
||||
|
||||
backref = _fromrs_
|
||||
link = _fromrs_
|
||||
compword(@d_branch)
|
||||
_compword_(@d_branch)
|
||||
_tors_(heapmark)
|
||||
pfillw(link)
|
||||
_dictaddw_(link)
|
||||
if state & comp_itc_flag
|
||||
*backref = heapmark
|
||||
else // comp_pbc_flag
|
||||
*backref = heapmark - backref // Relative branch
|
||||
fin
|
||||
compword(@d_dup)
|
||||
_compword_(@d_dup)
|
||||
end
|
||||
def _endcase_#0
|
||||
word backref, link
|
||||
|
||||
compword(@d_drop)
|
||||
_compword_(@d_drop)
|
||||
backref = _fromrs_
|
||||
while backref
|
||||
link = *backref
|
||||
*backref = heapmark
|
||||
backref = link
|
||||
loop
|
||||
compword(@d_drop)
|
||||
_compword_(@d_drop)
|
||||
end
|
||||
def _dodo_(a,b)#0
|
||||
if RSP < 2
|
||||
@ -1490,7 +1482,7 @@ def _dodo_(a,b)#0
|
||||
RSTACK[RSP] = b
|
||||
end
|
||||
def _do_#0
|
||||
compword(@d_dodo)
|
||||
_compword_(@d_dodo)
|
||||
_tors_(heapmark)
|
||||
end
|
||||
def _leave_#0
|
||||
@ -1532,23 +1524,23 @@ def _dopbcplusloop_(a)#1
|
||||
end
|
||||
def _loop_#0
|
||||
if state & comp_itc_flag
|
||||
pfillw(@d_doloop)
|
||||
_dictaddw_(@d_doloop)
|
||||
else // comp_pbc_flag
|
||||
pfillb($54) // CALL
|
||||
pfillw(@_dopbcloop_)
|
||||
pfillb($C2) // JUMPZ
|
||||
_dictaddb_($54) // CALL
|
||||
_dictaddw_(@_dopbcloop_)
|
||||
_dictaddb_($C2) // JUMPZ
|
||||
fin
|
||||
pfillw(_fromrs_)
|
||||
_dictaddw_(_fromrs_)
|
||||
end
|
||||
def _plusloop_#0
|
||||
if state & comp_itc_flag
|
||||
pfillw(@d_doplusloop)
|
||||
_dictaddw_(@d_doplusloop)
|
||||
else // comp_pbc_flag
|
||||
pfillb($54) // CALL
|
||||
pfillw(@_dopbcplusloop_)
|
||||
pfillb($C2) // JUMPZ
|
||||
_dictaddb_($54) // CALL
|
||||
_dictaddw_(@_dopbcplusloop_)
|
||||
_dictaddb_($C2) // JUMPZ
|
||||
fin
|
||||
pfillw(_fromrs_)
|
||||
_dictaddw_(_fromrs_)
|
||||
end
|
||||
def _j_#1
|
||||
return RSTACK[RSP + 2]
|
||||
@ -1557,23 +1549,23 @@ def _begin_#0
|
||||
_tors_(heapmark)
|
||||
end
|
||||
def _again_#0
|
||||
compword(@d_branch)
|
||||
pfillw(_fromrs_)
|
||||
_compword_(@d_branch)
|
||||
_dictaddw_(_fromrs_)
|
||||
end
|
||||
def _until_#0
|
||||
compword(@d_0branch)
|
||||
pfillw(_fromrs_)
|
||||
_compword_(@d_0branch)
|
||||
_dictaddw_(_fromrs_)
|
||||
end
|
||||
def _while_#0
|
||||
compword(@d_0branch)
|
||||
_compword_(@d_0branch)
|
||||
_tors_(heapalloc(2)) // Save backfill address
|
||||
end
|
||||
def _repeat_#0
|
||||
word backref
|
||||
|
||||
backref = _fromrs_ // Backref from WHILE
|
||||
compword(@d_branch)
|
||||
pfillw(_fromrs_)
|
||||
_compword_(@d_branch)
|
||||
_dictaddw_(_fromrs_)
|
||||
*backref = heapmark // Backref to BEGIN
|
||||
end
|
||||
def _count_(a)#2
|
||||
@ -1593,7 +1585,7 @@ def _tick_#0
|
||||
|
||||
dentry = find(nextword(' '))
|
||||
if state & comp_flag
|
||||
compliteral(dentry)
|
||||
_compliteral_(dentry)
|
||||
else
|
||||
(@push)(dentry)#0
|
||||
fin
|
||||
@ -1616,11 +1608,6 @@ def _forget_#0
|
||||
_quit_
|
||||
fin
|
||||
end
|
||||
def _query_#0
|
||||
inptr = gets('?'|$80)
|
||||
^(inptr + ^inptr + 1) = 0
|
||||
inptr++
|
||||
end
|
||||
def _accept_(a,b)#1
|
||||
word saveinptr
|
||||
byte len
|
||||
@ -1673,7 +1660,7 @@ def _prat_(a)#0
|
||||
end
|
||||
def _blank_#0
|
||||
if state & comp_flag
|
||||
compliteral(32)
|
||||
_compliteral_(32)
|
||||
else
|
||||
(@push)(32)#0
|
||||
fin
|
||||
@ -1684,7 +1671,7 @@ def _char_#0
|
||||
|
||||
str, len = nextword(' ')
|
||||
if state & comp_flag
|
||||
compliteral(^str)
|
||||
_compliteral_(^str)
|
||||
else
|
||||
(@push)(^str)#0
|
||||
fin
|
||||
@ -1698,7 +1685,7 @@ def _str_#0
|
||||
^str = len
|
||||
len++
|
||||
if state & comp_flag
|
||||
compword(@d_slit)
|
||||
_compword_(@d_slit)
|
||||
memcpy(heapalloc(len), str, len) // Add to dictionary
|
||||
else
|
||||
(@push)(heapmark)#0
|
||||
@ -1718,7 +1705,7 @@ def _prstr_#0
|
||||
|
||||
if state & comp_flag
|
||||
_str_
|
||||
compword(@d_doprstr)
|
||||
_compword_(@d_doprstr)
|
||||
else
|
||||
str, len = nextword('"')
|
||||
str--
|
||||
@ -1732,7 +1719,7 @@ def _prpstr_#0
|
||||
|
||||
if state & comp_flag
|
||||
_str_
|
||||
compword(@d_doprstr)
|
||||
_compword_(@d_doprstr)
|
||||
else
|
||||
str, len = nextword(')')
|
||||
str--
|
||||
@ -1799,7 +1786,7 @@ def _srcstr_#0
|
||||
|
||||
if state & comp_flag
|
||||
_str_
|
||||
compword(@d_src)
|
||||
_compword_(@d_src)
|
||||
else
|
||||
filename, len = nextword('"')
|
||||
filename--
|
||||
@ -1962,7 +1949,7 @@ def _abortstr_#0
|
||||
|
||||
_str_
|
||||
if state & comp_flag
|
||||
compword(@d_doabortstr)
|
||||
_compword_(@d_doabortstr)
|
||||
else
|
||||
(@_doabortstr_)()#0
|
||||
fin
|
||||
@ -1981,7 +1968,7 @@ def _bye_#0
|
||||
throw(@exitforth, TRUE)
|
||||
end
|
||||
|
||||
puts("FORTH WIP for PLASMA 2.1\n")
|
||||
puts("FORTH (Alpha) for PLASMA 2.1\n")
|
||||
if cmdsys:sysver < $0201
|
||||
puts("PLASMA >= 2.01 required\n")
|
||||
return
|
||||
@ -1994,6 +1981,6 @@ coldstart
|
||||
inptr = argNext(argFirst)
|
||||
if not except(@exitforth)
|
||||
if ^inptr; inptr++; _srcstr_; fin
|
||||
interpret
|
||||
_interpret_
|
||||
fin
|
||||
done
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user