diff --git a/src/inc/longjmp.plh b/src/inc/longjmp.plh new file mode 100644 index 0000000..330ff91 --- /dev/null +++ b/src/inc/longjmp.plh @@ -0,0 +1,4 @@ +import longjmp + const t_longjmp = $0140 + predef setjmp(env), longjmp(env, retval) +end diff --git a/src/libsrc/longjmp.pla b/src/libsrc/longjmp.pla new file mode 100644 index 0000000..462e394 --- /dev/null +++ b/src/libsrc/longjmp.pla @@ -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 diff --git a/src/toolsrc/codegen.pla b/src/toolsrc/codegen.pla index 9796af7..9bdf739 100644 --- a/src/toolsrc/codegen.pla +++ b/src/toolsrc/codegen.pla @@ -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) diff --git a/src/toolsrc/lex.pla b/src/toolsrc/lex.pla index 03bf073..776bb7c 100644 --- a/src/toolsrc/lex.pla +++ b/src/toolsrc/lex.pla @@ -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 diff --git a/src/toolsrc/parse.c b/src/toolsrc/parse.c index d1986c3..b24e0a6 100755 --- a/src/toolsrc/parse.c +++ b/src/toolsrc/parse.c @@ -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"); } diff --git a/src/toolsrc/parse.pla b/src/toolsrc/parse.pla index 59e4dcf..f24ea57 100644 --- a/src/toolsrc/parse.pla +++ b/src/toolsrc/parse.pla @@ -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 diff --git a/src/toolsrc/plasm.pla b/src/toolsrc/plasm.pla index 62ed83a..30faae9 100644 --- a/src/toolsrc/plasm.pla +++ b/src/toolsrc/plasm.pla @@ -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