From 5dabd1dbb7b4f52772b4c5c79082e4fb3f953359 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Tue, 26 Dec 2023 21:41:20 -0800 Subject: [PATCH] Compile both Indirect Threaded Code and PLASMA Byte Code --- src/toolsrc/plforth.pla | 494 +++++++++++++++++++++++++--------------- 1 file changed, 311 insertions(+), 183 deletions(-) diff --git a/src/toolsrc/plforth.pla b/src/toolsrc/plforth.pla index b7c5df0..8d26b39 100644 --- a/src/toolsrc/plforth.pla +++ b/src/toolsrc/plforth.pla @@ -17,6 +17,8 @@ include "inc/args.plh" // // Mask and flags for dictionary entries // +const param_flag = $04 +const itc_flag = $08 const inline_flag = $10 const imm_flag = $20 const componly_flag = $40 @@ -32,25 +34,25 @@ predef _cfa_(a)#1, _lfa_(a)#1 predef _eq_(a,b)#1, _gt_(a,b)#1, _lt_(a,b)#1 predef _branch_#0, _branch0_(a)#0, _if_#0, _else_#0, _then_#0 predef _do_#0, _doloop_#0, _leave_#0, _loop_#0, _j_#1 -predef _create_#0, _dodoes_#0, _filldoes_#0, _does_#0 -predef _pset_(a)#0, _colon_#0, _semi_#0 +predef _bldcreate_#0, _builds_#0, _dodoes_#0, _filldoes_#0, _does_#0 +predef pfillw(a)#0, pfillb(a)#0, _colon_#0, _semi_#0 predef _tors_(a)#0, _fromrs_#1, _toprs_#1 predef _var_(a)#0, _const_(a)#0, _lit_#1, _slit_#1, _tick_#1, _forget_#0 predef _str_#0, _prstr_#0, _src_#0 -predef _vlist_#0, _tron_#0, _troff_#0, _checkon_#0, _checkoff_#0 +predef _vlist_#0, _tron_#0, _troff_#0, _itc_#0, _pbc_#0 predef _show_#0, _showstack_#0, _bye_#0, _abort_#0 // DROP char d_drop = "DROP" -byte = 0 -word = 0, @_drop_, 0 +byte = inline_flag +word = 0, @_drop_, $30 // SWAP char d_swap = "SWAP" -byte = 0 +byte = inline_flag word = @d_drop, @_swap_, 0 // DUP char d_dup = "DUP" -byte = 0 -word = @d_swap, @_dup_, 0 +byte = inline_flag +word = @d_swap, @_dup_, $34 // OVER word d_over = "OVER" byte = 0 @@ -61,68 +63,68 @@ byte = 0 word = @d_over, @_rot_, 0 // ADD char d_add = "+" -byte = 0 -word = @d_rot, @_add_, 0 +byte = inline_flag +word = @d_rot, @_add_, $82 // SUB char d_sub = "-" -byte = 0 -word = @d_add, @_sub_, 0 +byte = inline_flag +word = @d_add, @_sub_, $84 // MUL char d_mul = "*" -byte = 0 -word = @d_sub, @_mul_, 0 +byte = inline_flag +word = @d_sub, @_mul_, $86 // DIV char d_div = "/" -byte = 0 -word = @d_mul, @_div_, 0 +byte = inline_flag +word = @d_mul, @_div_, $88 // NEG char d_neg = "NEG" -byte = 0 -word = @d_div, @_neg_, 0 +byte = inline_flag +word = @d_div, @_neg_, $90 // AND char d_and = "AND" -byte = 0 -word = @d_neg, @_and_, 0 +byte = inline_flag +word = @d_neg, @_and_, $94 // OR char d_or = "OR" -byte = 0 -word = @d_and, @_or_, 0 +byte = inline_flag +word = @d_and, @_or_, $96 // XOR char d_xor = "XOR" -byte = 0 -word = @d_or, @_xor_, 0 +byte = inline_flag +word = @d_or, @_xor_, $98 // NOT char d_not = "NOT" -byte = 0 -word = @d_xor, @_not_, 0 +byte = inline_flag +word = @d_xor, @_not_, $92 // EQUALS char d_eq = "=" -byte = 0 -word = @d_not, @_eq_, 0 +byte = inline_flag +word = @d_not, @_eq_, $40 // GREATER THAN char d_gt = ">" -byte = 0 -word = @d_eq, @_gt_, 0 +byte = inline_flag +word = @d_eq, @_gt_, $44 // LESS THAN char d_lt = "<" -byte = 0 -word = @d_gt, @_lt_, 0 +byte = inline_flag +word = @d_gt, @_lt_, $46 // CHAR PUT char d_cset = "C!" -byte = 0 -word = @d_lt, @_cset_, 0 +byte = inline_flag +word = @d_lt, @_cset_, $70 // WORD PUT char d_wset = "!" -byte = 0 -word = @d_cset, @_wset_, 0 +byte = inline_flag +word = @d_cset, @_wset_, $72 // CHAR GET char d_cget = "C@" -byte = 0 -word = @d_wset, @_cget_, 0 +byte = inline_flag +word = @d_wset, @_cget_, $60 // WORD SET char d_wget = "@" -byte = 0 -word = @d_cget, @_wget_, 0 +byte = inline_flag +word = @d_cget, @_wget_, $62 // TO RSTACK char d_torstk = ">R" byte = 0 @@ -153,11 +155,11 @@ byte = 0 word = @d_here, @heapalloc, 0 // BRANCH char d_branch = "(BRANCH)" -byte = inline_flag +byte = param_flag word = @d_allot, @_branch_, 0 // BRANCH IF 0 char d_branch0 = "(BRANCH0)" -byte = inline_flag +byte = param_flag word = @d_branch, @_branch0_, 0 // IF char d_if = "IF" @@ -181,7 +183,7 @@ byte = componly_flag word = @d_do, @_leave_, 0 // LOOP char d_doloop = "(DOLOOP)" -byte = componly_flag | inline_flag +byte = param_flag word = @d_leave, @_doloop_, 0 // LOOP char d_loop = "LOOP" @@ -199,10 +201,14 @@ word = @d_i, @_j_, 0 char d_forget = "FORGET" byte = 0 word = @d_j, @_forget_, 0 +// CREATE +char d_create = "(CREATE)" +byte = 0 +word = @d_forget, @_bldcreate_, 0 // BUILDS char d_builds = " _toprs_ - _tors_(count) - IIP = *IIP - else - _fromrs_ + RSTACK[RSP]++ + if RSTACK[RSP] == RSTACK[RSP + 1] + RSP = RSP + 2 IIP = IIP + 2 + else + IIP = *IIP fin end +def _dopbcloop_#1 + RSTACK[RSP]++ + if RSTACK[RSP] == RSTACK[RSP + 1] + RSP = RSP + 2 + return TRUE + fin + return FALSE +end def _loop_#0 - *(heapalloc(2)) = @d_doloop - *(heapalloc(2)) = _fromrs_ + if state & comp_itc_flag + pfillw(@d_doloop) + pfillw(_fromrs_) + else // comp_pbc_flag + pfillb($54) // CALL + pfillw(@_dopbcloop_) + pfillb($4C) // BRFLS + pfillw(_fromrs_ - heapmark) + fin end def _j_#1 return RSTACK[RSP + 2] @@ -807,35 +898,38 @@ def _bye_#0 state = state | exit_flag end def _str_#0 - word str, dict - byte len - - str, len = delimit('"') - str-- - ^str = len - len++ - if state & comp_flag - *(heapalloc(2)) = @d_slit - fin - dict = heapalloc(len) - memcpy(dict, str, len) - if not state & comp_flag - (@push)(dict)#0 - fin -end -def _prstr_#0 word str byte len str, len = delimit('"') str-- ^str = len - if state & comp_flag - len++ - *(heapalloc(2)) = @d_slit - memcpy(heapalloc(len), str, len) - *(heapalloc(2)) = @d_doprstr + len++ + if state & comp_itc_flag + pfillw(@d_slit) + elsif state & comp_pbc_flag + pfillb($2E) // CONSTANT STRING else + (@push)(heapmark)#0 + fin + memcpy(heapalloc(len), str, len) +end +def _prstr_#0 + word str + byte len + + if state & comp_flag + _str_ + if state & comp_itc_flag + pfillw(@d_doprstr) + else // comp_pbc_flag + pfillb($54) // CALL + pfillw(*_cfa_(@d_doprstr)) + fin + else + str, len = delimit('"') + str-- + ^str = len puts(str) fin end @@ -861,28 +955,33 @@ def _show_#0 dentry = find(toknext) if dentry - if *_cfa_(dentry) == @_docolon_ - pfa = _pfa_(dentry) - else - pfa = *_pfa_(dentry) - fin - w = *pfa - while w - puts(" "); puts(w) - if ^_ffa_(w) & inline_flag - pfa = pfa + 2 - putc('=') - if *_cfa_(w) == @_slit_ - puts(pfa) - pfa = pfa + ^pfa - 1 - else - puti(*pfa) - fin + if ^_ffa_(dentry) & itc_flag // Only show ITC words + if *_cfa_(dentry) == @_docolon_ + pfa = _pfa_(dentry) + else // @d_dodoes + pfa = *_pfa_(dentry) fin - putln - pfa = pfa + 2 w = *pfa - loop + while w + puts(" ") + if ^_ffa_(w) & param_flag + pfa = pfa + 2 + fin + if w == @d_slit + putc('"') + puts(pfa) + putc('"') + pfa = pfa + ^pfa - 1 + elsif w == @d_lit + puti(*pfa) + else + puts(w) + fin + putln + pfa = pfa + 2 + w = *pfa + loop + fin fin end def _showstack_#0 @@ -900,11 +999,11 @@ end def _troff_#0 trace = 0 end -def _checkon_#0 - execwords = @execwords_check +def _itc_#0 + comp_mode = comp_itc_flag end -def _checkoff_#0 - execwords = @execwords_nocheck +def _pbc_#0 + comp_mode = comp_pbc_flag end def _vlist_#0 word d @@ -947,8 +1046,8 @@ end // Quit and look for user input // def _quit_#0 - word inchars, dentry - byte inlen, i + word inchars, dentry, value + byte inlen, valid // // Set flags on words @@ -959,15 +1058,45 @@ def _quit_#0 if dentry if (not state & comp_flag) or (^_ffa_(dentry) & imm_flag) execword(dentry) - else - _pset_(dentry) + elsif state & comp_itc_flag + pfillw(dentry) + else // 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) + elsif ^_ffa_(dentry) & inline_flag // inline bytecode + pfillb(^_pfa_(dentry)) + else + pfillb($54) // CALL CFA directly + pfillw(*_cfa_(dentry)) + fin + fin + else + value, valid = isnum(inchars, inlen) + if not valid + _warmstart_ + puts("? No match\n") + else + if state & comp_flag + if state & comp_itc_flag + pfillw(@d_lit) + pfillw(value) // Poke literal value into PFA + else // comp_pbc_flag + if value >= 0 and value <= 15 + pfillb(value << 1) // CONSTANT NIBBLE + elsif value == -1 + pfillb($20) // CONSTANT MINUS_ONE + else + pfillb($2C) // CONSTANT WORD + pfillw(value) // Poke literal value into PFA + fin + fin + else + (@push)(value)#0 + fin fin - elsif not (@isnum)(inchars, inlen)#1 - _warmstart_ - puts("? No match\n") - elsif state & comp_flag - _pset_(@d_lit) - (@_pset_)()#0 // Poke literal value on stack into PFA fin until state & exit_flag end @@ -985,7 +1114,6 @@ puts("PLFORTH WIP\n") startheap = heapmark _estkl = ^(@syscall + 1) // Hack to fill in parameter stack locations _estkh = ^(@syscall + 3) -execwords = @execwords_nocheck // Faster, no checking execution _warmstart_ inptr = argNext(argFirst) if ^inptr; inptr++; _src_; fin