6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-01-03 19:31:10 +00:00
Code Issues Projects Releases Wiki Activity

Fixes to compilers case statement to allow addresses. Update names to Forth words

Browse Source
This commit is contained in:
David Schmenk 2024-01-26 17:19:37 -08:00
parent c2773d208c
commit b93b4d7c75
18 changed files with 69 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
images/apple/PLASMA-2.1-4TH.po
View File

Binary file not shown.

BIN
images/apple/PLASMA-2.1-BLD.po
View File

Binary file not shown.

BIN
images/apple/PLASMA-2.1-DEMOS.po
View File

Binary file not shown.

BIN
images/apple/PLASMA-2.1-FPSOS.po
View File

Binary file not shown.

BIN
images/apple/PLASMA-2.1-INET.po
View File

Binary file not shown.

BIN
images/apple/PLASMA-2.1-INST.po
View File

Binary file not shown.

BIN
images/apple/PLASMA-2.1-SYS.po
View File

Binary file not shown.

BIN
images/apple/PLASMA-2.1.po
View File

Binary file not shown.

2
src/samplesrc/rod.pla
View File

@ -24,7 +24,7 @@ def rod#0
conio:grplot(i, fmk)
conio:grplot(fmk, i)
if conio:keypressed()
getc
conio:getkey()
return
fin
next

2
src/scripts/bounce.4th
View File

@ -35,7 +35,7 @@ SRC" GRLIB.4TH"
0 GRCLEAR
BEGIN
MOVEBALL
?TERMINAL
KEY?
UNTIL
KEY DROP
-1 GRMODE DROP

2
src/scripts/hrbounce.4th
View File

@ -39,7 +39,7 @@ SRC" HGRLIB.4TH"
0 HGRSHOW DROP
BEGIN
MOVEBALL
?TERMINAL
KEY?
UNTIL
KEY DROP
-1 HGRMODE DROP

2
src/scripts/rod.4th
View File

@ -26,7 +26,7 @@ SRC" CONIO.4TH"
FMI @ K @ PLOT
J FMK @ PLOT
FMK @ J PLOT
?TERMINAL IF ( if keypressed )
KEY? IF ( if keypressed )
KEY DROP
UNLOOP ( clean up DO-OKIE )
UNLOOP

11
src/toolsrc/codegen.c
View File

@ -871,7 +871,7 @@ void emit_select(int tag)
fprintf(outputfile, "\t%s\t$52\t\t\t; SEL\n", DB);
fprintf(outputfile, "\t%s\t_B%03d-*\n", DW, tag);
}
void emit_caseblock(int casecnt, int *caseof, int *casetag)
void emit_caseblock(int casecnt, int *caseof, int *casetyp, int *casetag)
{
int i;
@ -881,7 +881,14 @@ void emit_caseblock(int casecnt, int *caseof, int *casetag)
fprintf(outputfile, "\t%s\t$%02X\t\t\t; CASEBLOCK\n", DB, casecnt & 0xFF);
for (i = 0; i < casecnt; i++)
{
fprintf(outputfile, "\t%s\t$%04X\n", DW, caseof[i] & 0xFFFF);
if (casetyp[i] & (FUNC_TYPE | ADDR_TYPE))
{
int fixup = fixup_new(caseof[i], casetyp[i], FIXUP_WORD);
char *taglbl = tag_string(caseof[i], casetyp[i]);
fprintf(outputfile, "_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, casetyp[i] & EXTERN_TYPE ? "0" : taglbl, 0);
}
else
fprintf(outputfile, "\t%s\t$%04X\n", DW, caseof[i] & 0xFFFF);
fprintf(outputfile, "\t%s\t_B%03d-*\n", DW, casetag[i]);
}
}

2
src/toolsrc/codegen.h
View File

@ -151,7 +151,7 @@ void emit_indexword(void);
int emit_unaryop(t_token op);
int emit_op(t_token op);
void emit_select(int tag);
void emit_caseblock(int casecnt, int *caseof, int *casetag);
void emit_caseblock(int casecnt, int *caseof, int *casetype, int *casetag);
void emit_brand(int tag);
void emit_bror(int tag);
void emit_brtru(int tag);

8
src/toolsrc/codegen.pla
View File

@ -198,14 +198,18 @@ def emit_select(tag)#0
emit_byte($52)
emit_reladdr(tag)
end
def emit_caseblock(cnt, oflist, taglist)#0
def emit_caseblock(cnt, oflist, typlist, taglist)#0
byte i
if not cnt or cnt > 256; exit_err(ERR_OVER|ERR_STATE); fin
emit_pending_seq
emit_byte(cnt)
for i = 0 to cnt-1
emit_word(oflist=>[i])
if typlist=>[i] & CONSTADDR_TYPE
emit_addr(oflist=>[i], 0)
else
emit_word(oflist=>[i])
fin
emit_reladdr(taglist=>[i])
next
end

12
src/toolsrc/parse.c
View File

@ -850,7 +850,7 @@ int parse_stmnt(void)
{
int tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend, tag_repeat, tag_for, tag_choice, tag_of;
int type, addr, step, cfnvals, constsize, casecnt, i;
int *caseval, *casetag;
int *caseval, *casetyp, *casetag;
long constval;
char *idptr;
t_opseq *seq, *fromseq, *toseq;
@ -1052,6 +1052,7 @@ int parse_stmnt(void)
break_tag = tag_new(BRANCH_TYPE);
tag_choice = tag_new(BRANCH_TYPE);
caseval = malloc(sizeof(int)*256);
casetyp = malloc(sizeof(int)*256);
casetag = malloc(sizeof(int)*256);
casecnt = 0;
if (!(seq = parse_expr(NULL, &cfnvals)))
@ -1070,7 +1071,7 @@ int parse_stmnt(void)
{
tag_of = tag_new(BRANCH_TYPE);
constval = 0;
parse_constexpr(&constval, &constsize);
type = parse_constexpr(&constval, &constsize);
i = casecnt;
while ((i > 0) && (caseval[i-1] > constval))
{
@ -1078,12 +1079,14 @@ int parse_stmnt(void)
// Move larger case consts up
//
caseval[i] = caseval[i-1];
casetyp[i] = casetyp[i-1];
casetag[i] = casetag[i-1];
i--;
}
if ((i < casecnt) && (caseval[i] == constval))
parse_error("Duplicate CASE");
caseval[i] = constval;
casetyp[i] = type;
casetag[i] = tag_of;
casecnt++;
emit_codetag(tag_of);
@ -1099,7 +1102,7 @@ int parse_stmnt(void)
else
tag_of = 0;
emit_codetag(tag_choice);
emit_caseblock(casecnt, caseval, casetag);
emit_caseblock(casecnt, caseval, casetyp, casetag);
tag_choice = 0;
scan();
if (tag_of)
@ -1117,9 +1120,10 @@ int parse_stmnt(void)
{
emit_brnch(break_tag);
emit_codetag(tag_choice);
emit_caseblock(casecnt, caseval, casetag);
emit_caseblock(casecnt, caseval, casetyp, casetag);
}
free(caseval);
free(casetyp);
free(casetag);
emit_codetag(break_tag);
break_tag = tag_prevbrk;

15
src/toolsrc/parse.pla
View File

@ -614,7 +614,7 @@ def parse_stmnt
byte type, elem_type, elem_size, cfnvals
word seq, fromseq, toseq, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend
word tag_repeat, tag_for, tag_choice, tag_of, idptr, addr, stepdir
word caseconst, casecnt, caseval, casetag, i
word caseconst, casetype, casecnt, caseval, casetyp, casetag, i
if token <> END_TKN and token <> DONE_TKN and token <> OF_TKN and token <> DEFAULT_TKN
prevstmnt = token
@ -803,6 +803,7 @@ def parse_stmnt
break_tag = new_tag(RELATIVE_FIXUP)
tag_choice = new_tag(RELATIVE_FIXUP)
caseval = heapalloc(CASENUM)
casetyp = heapalloc(CASENUM)
casetag = heapalloc(CASENUM)
casecnt = 0
seq, cfnvals = parse_expr(NULL)
@ -818,19 +819,21 @@ def parse_stmnt
when token
is OF_TKN
if casecnt == CASENUM; exit_err(ERR_OVER|ERR_TABLE); fin
caseconst, drop, drop = parse_constexpr
tag_of = new_tag(RELATIVE_FIXUP)
i = casecnt
caseconst, drop, casetype = parse_constexpr
tag_of = new_tag(RELATIVE_FIXUP)
i = casecnt
while i > 0 and caseval=>[i-1] > caseconst
//
// Move larger case consts up
//
caseval=>[i] = caseval=>[i-1]
casetyp=>[i] = casetyp=>[i-1]
casetag=>[i] = casetag=>[i-1]
i--
loop
if i < casecnt and caseval=>[i] == caseconst; exit_err(ERR_DUP|ERR_STATE); fin
caseval=>[i] = caseconst
casetyp=>[i] = casetype
casetag=>[i] = tag_of
casecnt++
emit_tag(tag_of)
@ -845,7 +848,7 @@ def parse_stmnt
emit_branch(tag_of)
fin
emit_tag(tag_choice)
emit_caseblock(casecnt, caseval, casetag)
emit_caseblock(casecnt, caseval, casetype, casetag)
tag_choice = 0
if tag_of
emit_tag(tag_of)
@ -866,7 +869,7 @@ def parse_stmnt
if tag_choice
emit_branch(break_tag)
emit_tag(tag_choice)
emit_caseblock(casecnt, caseval, casetag)
emit_caseblock(casecnt, caseval, casetyp, casetag)
fin
heaprelease(caseval)
emit_tag(break_tag)

51
src/toolsrc/plforth.pla
View File

@ -111,7 +111,7 @@ predef _componly_#0, _interponly_#0, _immediate_#0, _exit_#0, _pad_#1, _trailing
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 _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, _keypressed_#1, _key_#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, _accept_(a,b)#1, _type_(a,b)#0
predef _vlist_#0, _tron_#0, _troff_#0, _stepon_#0, _stepoff_#0
@ -525,14 +525,14 @@ word = 0, 0, @_lit_
char d_literal = "LITERAL"
byte = imm_flag | componly_flag
word = @d_tick, 0, @_compliteral_
// ?TERMINAL
char d_terminal = "?TERMINAL"
// KEY?
char d_keypressed = "KEY?"
byte = 0
word = @d_literal, 0, @_terminal_
word = @d_literal, 0, @_keypressed_
// KEY
char d_key = "KEY"
byte = 0
word = @d_terminal, 0, @_key_
word = @d_keypressed, 0, @_key_
// ACCEPT
char d_accept = "ACCEPT"
byte = 0
@ -542,7 +542,7 @@ char d_word = "WORD"
byte = 0
word = @d_accept, 0, @_word_
// _isnum_
char d__isnum_ = "?NUM"
char d__isnum_ = "NUM?"
byte = 0
word = @d_word, 0, @_isnum_
// -TRAILING
@ -1586,7 +1586,7 @@ def _accept_(a,b)#1
inptr = saveinptr
return len
end
def _terminal_#1
def _keypressed_#1
return conio:keypressed() > 127
end
def _key_#1
@ -1776,35 +1776,48 @@ def _show_#0
else // @d_dodoes
pfa = *_pfa_(dentry)
fin
putc('$'); puth(pfa); putc(' ')
w = *pfa
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)
when w
is @d_slit
putc('"')
puts(pfa)
putc('"')
pfa = pfa + ^pfa - 1
break
is @d_lit
puti(*pfa)
break
is @d_branch
is @d_0branch
is @d_doloop
puts(w); puts(" $"); puth(*pfa)
break
otherwise
puts(w)
wend
else
puts(w)
fin
if ^_ffa_(w) & showcr_flag; putln; fin
pfa = pfa + 2
if ^_ffa_(w) & showcr_flag
putln; putc('$'); puth(pfa)
fin
putc(' ')
w = *pfa
if !w
pfa = pfa + 2
w = *pfa
if !*w; puts(" EXIT\n"); fin
if w; puts("EXIT\n"); putc('$'); puth(pfa); putc(' '); fin // Early exit
fin
if conio:keypressed()
conio:getkey(); conio:getkey()
fin
loop
puts(" EXIT\n")
puts("EXIT\n")
fin
end
def _showstack_#0