mirror of
https://github.com/dschmenk/PLASMA.git
synced 2024-09-29 16:55:22 +00:00
Add longjmp library to slean up PLASM
This commit is contained in:
David Schmenk
parent
5206d23a63
commit
3c1be6c92f
4
src/inc/longjmp.plh
Normal file
4
src/inc/longjmp.plh
Normal file
@ -0,0 +1,4 @@
|
||||
import longjmp
|
||||
const t_longjmp = $0140
|
||||
predef setjmp(env), longjmp(env, retval)
|
||||
end
|
||||
69
src/libsrc/longjmp.pla
Normal file
69
src/libsrc/longjmp.pla
Normal file
@ -0,0 +1,69 @@
|
||||
asm incs
|
||||
!SOURCE "vmsrc/plvmzp.inc"
|
||||
end
|
||||
//
|
||||
// Save environment (PLASMA ZP and stack) for below and return 0
|
||||
//
|
||||
export asm setjmp(env)
|
||||
LDA ESTKL,X
|
||||
STA SRC
|
||||
LDA ESTKH,X
|
||||
STA SRC+1
|
||||
STX ESP
|
||||
TSX
|
||||
STX TMPL
|
||||
LDX #ESTK
|
||||
LDY #$00
|
||||
- LDA $00,X
|
||||
STA (SRC),Y
|
||||
INY
|
||||
INX
|
||||
BNE -
|
||||
- LDA $0100,X
|
||||
STA (SRC),Y
|
||||
INY
|
||||
BNE +
|
||||
INC SRC+1
|
||||
+ INX
|
||||
BNE -
|
||||
TXA
|
||||
LDX ESP
|
||||
STA ESTKL,X
|
||||
STA ESTKH,X
|
||||
RTS
|
||||
end
|
||||
//
|
||||
// Restore environment saved above and return retval
|
||||
//
|
||||
export asm longjmp(env, retval)
|
||||
LDA ESTKL,X
|
||||
STA SRC
|
||||
LDA ESTKH,X
|
||||
STA SRC+1
|
||||
LDA ESTKL+1,X
|
||||
STA DST
|
||||
LDA ESTKH+1,X
|
||||
STA DST+1
|
||||
LDX #ESTK
|
||||
LDY #$00
|
||||
- LDA (DST),Y
|
||||
STA $00,X
|
||||
INY
|
||||
INX
|
||||
BNE -
|
||||
- LDA (DST),Y
|
||||
STA $0100,X
|
||||
INY
|
||||
BNE +
|
||||
INC DST+1
|
||||
+ INX
|
||||
BNE -
|
||||
LDX TMP
|
||||
TXS
|
||||
LDX ESP
|
||||
LDA SRC
|
||||
STA ESTKL,X
|
||||
LDA SRC+1
|
||||
STA ESTKH,X
|
||||
RTS
|
||||
end
|
||||
@ -53,30 +53,30 @@ def id_lookup(nameptr, len)
|
||||
if idptr
|
||||
return idptr
|
||||
fin
|
||||
return parse_err(@undecl_id)
|
||||
exit_err(@undecl_id)
|
||||
return 0
|
||||
end
|
||||
def idglobal_lookup(nameptr, len)
|
||||
return idmatch(nameptr, len, idglobal_tbl, globals)
|
||||
end
|
||||
def idlocal_add(namestr, len, type, size)
|
||||
if idmatch(namestr, len, @idlocal_tbl, locals); return parse_err(@dup_id); fin
|
||||
if idmatch(namestr, len, @idlocal_tbl, locals); return exit_err(@dup_id); fin
|
||||
lastlocal=>idval = framesize
|
||||
lastlocal->idtype = type | LOCAL_TYPE
|
||||
nametostr(namestr, len, lastlocal + idname)
|
||||
locals++
|
||||
lastlocal = lastlocal + idrecsz + len
|
||||
if lastlocal > idlocal_tbl + idlocal_tblsz
|
||||
prstr(@local_sym_overflw)
|
||||
exit
|
||||
exit_err(@local_sym_overflw)
|
||||
fin
|
||||
framesize = framesize + size
|
||||
if framesize > 255
|
||||
return parse_err(@local_overflw)
|
||||
return exit_err(@local_overflw)
|
||||
fin
|
||||
return TRUE
|
||||
end
|
||||
def iddata_add(namestr, len, type, size)
|
||||
if idmatch(namestr, len, idglobal_tbl, globals); return parse_err(@dup_id); fin
|
||||
if idmatch(namestr, len, idglobal_tbl, globals); return exit_err(@dup_id); fin
|
||||
lastglobal=>idval = datasize
|
||||
lastglobal->idtype = type
|
||||
nametostr(namestr, len, lastglobal + idname)
|
||||
@ -99,7 +99,7 @@ def iddata_size(type, varsize, initsize)#0
|
||||
fin
|
||||
end
|
||||
def idglobal_add(namestr, len, type, value)
|
||||
if idmatch(namestr, len, idglobal_tbl, globals); return parse_err(@dup_id); fin
|
||||
if idmatch(namestr, len, idglobal_tbl, globals); return exit_err(@dup_id); fin
|
||||
lastglobal=>idval = value
|
||||
lastglobal->idtype = type
|
||||
nametostr(namestr, len, lastglobal + idname)
|
||||
@ -150,7 +150,7 @@ end
|
||||
// Flags are:
|
||||
//
|
||||
def ctag_new
|
||||
if codetag >= ctag_max; return parse_err(@ctag_full); fin
|
||||
if codetag >= ctag_max; return exit_err(@ctag_full); fin
|
||||
codetag = codetag + 1
|
||||
ctag_tbl:[codetag] = 0 // Unresolved, nothing to update yet
|
||||
return codetag | IS_CTAG
|
||||
@ -159,7 +159,7 @@ def ctag_resolve(ctag)#0
|
||||
word updtptr, nextptr
|
||||
|
||||
ctag = ctag & MASK_CTAG // Better be a ctag!
|
||||
if ctag_tbl:[ctag] & IS_RESOLVED;parse_err(@dup_id); return; fin
|
||||
if ctag_tbl:[ctag] & IS_RESOLVED;exit_err(@dup_id); return; fin
|
||||
updtptr = ctag_tbl:[ctag] & MASK_CTAG
|
||||
while updtptr
|
||||
//
|
||||
@ -299,7 +299,7 @@ def emit_llw(offset)#0
|
||||
end
|
||||
def emit_lab(tag, offset)#0
|
||||
if tag & IS_CTAG and offset
|
||||
parse_err(@no_ctag_offst)
|
||||
exit_err(@no_ctag_offst)
|
||||
else
|
||||
emit_op($68)
|
||||
emit_addr(tag+offset)
|
||||
@ -307,7 +307,7 @@ def emit_lab(tag, offset)#0
|
||||
end
|
||||
def emit_law(tag, offset)#0
|
||||
if tag & IS_CTAG and offset
|
||||
parse_err(@no_ctag_offst)
|
||||
exit_err(@no_ctag_offst)
|
||||
else
|
||||
emit_op($6A)
|
||||
emit_addr(tag+offset)
|
||||
@ -337,7 +337,7 @@ def emit_dlw(offset)#0
|
||||
end
|
||||
def emit_sab(tag, offset)#0
|
||||
if tag & IS_CTAG and offset
|
||||
parse_err(@no_ctag_offst)
|
||||
exit_err(@no_ctag_offst)
|
||||
else
|
||||
emit_op($78)
|
||||
emit_addr(tag+offset)
|
||||
@ -345,7 +345,7 @@ def emit_sab(tag, offset)#0
|
||||
end
|
||||
def emit_saw(tag, offset)#0
|
||||
if tag & IS_CTAG and offset
|
||||
parse_err(@no_ctag_offst)
|
||||
exit_err(@no_ctag_offst)
|
||||
else
|
||||
emit_op($7A)
|
||||
emit_addr(tag+offset)
|
||||
@ -353,7 +353,7 @@ def emit_saw(tag, offset)#0
|
||||
end
|
||||
def emit_dab(tag, offset)#0
|
||||
if tag & IS_CTAG and offset
|
||||
parse_err(@no_ctag_offst)
|
||||
exit_err(@no_ctag_offst)
|
||||
else
|
||||
emit_op($7C)
|
||||
emit_addr(tag+offset)
|
||||
@ -361,7 +361,7 @@ def emit_dab(tag, offset)#0
|
||||
end
|
||||
def emit_daw(tag, offset)#0
|
||||
if tag & IS_CTAG and offset
|
||||
parse_err(@no_ctag_offst)
|
||||
exit_err(@no_ctag_offst)
|
||||
else
|
||||
emit_op($7E)
|
||||
emit_addr(tag+offset)
|
||||
@ -380,7 +380,7 @@ def emit_localaddr(offset)#0
|
||||
end
|
||||
def emit_globaladdr(tag, offset)#0
|
||||
if tag & IS_CTAG and offset
|
||||
parse_err(@no_ctag_offst)
|
||||
exit_err(@no_ctag_offst)
|
||||
else
|
||||
emit_op($26)
|
||||
emit_addr(tag+offset)
|
||||
|
||||
@ -124,9 +124,7 @@ def scan
|
||||
constval = ^scanptr
|
||||
wend
|
||||
fin
|
||||
if ^(scanptr + 1) <> '\''
|
||||
return parse_err(@bad_cnst)
|
||||
fin
|
||||
if ^(scanptr + 1) <> '\''; exit_err(@bad_cnst); fin
|
||||
scanptr = scanptr + 2
|
||||
break
|
||||
is '"'
|
||||
@ -157,7 +155,7 @@ def scan
|
||||
strconst++
|
||||
scanptr++
|
||||
loop
|
||||
if !^scanptr; return parse_err(@bad_cnst); fin
|
||||
if !^scanptr; exit_err(@bad_cnst); fin
|
||||
constval = @strconst
|
||||
scanptr++
|
||||
break
|
||||
@ -290,7 +288,7 @@ def nextln
|
||||
scanptr++
|
||||
scan
|
||||
else
|
||||
if token <> EOL_TKN or token <> EOF_TKN; return parse_err("Extraneous characters"); fin
|
||||
if token <> EOL_TKN or token <> EOF_TKN; exit_err("Extraneous characters"); fin
|
||||
scanptr = inbuff
|
||||
instr = fileio:read(refnum, inbuff, 127)
|
||||
if instr
|
||||
@ -298,13 +296,13 @@ def nextln
|
||||
lineno++
|
||||
if !(lineno & $0F); putc('.'); fin
|
||||
if scan == INCLUDE_TKN
|
||||
if incref; return parse_err("Nested INCLUDEs not allowed"); fin
|
||||
if scan <> STRING_TKN; return parse_err("Missing INCLUDE file"); fin
|
||||
if incref; exit_err("Nested INCLUDEs not allowed"); fin
|
||||
if scan <> STRING_TKN; exit_err("Missing INCLUDE file"); fin
|
||||
incfile = scanptr - constval
|
||||
memcpy(@incfile + 1, constval, incfile)
|
||||
sysincbuf = heapallocalign(1024, 256)
|
||||
incref = fileio:opensys(@incfile, sysincbuf)
|
||||
if not incref; return parse_err("Unable to open INCLUDE file"); fin
|
||||
if not incref; exit_err("Unable to open INCLUDE file"); fin
|
||||
fileio:newline(incref, $7F, $0D)
|
||||
refnum = incref
|
||||
parsefile = @incfile
|
||||
|
||||
@ -347,7 +347,7 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
|
||||
/*
|
||||
* Parse pre operators.
|
||||
*/
|
||||
while (scan())
|
||||
while (scan)
|
||||
{
|
||||
if (scantoken == ADD_TOKEN)
|
||||
{
|
||||
@ -364,7 +364,8 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
|
||||
{
|
||||
deref++;
|
||||
if (!type)
|
||||
type |= scantoken == BPTR_TOKEN ? BPTR_TYPE : WPTR_TYPE;
|
||||
//type |= scantoken == BPTR_TOKEN ? BPTR_TYPE : WPTR_TYPE;
|
||||
type = scantoken == BPTR_TOKEN ? BPTR_TYPE : WPTR_TYPE;
|
||||
else if (scantoken == BPTR_TOKEN)
|
||||
parse_error("Byte value used as pointer");
|
||||
}
|
||||
|
||||
@ -2,14 +2,14 @@
|
||||
// Alebraic op to stack op
|
||||
//
|
||||
def push_op(op, prec)#0
|
||||
if opsp == 16; parse_err("Op stack overflow"); return; fin
|
||||
if opsp == 16; exit_err("Op stack overflow"); fin
|
||||
opstack[opsp] = op
|
||||
precstack[opsp] = prec
|
||||
opsp++
|
||||
end
|
||||
def pop_op
|
||||
opsp--
|
||||
if opsp < 0; return parse_err("Op stack underflow"); fin
|
||||
if opsp < 0; exit_err("Op stack underflow"); fin
|
||||
return opstack[opsp]
|
||||
end
|
||||
def tos_op
|
||||
@ -25,7 +25,7 @@ def tos_op_prec(tos)
|
||||
return precstack[opsp]
|
||||
end
|
||||
def push_val(value, size, type)#0
|
||||
if valsp == 16; parse_err("Eval stack overflow"); return; fin
|
||||
if valsp == 16; exit_err("Eval stack overflow"); fin
|
||||
valstack[valsp] = value
|
||||
sizestack[valsp] = size
|
||||
typestack[valsp] = type
|
||||
@ -33,19 +33,19 @@ def push_val(value, size, type)#0
|
||||
end
|
||||
def pop_val#3
|
||||
valsp--
|
||||
if valsp < 0; return parse_err("Eval stack underflow"), 0, 0; fin
|
||||
if valsp < 0; exit_err("Eval stack underflow"); fin
|
||||
return valstack[valsp], sizestack[valsp], typestack[valsp]
|
||||
end
|
||||
//
|
||||
// Constant expression parsing
|
||||
//
|
||||
def calc_binaryop(op)
|
||||
def calc_binaryop(op)#0
|
||||
word val1, val2
|
||||
byte size1, size2, type1, type2
|
||||
|
||||
val2, size2, type2 = pop_val
|
||||
val1, size1, type1 = pop_val
|
||||
if type1 <> CONST_TYPE and type2 <> CONST_TYPE; return parse_err(@bad_cnst); fin
|
||||
if type1 <> CONST_TYPE and type2 <> CONST_TYPE; exit_err(@bad_cnst); fin
|
||||
when op
|
||||
is MUL_TKN
|
||||
val1 = val1 * val2
|
||||
@ -78,17 +78,16 @@ def calc_binaryop(op)
|
||||
val1 = val1 ^ val2
|
||||
break
|
||||
otherwise
|
||||
return FALSE
|
||||
exit_err(@bad_cnst)
|
||||
wend
|
||||
if size2 > size1; size1 = size2; fin
|
||||
push_val(val1, size1, type1)
|
||||
return TRUE
|
||||
end
|
||||
def parse_constterm // (valptr, sizeptr)
|
||||
def parse_constterm
|
||||
when scan
|
||||
is OPEN_PAREN_TKN
|
||||
parse_constexpr
|
||||
if token <> CLOSE_PAREN_TKN; return parse_err(@no_close_paren); fin
|
||||
if token <> CLOSE_PAREN_TKN; exit_err(@no_close_paren); fin
|
||||
return TRUE
|
||||
is ID_TKN
|
||||
is INT_TKN
|
||||
@ -126,7 +125,7 @@ def parse_constval
|
||||
size = tknlen - 1
|
||||
value = constval
|
||||
type = STR_TYPE
|
||||
if mod; return parse_err(@bad_op); fin
|
||||
if mod; exit_err(@bad_op); fin
|
||||
break
|
||||
is CHR_TKN
|
||||
size = 1
|
||||
@ -141,10 +140,9 @@ def parse_constval
|
||||
is ID_TKN
|
||||
size = 2
|
||||
idptr = id_lookup(tknptr, tknlen)
|
||||
if !idptr; return parse_err(@bad_cnst); fin
|
||||
type = idptr->idtype
|
||||
if type & ADDR_TYPE
|
||||
if mod <> 8; return parse_err(@bad_cnst); fin
|
||||
if mod <> 8; exit_err(@bad_cnst); fin
|
||||
type = CONSTADDR_TYPE
|
||||
fin
|
||||
value = idptr=>idval
|
||||
@ -164,7 +162,7 @@ def parse_constval
|
||||
push_val(value, size, type)
|
||||
return TRUE
|
||||
end
|
||||
def parse_constexpr#3 //(valptr, sizeptr)
|
||||
def parse_constexpr#3
|
||||
byte prevmatch, matchop, i
|
||||
word optos
|
||||
|
||||
@ -180,7 +178,7 @@ def parse_constexpr#3 //(valptr, sizeptr)
|
||||
if token == bops_tbl[i]
|
||||
matchop = 2
|
||||
if bops_prec[i] >= tos_op_prec(optos)
|
||||
if !calc_binaryop(pop_op); return parse_err(@bad_op); fin
|
||||
calc_binaryop(pop_op)
|
||||
fin
|
||||
push_op(token, bops_prec[i])
|
||||
break
|
||||
@ -189,9 +187,9 @@ def parse_constexpr#3 //(valptr, sizeptr)
|
||||
fin
|
||||
until matchop <> 2
|
||||
if matchop == 0 and prevmatch == 0; return 0; fin
|
||||
if matchop == 0 and prevmatch == 2; return parse_err(@missing_op); fin
|
||||
if matchop == 0 and prevmatch == 2; exit_err(@missing_op); fin
|
||||
while optos < opsp
|
||||
if !calc_binaryop(pop_op); return parse_err(@bad_op); fin
|
||||
calc_binaryop(pop_op)
|
||||
loop
|
||||
return pop_val
|
||||
end
|
||||
@ -205,7 +203,6 @@ def parse_const(valptr)
|
||||
break
|
||||
is ID_TKN
|
||||
idptr = id_lookup(tknptr, tknlen)
|
||||
if !idptr; return parse_err(@bad_cnst); fin
|
||||
if idptr->idtype & CONST_TYPE
|
||||
*valptr = idptr=>idval
|
||||
break
|
||||
@ -220,55 +217,20 @@ end
|
||||
//
|
||||
def parse_list#2
|
||||
{
|
||||
byte stackdepth, elemdepth
|
||||
word codeseq, elemseq;
|
||||
codeseq = NULL
|
||||
stackdepth = 0
|
||||
byte listdepth, stackdepth
|
||||
word listseq
|
||||
listseq = NULL
|
||||
listdepth = 0
|
||||
repeat
|
||||
elemseq, elemdepth = parse_expr(codeseq)
|
||||
if not elemseq; break; fin
|
||||
codeseq = elemseq
|
||||
stackdepth = stackdepth + elemdepth
|
||||
until scantoken <> COMMA_TOKEN
|
||||
return codeseq, stackdepth
|
||||
listseq, stackdepth = parse_expr(listseq)
|
||||
listdepth = listdepth + stackdepth
|
||||
until not listseq or token <> COMMA_TOKEN
|
||||
return listseq, listdepth
|
||||
}
|
||||
//
|
||||
// Flag token as post-op
|
||||
//
|
||||
def ispostop
|
||||
when scan
|
||||
is OPEN_PAREN_TKN
|
||||
is OPEN_BRACKET_TKN
|
||||
is DOT_TKN
|
||||
is COLON_TKN
|
||||
is PTRB_TKN
|
||||
is PTRW_TKN
|
||||
return TRUE
|
||||
wend
|
||||
return FALSE
|
||||
end
|
||||
//def parse_term(codeseq)
|
||||
// byte stackdepth
|
||||
// word codeseq
|
||||
//
|
||||
// stackdepth = 0
|
||||
// when scan
|
||||
// is OPEN_PAREN_TKN
|
||||
// codeseq, stackdepth = parse_expr(codeseq)
|
||||
// if not parse_expr; return FALSE; fin
|
||||
// if token <> CLOSE_PAREN_TKN; return parse_err(@no_close_paren); fin
|
||||
// is ID_TKN
|
||||
// is INT_TKN
|
||||
// is CHR_TKN
|
||||
// is STR_TKN
|
||||
// return TRUE
|
||||
// wend
|
||||
// return FALSE
|
||||
//end
|
||||
def parse_value(codeseq, rvalue)
|
||||
byte cfnparms, cfnvals, stackdepth, deref, type
|
||||
word optos, idptr, value
|
||||
word const_offset, uopseq, valseq, idxseq
|
||||
byte cfnparms, cfnvals, stackdepth, deref, type, operation
|
||||
word optos, idptr, value, const_offset
|
||||
word uopseq, valseq, idxseq
|
||||
|
||||
deref = rvalue
|
||||
optos = opsp
|
||||
@ -283,101 +245,86 @@ def parse_value(codeseq, rvalue)
|
||||
//
|
||||
// Parse pre-ops
|
||||
//
|
||||
while !parse_term
|
||||
when token
|
||||
operation = TRUE
|
||||
repeat
|
||||
when scan
|
||||
is NEG_TKN
|
||||
is COMP_TKN
|
||||
is LOGIC_NOT_TKN
|
||||
uopseq = gen_uop(uopseq, token);
|
||||
is ADD_TKN
|
||||
break
|
||||
if not rvalue; exit_err("Invalid op for LVALUE"); fin
|
||||
break
|
||||
is BPTR_TKN
|
||||
if deref
|
||||
push_op(token, 0)
|
||||
else
|
||||
deref++
|
||||
type = type | BPTR_TYPE
|
||||
fin
|
||||
deref++
|
||||
type = type | BPTR_TYPE
|
||||
break
|
||||
is WPTR_TKN
|
||||
if deref
|
||||
push_op(token, 0)
|
||||
else
|
||||
deref++
|
||||
type = type | WPTR_TYPE
|
||||
fin
|
||||
deref++
|
||||
type = type | WPTR_TYPE
|
||||
break
|
||||
is AT_TKN
|
||||
deref--
|
||||
break
|
||||
is SUB_TKN
|
||||
is COMP_TKN
|
||||
is LOGIC_NOT_TKN
|
||||
push_op(token, 0)
|
||||
if not deref; exit_err("Invalid ADDRESS-OF"); fin
|
||||
break
|
||||
otherwise
|
||||
return 0
|
||||
operation = FALSE
|
||||
wend
|
||||
loop
|
||||
until not operation
|
||||
//
|
||||
// Determine terminal type
|
||||
//
|
||||
when token
|
||||
is ID_TKN
|
||||
idptr = id_lookup(tknptr, tknlen)
|
||||
if !idptr; return NULL, 0; fin
|
||||
if !(idptr->idtype); return NULL, 0; fin
|
||||
type = type | idptr->idtype
|
||||
value = idptr=>idval
|
||||
if type & CONST_TYPE
|
||||
valseq = gen_const(NULL, value)
|
||||
else
|
||||
valseq = type & LOCAL_TYPE ?? gen_lcladr(NULL, value) :: gen_gbladr(NULL, value, type)
|
||||
fin
|
||||
if type & FUNC_TYPE
|
||||
cfnparms = idptr->funcparms
|
||||
cfnvals = idptr->funcvals
|
||||
fin
|
||||
break
|
||||
is INT_TKN
|
||||
is CHR_TKN
|
||||
value = constval
|
||||
type = type | CONST_TYPE
|
||||
break
|
||||
is ID_TKN
|
||||
idptr = id_lookup(tknptr, tknlen)
|
||||
if !idptr; return 0; fin
|
||||
if !(idptr->idtype); return 0; fin
|
||||
type = type | idptr->idtype
|
||||
value = idptr=>idval
|
||||
break
|
||||
is CLOSE_PAREN_TKN
|
||||
// type = type | WORD_TYPE
|
||||
emit_val = TRUE
|
||||
valseq = gen_const(NULL, value)
|
||||
break
|
||||
is STR_TKN
|
||||
//
|
||||
// Special case
|
||||
//
|
||||
emit_constr(constval, tknlen - 1)
|
||||
codeseq = gen_str(codeseq, constval)
|
||||
scan
|
||||
return WORD_TYPE
|
||||
return codeseq, stackdepth // Special case return
|
||||
break
|
||||
is OPEN_PAREN_TKN
|
||||
valseq, stackdepth = parse_expr(NULL)
|
||||
if scantoken <> CLOSE_PAREN_TOKEN; exit_err("Missing closing parenthesis"); fin
|
||||
break
|
||||
is DROP_TOKEN
|
||||
if rvalue; exit_err("DROP is LVALUE only"); fin
|
||||
codeseq = gen_drop(codeseq)
|
||||
scan
|
||||
return codeseq, 0 // Special case return
|
||||
is LAMBDA_TOKEN
|
||||
type |= CONST_TYPE
|
||||
value = parse_lambda
|
||||
valseq = gen_gbladr(NULL, value, FUNC_TYPE)
|
||||
break
|
||||
otherwise
|
||||
return 0
|
||||
return NULL, 0
|
||||
wend
|
||||
//
|
||||
// Constant optimizations
|
||||
//
|
||||
if type & CONST_TYPE
|
||||
cparams = TRUE
|
||||
while optos < opsp and cparams
|
||||
when tos_op
|
||||
is NEG_TKN
|
||||
pop_op
|
||||
value = -value
|
||||
break
|
||||
is ALT_COMP_TKN
|
||||
is COMP_TKN
|
||||
pop_op
|
||||
value = ~value
|
||||
break
|
||||
is LOGIC_NOT_TKN
|
||||
pop_op
|
||||
value = !value
|
||||
break
|
||||
otherwise
|
||||
cparams = FALSE
|
||||
wend
|
||||
loop
|
||||
fin
|
||||
//
|
||||
// Parse post-ops
|
||||
//
|
||||
ref_type = type & ~PTR_TYPE
|
||||
ref_offset = 0
|
||||
while ispostop
|
||||
when token
|
||||
operation = TRUE
|
||||
repeat
|
||||
when scan
|
||||
is OPEN_PAREN_TKN
|
||||
//
|
||||
// Function call
|
||||
@ -402,7 +349,7 @@ def parse_value(codeseq, rvalue)
|
||||
break
|
||||
fin
|
||||
loop
|
||||
if token <> CLOSE_PAREN_TKN; return parse_err(@no_close_paren); fin
|
||||
if token <> CLOSE_PAREN_TKN; exit_err(@no_close_paren); fin
|
||||
if ref_type & FUNC_CONST_TYPE
|
||||
emit_call(value)
|
||||
else
|
||||
@ -457,7 +404,7 @@ def parse_value(codeseq, rvalue)
|
||||
emit_indexword
|
||||
emit_lw
|
||||
loop
|
||||
if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin
|
||||
if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin
|
||||
if ref_type & (WPTR_TYPE | WORD_TYPE)
|
||||
emit_indexword
|
||||
ref_type = WPTR_TYPE
|
||||
@ -549,7 +496,7 @@ def parse_value(codeseq, rvalue)
|
||||
fin
|
||||
break
|
||||
wend
|
||||
loop
|
||||
until not operation
|
||||
if emit_val
|
||||
if ref_offset <> 0
|
||||
emit_const(ref_offset)
|
||||
@ -604,7 +551,7 @@ def parse_value(codeseq, rvalue)
|
||||
fin
|
||||
fin // emit_val
|
||||
while optos < opsp
|
||||
if !emit_unaryop(pop_op); return parse_err(@bad_op); fin
|
||||
emit_unaryop(pop_op)
|
||||
loop
|
||||
if type & PTR_TYPE
|
||||
ref_type = type
|
||||
@ -614,7 +561,7 @@ def parse_value(codeseq, rvalue)
|
||||
fin
|
||||
return ref_type
|
||||
end
|
||||
def parse_expr
|
||||
def parse_expr(codeseq)
|
||||
byte prevmatch, matchop, i
|
||||
word optos
|
||||
|
||||
@ -629,7 +576,7 @@ def parse_expr
|
||||
if token == bops_tbl[i]
|
||||
matchop = 2
|
||||
if bops_prec[i] >= tos_op_prec(optos)
|
||||
if !emit_binaryop(pop_op); return parse_err(@bad_op); fin
|
||||
emit_binaryop(pop_op)
|
||||
fin
|
||||
push_op(token, bops_prec[i])
|
||||
break
|
||||
@ -637,13 +584,13 @@ def parse_expr
|
||||
next
|
||||
fin
|
||||
until matchop <> 2
|
||||
if matchop == 0 and prevmatch == 2; return parse_err(@missing_op); fin
|
||||
if matchop == 0 and prevmatch == 2; exit_err(@missing_op); fin
|
||||
while optos < opsp
|
||||
if !emit_binaryop(pop_op); return parse_err(@bad_op); fin
|
||||
emit_binaryop(pop_op)
|
||||
loop
|
||||
return matchop or prevmatch
|
||||
end
|
||||
def parse_stmnt
|
||||
def parse_stmnt(codeseq)
|
||||
byte type, elem_type, elem_size, i
|
||||
word elem_offset, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend
|
||||
word tag_repeat, tag_for, tag_choice, tag_of, idptr, saveptr, addr, stepdir
|
||||
@ -683,7 +630,7 @@ def parse_stmnt
|
||||
ctag_resolve(tag_else)
|
||||
ctag_resolve(tag_endif)
|
||||
fin
|
||||
if token <> FIN_TKN; return parse_err(@no_fin); fin
|
||||
if token <> FIN_TKN; exit_err(@no_fin); fin
|
||||
break
|
||||
is WHILE_TKN
|
||||
tag_while = ctag_new
|
||||
@ -698,7 +645,7 @@ def parse_stmnt
|
||||
while parse_stmnt
|
||||
nextln
|
||||
loop
|
||||
if token <> LOOP_TKN; return parse_err(@no_loop); fin
|
||||
if token <> LOOP_TKN; exit_err(@no_loop); fin
|
||||
emit_branch(tag_while)
|
||||
ctag_resolve(tag_wend)
|
||||
break_tag = tag_prevbrk
|
||||
@ -715,7 +662,7 @@ def parse_stmnt
|
||||
while parse_stmnt
|
||||
nextln
|
||||
loop
|
||||
if token <> UNTIL_TKN; return parse_err(@no_until); fin
|
||||
if token <> UNTIL_TKN; exit_err(@no_until); fin
|
||||
ctag_resolve(cont_tag)
|
||||
cont_tag = tag_prevcnt
|
||||
if !parse_expr; return FALSE; fin
|
||||
@ -730,7 +677,7 @@ def parse_stmnt
|
||||
cont_tag = tag_for
|
||||
tag_prevbrk = break_tag
|
||||
break_tag = ctag_new
|
||||
if scan <> ID_TKN; return parse_err(@bad_stmnt); fin
|
||||
if scan <> ID_TKN; exit_err(@bad_stmnt); fin
|
||||
idptr = id_lookup(tknptr, tknlen)
|
||||
if idptr
|
||||
type = idptr->idtype
|
||||
@ -738,8 +685,8 @@ def parse_stmnt
|
||||
else
|
||||
return FALSE
|
||||
fin
|
||||
if scan <> SET_TKN; return parse_err(@bad_stmnt); fin
|
||||
if !parse_expr; return parse_err(@bad_stmnt); fin
|
||||
if scan <> SET_TKN; exit_err(@bad_stmnt); fin
|
||||
parse_expr
|
||||
ctag_resolve(tag_for)
|
||||
if type & LOCAL_TYPE
|
||||
if type & BYTE_TYPE
|
||||
@ -759,16 +706,16 @@ def parse_stmnt
|
||||
elsif token == DOWNTO_TKN
|
||||
stepdir = -1
|
||||
else
|
||||
return parse_err(@bad_stmnt)
|
||||
exit_err(@bad_stmnt)
|
||||
fin
|
||||
if !parse_expr; return parse_err(@bad_stmnt); fin
|
||||
parse_expr
|
||||
if stepdir > 0
|
||||
emit_brgt(break_tag)
|
||||
else
|
||||
emit_brlt(break_tag)
|
||||
fin
|
||||
if token == STEP_TKN
|
||||
if !parse_expr; return parse_err(@bad_stmnt); fin
|
||||
parse_expr
|
||||
if stepdir > 0
|
||||
emit_binaryop(ADD_TKN)
|
||||
else
|
||||
@ -784,7 +731,7 @@ def parse_stmnt
|
||||
while parse_stmnt
|
||||
nextln
|
||||
loop
|
||||
if token <> NEXT_TKN; return parse_err(@bad_stmnt); fin
|
||||
if token <> NEXT_TKN; exit_err(@bad_stmnt); fin
|
||||
emit_branch(tag_for)
|
||||
cont_tag = tag_prevcnt
|
||||
ctag_resolve(break_tag)
|
||||
@ -798,12 +745,12 @@ def parse_stmnt
|
||||
break_tag = ctag_new
|
||||
tag_choice = ctag_new
|
||||
tag_of = ctag_new
|
||||
if !parse_expr; return parse_err(@bad_stmnt); fin
|
||||
parse_expr
|
||||
nextln
|
||||
while token <> ENDCASE_TKN
|
||||
when token
|
||||
is OF_TKN
|
||||
if !parse_expr; return parse_err(@bad_stmnt); fin
|
||||
parse_expr
|
||||
emit_brne(tag_choice)
|
||||
ctag_resolve(tag_of)
|
||||
while parse_stmnt
|
||||
@ -823,13 +770,13 @@ def parse_stmnt
|
||||
while parse_stmnt
|
||||
nextln
|
||||
loop
|
||||
if token <> ENDCASE_TKN; return parse_err(@bad_stmnt); fin
|
||||
if token <> ENDCASE_TKN; exit_err(@bad_stmnt); fin
|
||||
break
|
||||
is EOL_TKN
|
||||
nextln
|
||||
break
|
||||
otherwise
|
||||
return parse_err(@bad_stmnt)
|
||||
exit_err(@bad_stmnt)
|
||||
wend
|
||||
loop
|
||||
if (tag_of)
|
||||
@ -844,14 +791,14 @@ def parse_stmnt
|
||||
if break_tag
|
||||
emit_branch(break_tag)
|
||||
else
|
||||
return parse_err(@bad_stmnt)
|
||||
exit_err(@bad_stmnt)
|
||||
fin
|
||||
break
|
||||
is CONT_TKN
|
||||
if cont_tag
|
||||
emit_branch(cont_tag)
|
||||
else
|
||||
return parse_err(@bad_stmnt)
|
||||
exit_err(@bad_stmnt)
|
||||
fin
|
||||
break
|
||||
is RETURN_TKN
|
||||
@ -905,7 +852,7 @@ def parse_stmnt
|
||||
fin
|
||||
fin
|
||||
if token == SET_TKN
|
||||
if !parse_expr; return parse_err(@bad_expr); fin
|
||||
parse_expr
|
||||
if type & LOCAL_TYPE
|
||||
if elem_type & BYTE_TYPE
|
||||
emit_slb(addr + elem_offset)
|
||||
@ -957,7 +904,7 @@ def parse_stmnt
|
||||
type = parse_value(0)
|
||||
if type
|
||||
if token == SET_TKN
|
||||
if !parse_expr; return parse_err(@bad_expr); fin
|
||||
parse_expr
|
||||
if type & XBYTE_TYPE
|
||||
emit_sb
|
||||
else
|
||||
@ -983,10 +930,10 @@ def parse_stmnt
|
||||
emit_drop
|
||||
fin
|
||||
else
|
||||
return parse_err(@bad_syntax)
|
||||
exit_err(@bad_syntax)
|
||||
fin
|
||||
wend
|
||||
if scan <> EOL_TKN; return parse_err(@bad_syntax); fin
|
||||
//if scan <> EOL_TKN; exit_err(@bad_syntax); fin
|
||||
return TRUE
|
||||
end
|
||||
def parse_var(type)
|
||||
@ -998,7 +945,7 @@ def parse_var(type)
|
||||
size = 1
|
||||
if scan == OPEN_BRACKET_TKN
|
||||
size, constsize, consttype = parse_constexpr
|
||||
if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin
|
||||
if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin
|
||||
scan
|
||||
fin
|
||||
if token == ID_TKN
|
||||
@ -1006,7 +953,7 @@ def parse_var(type)
|
||||
idlen = tknlen
|
||||
if scan == OPEN_BRACKET_TKN
|
||||
size, constsize, consttype = parse_constexpr
|
||||
if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin
|
||||
if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin
|
||||
scan
|
||||
fin
|
||||
fin
|
||||
@ -1014,16 +961,14 @@ def parse_var(type)
|
||||
size = size * 2
|
||||
fin
|
||||
if token == SET_TKN
|
||||
if infunc; return parse_err(@no_local_init); fin
|
||||
if infunc; exit_err(@no_local_init); fin
|
||||
if idlen
|
||||
iddata_add(idptr, idlen, type, 0)
|
||||
fin
|
||||
constval, constsize, consttype = parse_constexpr
|
||||
if not consttype; return parse_err(@bad_decl); fin
|
||||
arraysize = emit_data(type, consttype, constval, constsize)
|
||||
while token == COMMA_TKN
|
||||
constval, constsize, consttype = parse_constexpr
|
||||
if not consttype; return parse_err(@bad_decl); fin
|
||||
arraysize = arraysize + emit_data(type, consttype, constval, constsize)
|
||||
loop
|
||||
iddata_size(PTR_TYPE, size, arraysize)
|
||||
@ -1062,7 +1007,7 @@ def parse_struc
|
||||
fin
|
||||
if scan == OPEN_BRACKET_TKN
|
||||
size, constsize, consttype = parse_constexpr
|
||||
if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin
|
||||
if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin
|
||||
scan
|
||||
fin
|
||||
repeat
|
||||
@ -1072,7 +1017,7 @@ def parse_struc
|
||||
idlen = tknlen
|
||||
if scan == OPEN_BRACKET_TKN
|
||||
size, constsize, consttype = parse_constexpr
|
||||
if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin
|
||||
if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin
|
||||
scan
|
||||
fin
|
||||
fin
|
||||
@ -1098,16 +1043,15 @@ def parse_vars
|
||||
//cout('V')
|
||||
when token
|
||||
is CONST_TKN
|
||||
if scan <> ID_TKN; return parse_err(@bad_cnst); fin
|
||||
if scan <> ID_TKN; exit_err(@bad_cnst); fin
|
||||
idptr = tknptr
|
||||
idlen = tknlen
|
||||
if scan <> SET_TKN; return parse_err(@bad_cnst); fin
|
||||
if scan <> SET_TKN; exit_err(@bad_cnst); fin
|
||||
value, size, type = parse_constexpr
|
||||
if not type; return parse_err(@bad_cnst); fin
|
||||
idconst_add(idptr, idlen, value)
|
||||
break
|
||||
is STRUC_TKN
|
||||
if !parse_struc; parse_err(@bad_struc); fin
|
||||
parse_struc
|
||||
break
|
||||
is BYTE_TKN
|
||||
is WORD_TKN
|
||||
@ -1127,7 +1071,7 @@ def parse_vars
|
||||
if scan == ID_TKN
|
||||
idfunc_add(tknptr, tknlen, ctag_new)
|
||||
else
|
||||
return parse_err(@bad_decl)
|
||||
exit_err(@bad_decl)
|
||||
fin
|
||||
until scan <> COMMA_TKN
|
||||
break
|
||||
@ -1142,7 +1086,7 @@ def parse_defs
|
||||
|
||||
if token == DEF_TKN
|
||||
//cout('D')
|
||||
if scan <> ID_TKN; return parse_err(@bad_decl); fin
|
||||
if scan <> ID_TKN; exit_err(@bad_decl); fin
|
||||
cfnparms = 0
|
||||
infunc = TRUE
|
||||
idptr = idglobal_lookup(tknptr, tknlen)
|
||||
@ -1163,7 +1107,7 @@ def parse_defs
|
||||
scan
|
||||
fin
|
||||
until token <> COMMA_TKN
|
||||
if token <> CLOSE_PAREN_TKN; return parse_err(@bad_decl); fin
|
||||
if token <> CLOSE_PAREN_TKN; exit_err(@bad_decl); fin
|
||||
scan
|
||||
fin
|
||||
while parse_vars
|
||||
@ -1175,7 +1119,7 @@ def parse_defs
|
||||
nextln
|
||||
loop
|
||||
infunc = FALSE
|
||||
if token <> END_TKN; return parse_err(@bad_syntax); fin
|
||||
if token <> END_TKN; exit_err(@bad_syntax); fin
|
||||
if prevstmnt <> RETURN_TKN
|
||||
emit_const(0)
|
||||
emit_leave
|
||||
@ -1220,7 +1164,6 @@ def parse_module
|
||||
//
|
||||
// Write REL file
|
||||
//
|
||||
|
||||
return not parserr
|
||||
fin
|
||||
else
|
||||
|
||||
@ -1,14 +1,6 @@
|
||||
//
|
||||
// Data and text buffer constants
|
||||
//
|
||||
const machid = $BF98
|
||||
const iobuffer = $0800
|
||||
const databuff = $0C00
|
||||
const codebuff = $A900
|
||||
const codebuffsz = $1000
|
||||
//
|
||||
// Compiler variables
|
||||
//
|
||||
include "inc/cmdsys.plh"
|
||||
include "inc/fileio.plh"
|
||||
include "inc/longjmp.plh"
|
||||
//
|
||||
// Tokens
|
||||
//
|
||||
@ -204,41 +196,50 @@ byte[16] sizestack
|
||||
byte[16] typestack
|
||||
word valsp = 0
|
||||
//
|
||||
// Generated code buffers
|
||||
//
|
||||
const databuff = $0C00
|
||||
const codebuff = $A900
|
||||
const codebuffsz = $1000
|
||||
//
|
||||
// Symbol table variables
|
||||
//
|
||||
struc t_opseq
|
||||
byte code
|
||||
word val
|
||||
word tag
|
||||
word offsz
|
||||
byte type
|
||||
word nextop
|
||||
byte opcode
|
||||
word opval
|
||||
word optag
|
||||
word opoffsz
|
||||
byte optype
|
||||
word opnext
|
||||
end
|
||||
const OPSEQNUM = 200
|
||||
struc t_id
|
||||
word idval
|
||||
byte idtype
|
||||
byte idname
|
||||
byte funcparms
|
||||
byte funcvals
|
||||
end
|
||||
const idglobal_tblsz = 2048
|
||||
const idlocal_tblsz = 512
|
||||
const idglobal_tbl = $1600
|
||||
const idlocal_tbl = $1E00
|
||||
const ctag_max = 1024
|
||||
const ctag_tbl = $800
|
||||
const idval = 0
|
||||
const idtype = 2
|
||||
const idname = 3
|
||||
const idrecsz = 4
|
||||
word globals = 0
|
||||
word datasize = 0
|
||||
word lastglobal
|
||||
byte locals = 0
|
||||
word framesize = 0
|
||||
word lastlocal
|
||||
byte lastop = $FF
|
||||
const IS_RESOLVED = $8000
|
||||
const IS_RELATIVE = $8000
|
||||
const IS_CTAG = $8000
|
||||
const MASK_CTAG = $7FFF
|
||||
word codetag = -1
|
||||
word codeptr, entrypoint = 0
|
||||
word codeptr, entrypoint
|
||||
word modsysflags = 0
|
||||
byte lastop = $FF
|
||||
//
|
||||
// Scanner variables
|
||||
//
|
||||
@ -295,7 +296,11 @@ byte prevstmnt = 0
|
||||
word retfunc_tag = 0
|
||||
word break_tag = 0
|
||||
word cont_tag = 0
|
||||
predef parse_constexpr#3, parse_expr, parse_lambda
|
||||
predef parse_constexpr#3, parse_expr(codeseq), parse_lambda
|
||||
//
|
||||
// Long jump environment
|
||||
//
|
||||
word exit
|
||||
|
||||
//=====================================
|
||||
//
|
||||
@ -306,19 +311,17 @@ predef parse_constexpr#3, parse_expr, parse_lambda
|
||||
//
|
||||
// Error handler
|
||||
//
|
||||
def parse_err(errstr)
|
||||
if !parserr
|
||||
parserr = TRUE
|
||||
parserrln = lineno - 1
|
||||
parserrpos = tknptr - inbuff
|
||||
puts(parsefile); putc('['); puti(lineno); putc(']'); putc(':'); puts(errstr); putln
|
||||
puts(instr)
|
||||
for i = parseerrpos-1 downto 0
|
||||
putc(' ')
|
||||
next
|
||||
puts("^\n")
|
||||
fin
|
||||
return ERR_TKN
|
||||
def exit_err(errstr)#0
|
||||
byte i
|
||||
|
||||
puts(parsefile); putc('['); puti(lineno); putc(']'); putc(':'); puts(errstr); putln
|
||||
puts(instr)
|
||||
for i = tknptr - inbuff - 1 downto 0
|
||||
putc(' ')
|
||||
next
|
||||
puts("^\n")
|
||||
fileio:close(0) // Close all open files
|
||||
longjump(exit, TRUE)
|
||||
end
|
||||
//
|
||||
// Include code to reduce size of this file
|
||||
@ -332,11 +335,12 @@ include "toolsrc/parse.pla"
|
||||
arg = argNext(argFirst)
|
||||
if arg
|
||||
strcpy(@srcfile, arg)
|
||||
if parsemodule
|
||||
exit = heapalloc(t_longjmp)
|
||||
if not setjmp(exit)
|
||||
parsemodule
|
||||
puts("Bytes compiled: "); puti(codeptr - codebuff); putln
|
||||
fin
|
||||
else
|
||||
puts("Usage: +PLASM [srcfile]\n")
|
||||
fin
|
||||
|
||||
done
|
||||
|
||||
Loading…
Reference in New Issue
Block a user