diff --git a/src/toolsrc/codegen.pla b/src/toolsrc/codegen.pla index 9bdf739..1a7e5fe 100644 --- a/src/toolsrc/codegen.pla +++ b/src/toolsrc/codegen.pla @@ -623,42 +623,15 @@ def emit_pending_seq#0 if not pending_seq; return; fin lcl_pending = pending_seq pending_seq = NULL - //if outflags & OPTIMIZE - // while crunch_seq(@lcl_pending, 0); loop - // while crunch_seq(@lcl_pending, 1); loop - //fin + if outflags & OPTIMIZE + while crunch_seq(@lcl_pending, 0); loop + if outflags & OPTIMIZE2 + while crunch_seq(@lcl_pending, 1); loop + fin + fin while lcl_pending op = lcl_pending when op->code - is NEG_CODE - is COMP_CODE - is LOGIC_NOT_CODE - is INC_CODE - is DEC_CODE - is BPTR_CODE - is WPTR_CODE - emit_unaryop(op->code) - break - is MUL_CODE - is DIV_CODE - is MOD_CODE - is ADD_CODE - is SUB_CODE - is SHL_CODE - is SHR_CODE - is AND_CODE - is OR_CODE - is EOR_CODE - is EQ_CODE - is NE_CODE - is GE_CODE - is LT_CODE - is GT_CODE - is LE_CODE - is LOGIC_OR_CODE - is LOGIC_AND_CODE - emit_op(op->code) - break is CONST_CODE emit_const(op=>val) break @@ -755,6 +728,63 @@ def emit_pending_seq#0 is CODETAG_CODE printf("_B%03d%c\n", op->tag, LBL); break; + is NEG_CODE + is COMP_CODE + is LOGIC_NOT_CODE + is INC_CODE + is DEC_CODE + is BPTR_CODE + is WPTR_CODE + emit_unaryop(op->code) + break + is MUL_CODE + is DIV_CODE + is MOD_CODE + is ADD_CODE + is SUB_CODE + is SHL_CODE + is SHR_CODE + is AND_CODE + is OR_CODE + is EOR_CODE + is EQ_CODE + is NE_CODE + is GE_CODE + is LT_CODE + is GT_CODE + is LE_CODE + is LOGIC_OR_CODE + is LOGIC_AND_CODE + emit_op(op->code) + break + is MUL_CODE + is DIV_CODE + is MOD_CODE + is ADD_CODE + is SUB_CODE + is SHL_CODE + is SHR_CODE + is AND_CODE + is OR_CODE + is EOR_CODE + is EQ_CODE + is NE_CODE + is GE_CODE + is LT_CODE + is GT_CODE + is LE_CODE + is LOGIC_OR_CODE + is LOGIC_AND_CODE + emit_op(op->code) + break + is NEG_CODE + is COMP_CODE + is LOGIC_NOT_CODE + is INC_CODE + is DEC_CODE + is BPTR_CODE + is WPTR_CODE + emit_unaryop(op->code) is NOP_CODE break otherwise @@ -774,10 +804,10 @@ end def emit_seq(seq)#0 word op byte string - string = 0 + string = FALSE op = seq while op - if op->code == STR_CODE; string = 1; fin + if op->code == STR_CODE; string = TRUE; break; fin op = op=>nextop loop pending_seq = cat_seq(pending_seq, seq) @@ -788,6 +818,6 @@ def emit_seq(seq)#0 // // We must also force output if the sequence includes a CS opcode, as the // associated 'constant' is only temporarily valid. - if !(outflags & OPTIMIZE) or (outflags & NO_COMBINE) or string + if !(outflags & (OPTIMIZE|OPTIMIZE2)) or (outflags & NO_COMBINE) or string emit_pending_seq end diff --git a/src/toolsrc/parse.c b/src/toolsrc/parse.c index 34663f3..c148e2e 100755 --- a/src/toolsrc/parse.c +++ b/src/toolsrc/parse.c @@ -505,12 +505,8 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth) cfnparms = 0; cfnvals = 1; type &= ~FUNC_TYPE; } - //while ((idxseq = parse_expr(NULL, stackdepth))) while ((valseq = parse_expr(valseq, stackdepth)) && scantoken == COMMA_TOKEN) { -// valseq = cat_seq(valseq, idxseq); -// if (scantoken != COMMA_TOKEN) -// break; valseq = gen_idxw(valseq); valseq = gen_lw(valseq); } @@ -794,8 +790,13 @@ int parse_stmnt(void) switch (scantoken) { case IF_TOKEN: - if (!(seq = parse_expr(NULL, NULL))) + if (!(seq = parse_expr(NULL, &cfnvals))) parse_error("Bad expression"); + if (cfnvals > 1) + { + parse_warn("Expression value overflow"); + while (cfnvals-- > 1) seq = gen_drop(seq); + } tag_else = tag_new(BRANCH_TYPE); tag_endif = tag_new(BRANCH_TYPE); seq = gen_brfls(seq, tag_else); @@ -807,8 +808,13 @@ int parse_stmnt(void) break; emit_brnch(tag_endif); emit_codetag(tag_else); - if (!(seq = parse_expr(NULL, NULL))) + if (!(seq = parse_expr(NULL, &cfnvals))) parse_error("Bad expression"); + if (cfnvals > 1) + { + parse_warn("Expression value overflow"); + while (cfnvals-- > 1) seq = gen_drop(seq); + } tag_else = tag_new(BRANCH_TYPE); seq = gen_brfls(seq, tag_else); emit_seq(seq); @@ -837,11 +843,16 @@ int parse_stmnt(void) tag_prevbrk = break_tag; break_tag = tag_wend; emit_codetag(tag_while); - if (!(seq = parse_expr(NULL, NULL))) + if (!(seq = parse_expr(NULL, &cfnvals))) parse_error("Bad expression"); + if (cfnvals > 1) + { + parse_warn("Expression value overflow"); + while (cfnvals-- > 1) seq = gen_drop(seq); + } seq = gen_brfls(seq, tag_wend); emit_seq(seq); - while (parse_stmnt()) next_line(); + while (parse_stmnt()) next_line(); if (scantoken != LOOP_TOKEN) parse_error("Missing WHILE/END"); emit_brnch(tag_while); @@ -862,8 +873,13 @@ int parse_stmnt(void) parse_error("Missing REPEAT/UNTIL"); emit_codetag(cont_tag); cont_tag = tag_prevcnt; - if (!(seq = parse_expr(NULL, NULL))) + if (!(seq = parse_expr(NULL, &cfnvals))) parse_error("Bad expression"); + if (cfnvals > 1) + { + parse_warn("Expression value overflow"); + while (cfnvals-- > 1) seq = gen_drop(seq); + } seq = gen_brfls(seq, tag_repeat); emit_seq(seq); emit_codetag(break_tag); @@ -882,8 +898,13 @@ int parse_stmnt(void) addr = id_tag(tokenstr, tokenlen); if (scan() != SET_TOKEN) parse_error("Missing FOR ="); - if (!emit_seq(parse_expr(NULL, NULL))) + if (!emit_seq(parse_expr(NULL, &cfnvals))) parse_error("Bad FOR expression"); + if (cfnvals > 1) + { + parse_warn("Expression value overflow"); + while (cfnvals-- > 1) seq = gen_drop(seq); + } emit_codetag(tag_for); if (type & LOCAL_TYPE) type & BYTE_TYPE ? emit_dlb(addr) : emit_dlw(addr); @@ -895,13 +916,23 @@ int parse_stmnt(void) step = -1; else parse_error("Missing FOR TO"); - if (!emit_seq(parse_expr(NULL, NULL))) + if (!emit_seq(parse_expr(NULL, &cfnvals))) parse_error("Bad FOR TO expression"); + if (cfnvals > 1) + { + parse_warn("Expression value overflow"); + while (cfnvals-- > 1) seq = gen_drop(seq); + } step > 0 ? emit_brgt(break_tag) : emit_brlt(break_tag); if (scantoken == STEP_TOKEN) { - if (!emit_seq(parse_expr(NULL, NULL))) + if (!emit_seq(parse_expr(NULL, &cfnvals))) parse_error("Bad FOR STEP expression"); + if (cfnvals > 1) + { + parse_warn("Expression value overflow"); + while (cfnvals-- > 1) seq = gen_drop(seq); + } emit_op(step > 0 ? ADD_TOKEN : SUB_TOKEN); } else @@ -922,15 +953,25 @@ int parse_stmnt(void) break_tag = tag_new(BRANCH_TYPE); tag_choice = tag_new(BRANCH_TYPE); tag_of = tag_new(BRANCH_TYPE); - if (!emit_seq(parse_expr(NULL, NULL))) + if (!emit_seq(parse_expr(NULL, &cfnvals))) parse_error("Bad CASE expression"); + if (cfnvals > 1) + { + parse_warn("Expression value overflow"); + while (cfnvals-- > 1) seq = gen_drop(seq); + } next_line(); while (scantoken != ENDCASE_TOKEN) { if (scantoken == OF_TOKEN) { - if (!emit_seq(parse_expr(NULL, NULL))) + if (!emit_seq(parse_expr(NULL, &cfnvals))) parse_error("Bad CASE OF expression"); + if (cfnvals > 1) + { + parse_warn("Expression value overflow"); + while (cfnvals-- > 1) seq = gen_drop(seq); + } emit_brne(tag_choice); emit_codetag(tag_of); while (parse_stmnt()) next_line(); @@ -961,18 +1002,18 @@ int parse_stmnt(void) break_tag = tag_prevbrk; stack_loop--; break; - case CONTINUE_TOKEN: - if (cont_tag) - emit_brnch(cont_tag); - else - parse_error("CONTINUE without loop"); - break; case BREAK_TOKEN: if (break_tag) emit_brnch(break_tag); else parse_error("BREAK without loop"); break; + case CONTINUE_TOKEN: + if (cont_tag) + emit_brnch(cont_tag); + else + parse_error("CONTINUE without loop"); + break; case RETURN_TOKEN: if (infunc) { @@ -993,13 +1034,17 @@ int parse_stmnt(void) } else { - if (!emit_seq(parse_expr(NULL, NULL))) + if (!emit_seq(parse_expr(NULL, &cfnvals))) emit_const(0); + else if (cfnvals > 1) + { + parse_warn("Expression value overflow"); + while (cfnvals-- > 1) seq = gen_drop(seq); + } emit_ret(); } break; case EOL_TOKEN: - //case COMMENT_TOKEN: return (1); case ELSE_TOKEN: case ELSEIF_TOKEN: @@ -1027,8 +1072,7 @@ int parse_stmnt(void) { emit_seq(rseq); emit_unaryop(scantoken); - tokenstr = idptr; - scan_rewind(tokenstr); + scan_rewind(idptr); emit_seq(parse_value(NULL, LVALUE, NULL)); } else if (scantoken != SET_TOKEN) @@ -1051,22 +1095,14 @@ int parse_stmnt(void) } return (scan() == EOL_TOKEN); } -int parse_var(int type) +int parse_var(int type, long basesize) { char *idstr; long constval; - int consttype, constsize, arraysize, idlen = 0; long size = 1; + int consttype, constsize, arraysize, idlen = 0; - if (scan() == OPEN_BRACKET_TOKEN) - { - size = 0; - parse_constexpr(&size, &constsize); - if (scantoken != CLOSE_BRACKET_TOKEN) - parse_error("Missing closing bracket"); - scan(); - } - if (scantoken == ID_TOKEN) + if (scan() == ID_TOKEN) { idstr = tokenstr; idlen = tokenlen; @@ -1079,8 +1115,7 @@ int parse_var(int type) scan(); } } - if (type & WORD_TYPE) - size *= 2; + size *= basesize; if (scantoken == SET_TOKEN) { if (type & (EXTERN_TYPE | LOCAL_TYPE)) @@ -1138,7 +1173,8 @@ int parse_struc(void) parse_error("Missing closing bracket"); scan(); } - do { + do + { idlen = 0; if (scantoken == ID_TOKEN) { @@ -1163,9 +1199,8 @@ int parse_struc(void) if (struclen) idconst_add(strucid, struclen, offset); if (scantoken != END_TOKEN) - return (0); + parse_error("Missing STRUC/END"); scan(); - return (1); } int parse_vars(int type) { @@ -1178,7 +1213,7 @@ int parse_vars(int type) { case SYSFLAGS_TOKEN: if (type & (EXTERN_TYPE | LOCAL_TYPE)) - parse_error("sysflags must be global"); + parse_error("SYSFLAGS must be global"); if (!parse_constexpr(&value, &size)) parse_error("Bad constant"); emit_sysflags(value); @@ -1195,8 +1230,7 @@ int parse_vars(int type) idconst_add(idstr, idlen, value); break; case STRUC_TOKEN: - if (!parse_struc()) - parse_error("Bad structure definition"); + parse_struc(); break; case EXPORT_TOKEN: if (type & (EXTERN_TYPE | LOCAL_TYPE)) @@ -1217,86 +1251,63 @@ int parse_vars(int type) */ case BYTE_TOKEN: case WORD_TOKEN: - type |= (scantoken == BYTE_TOKEN) ? BYTE_TYPE : WORD_TYPE; - if (!parse_var(type)) - return (0); - while (scantoken == COMMA_TOKEN) + type |= (scantoken == BYTE_TOKEN) ? BYTE_TYPE : WORD_TYPE; + cfnvals = 1; // Just co-opt a long variable for this case + if (scan() == OPEN_BRACKET_TOKEN) { - if (!parse_var(type)) - return (0); + // + // Get base size for variables + // + cfnvals = 0; + parse_constexpr(&cfnvals, &size); + if (scantoken != CLOSE_BRACKET_TOKEN) + parse_error("Missing closing bracket"); } + else + scan_rewind(tokenstr); + if (type & WORD_TYPE) + cfnvals *= 2; + do parse_var(type, cfnvals); while (scantoken == COMMA_TOKEN); break; case PREDEF_TOKEN: /* * Pre definition. */ - if (scan() == ID_TOKEN) + do { - type |= PREDEF_TYPE; - idstr = tokenstr; - idlen = tokenlen; - cfnparms = 0; - cfnvals = 1; // Default to one return value for compatibility - if (scan() == OPEN_PAREN_TOKEN) + if (scan() == ID_TOKEN) { - do + type = (type & ~FUNC_PARMVALS) | PREDEF_TYPE; + idstr = tokenstr; + idlen = tokenlen; + cfnparms = 0; + cfnvals = 1; // Default to one return value for compatibility + if (scan() == OPEN_PAREN_TOKEN) { - if (scan() == ID_TOKEN) + do { - cfnparms++; - scan(); - } - } while (scantoken == COMMA_TOKEN); - if (scantoken != CLOSE_PAREN_TOKEN) - parse_error("Bad function parameter list"); - scan(); - } - if (scantoken == POUND_TOKEN) - { - if (!parse_const(&cfnvals)) - parse_error("Invalid def return value count"); - scan(); - } - type |= funcparms_type(cfnparms) | funcvals_type(cfnvals); - idfunc_add(idstr, idlen, type, tag_new(type)); - while (scantoken == COMMA_TOKEN) - { - if (scan() == ID_TOKEN) - { - idstr = tokenstr; - idlen = tokenlen; - type &= ~FUNC_PARMVALS; - cfnparms = 0; - cfnvals = 1; // Default to one return value for compatibility - if (scan() == OPEN_PAREN_TOKEN) - { - do + if (scan() == ID_TOKEN) { - if (scan() == ID_TOKEN) - { - cfnparms++; - scan(); - } - } while (scantoken == COMMA_TOKEN); - if (scantoken != CLOSE_PAREN_TOKEN) - parse_error("Bad function parameter list"); - scan(); - } - if (scantoken == POUND_TOKEN) - { - if (!parse_const(&cfnvals)) - parse_error("Invalid def return value count"); - scan(); - } - type |= funcparms_type(cfnparms) | funcvals_type(cfnvals); - idfunc_add(idstr, idlen, type, tag_new(type)); + cfnparms++; + scan(); + } + } while (scantoken == COMMA_TOKEN); + if (scantoken != CLOSE_PAREN_TOKEN) + parse_error("Bad function parameter list"); + scan(); } - else - parse_error("Bad function pre-declaration"); + if (scantoken == POUND_TOKEN) + { + if (!parse_const(&cfnvals)) + parse_error("Invalid def return value count"); + scan(); + } + type |= funcparms_type(cfnparms) | funcvals_type(cfnvals); + idfunc_add(idstr, idlen, type, tag_new(type)); } - } - else - parse_error("Bad function pre-declaration"); + else + parse_error("Bad function pre-declaration"); + } while (scantoken == COMMA_TOKEN); case EOL_TOKEN: break; default: @@ -1315,7 +1326,7 @@ int parse_mods(void) while (parse_vars(EXTERN_TYPE)) next_line(); if (scantoken != END_TOKEN) parse_error("Missing END"); - return (scan() == EOL_TOKEN); + scan(); } if (scantoken == EOL_TOKEN) return (1); @@ -1326,7 +1337,6 @@ int parse_lambda(void) { int func_tag; int cfnparms; - char *expr; if (!infunc) parse_error("Lambda functions only allowed inside definitions"); @@ -1351,7 +1361,6 @@ int parse_lambda(void) } else parse_error("Missing parameter list in lambda function"); - expr = scanpos; if (scan_lookahead() == OPEN_PAREN_TOKEN) { /* diff --git a/src/toolsrc/parse.pla b/src/toolsrc/parse.pla index f24ea57..b8c1219 100644 --- a/src/toolsrc/parse.pla +++ b/src/toolsrc/parse.pla @@ -227,7 +227,7 @@ def parse_list#2 until not listseq or token <> COMMA_TOKEN return listseq, listdepth } -def parse_value(codeseq, rvalue) +def parse_value(codeseq, rvalue)#2 byte cfnparms, cfnvals, stackdepth, deref, type, operation word optos, idptr, value, const_offset word uopseq, valseq, idxseq @@ -293,8 +293,8 @@ def parse_value(codeseq, rvalue) break is INT_TKN is CHR_TKN - value = constval - type = type | CONST_TYPE + value = constval + type = type | CONST_TYPE valseq = gen_const(NULL, value) break is STR_TKN @@ -312,11 +312,14 @@ def parse_value(codeseq, rvalue) scan return codeseq, 0 // Special case return is LAMBDA_TOKEN - type |= CONST_TYPE + if not rvalue; return codeseq, 0; fin // Lambdas can't be LVALUES + type = type | CONST_TYPE value = parse_lambda valseq = gen_gbladr(NULL, value, FUNC_TYPE) break otherwise + if uopseq; release_seq(uopseq); fin + if codeseq; release_seq(codeseq); fin return NULL, 0 wend // @@ -327,90 +330,56 @@ def parse_value(codeseq, rvalue) when scan is OPEN_PAREN_TKN // - // Function call + // Function call - parameters generate before call address // - if emit_val - if ref_offset <> 0 - emit_const(ref_offset) - emit_op($02) - ref_offset = 0 - fin - if ref_type & BPTR_TYPE; emit_lb - elsif ref_type & WPTR_TYPE; emit_lw - fin - if lookahead <> CLOSE_PAREN_TKN - emit_push - fin + idxseq, value = parse_list(NULL) + valseq = cat_seq(idxseq, valseq) + if token <> CLOSE_PAREN_TKN; exit_err("Missing function closing parenthesis"); fin + if type & FUNC_TYPE + if cfnparms <> value; exit_err("Parameter count mismatch"); fin + else // Can't check parm count on function pointers + cfnparms = value fin - cparams = 0 - while parse_expr - cparams = cparams + 1 - if token <> COMMA_TKN - break - fin - loop - if token <> CLOSE_PAREN_TKN; exit_err(@no_close_paren); fin - if ref_type & FUNC_CONST_TYPE - emit_call(value) + if scan == POUND_TKN // Set function pointer return vals count - can't do this to regular function call + if type & FUNC_TYPE; exit_err("Overriding function return count"); fin + if not parse_const(@cfnvals); exit_err("Invalid def return value count"); fin else - if !emit_val - if ref_type & CONST_TYPE - emit_const(value) - elsif ref_type & VAR_TYPE - if type & LOCAL_TYPE - emit_llw(value + ref_offset) - else - emit_law(value, ref_offset) - fin - ref_offset = 0 - fin - else - if cparams - emit_pull - fin - fin - emit_ical + scan_rewind(tokenstr) fin - emit_val = TRUE - ref_type = 0 + if type & (VAR_TYPE | PTR_TYPE) // !(type & (FUNC_TYPE | CONST_TYPE))) + valseq = gen_lw(valseq) + if deref; deref--; fin + fin + valseq = gen_icall(valseq) + stackdepth = stackdepth + cfnvals + cfnparms - value - 1 + cfnparms = 0 + cfnvals = 1 + type = type & ~(FUNC_TYPE | VAR_TYPE) break is OPEN_BRACKET_TKN // // Array of arrays // - if !emit_val - if type & CONST_TYPE - emit_const(value) - elsif type & ADDR_TYPE - if type & LOCAL_TYPE - emit_localaddr(value + ref_offset) - else - emit_globaladdr(value, ref_offset) - fin - ref_offset = 0 - fin - emit_val = TRUE - else - if ref_offset <> 0 - emit_const(ref_offset) - emit_op($02) - ref_offset = 0 - fin + if type & FUNC_TYPE // Function call dereference + valseq = gen_icall(valseq) + stackdepth = stackdepth + cfnvals + cfnparms - 1 + cfnparms = 0 + cfnvals = 1 + type = type & ~FUNC_TYPE fin - while parse_expr - if token <> COMMA_TKN - break - fin - emit_indexword - emit_lw - loop - if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin - if ref_type & (WPTR_TYPE | WORD_TYPE) - emit_indexword - ref_type = WPTR_TYPE + repeat + valseq, drop = parse_expr(valseq) + if token <> COMMA_TKN; break; fin + valseq = gen_idxw(valseq); + valseq = gen_lw(valseq); + until FALSE + if token <> CLOSE_BRACKET_TOKEN; exit_err("Missing closing bracket"); fin + if type & (WPTR_TYPE | WORD_TYPE) + valseq = gen_idxw(valseq) + type = (type & PTR_TYPE) | WORD_TYPE else - emit_indexbyte - ref_type = BPTR_TYPE + valseq = gen_idxb(valseq) + type = (type & PTR_TYPE) | BYTE_TYPE fin break is PTRB_TKN @@ -418,47 +387,22 @@ def parse_value(codeseq, rvalue) // // Structure member pointer // - if !emit_val - if (type & CONST_TYPE) - emit_const(value) - elsif type & ADDR_TYPE - if type & LOCAL_TYPE - if ref_type & BYTE_TYPE - emit_llb(value + ref_offset) - else - emit_llw(value + ref_offset) - fin - else - if ref_type & BYTE_TYPE - emit_lab(value, ref_offset) - else - emit_law(value, ref_offset) - fin - fin - fin - emit_val = 1; - else - if ref_offset <> 0 - emit_const(ref_offset) - emit_op($02) - ref_offset = 0 - fin - if ref_type & BPTR_TYPE; emit_lb - elsif ref_type & WPTR_TYPE; emit_lw; fin + if type & FUNC_TYPE // Function call dereference + valseq = gen_icall(valseq) + stackdepth = stackdepth + cfnvals + cfnparms - 1 + cfnparms = 0 + cfnvals = 1 + type = type & ~FUNC_TYPE + elsif type & (VAR_TYPE | PTR_TYPE) + valseq = gen_lw(valseq) // Pointer dereference fin - if token == PTRB_TKN - ref_type = BPTR_TYPE - else - ref_type = WPTR_TYPE - fin - ref_offset = 0 - if !parse_const(@ref_offset) - rewind(tknptr) - fin - if ref_offset <> 0 - emit_const(ref_offset) - emit_op($02) - ref_offset = 0 + type = token == PTRB_TKN ?? BPTR_TYPE :: WPTR_TYPE + if not parse_const(@const_offset) + if token == EOL_TKN or token == CLOSE_PAREN_TKN; exit_err("Syntax"); fin + scan_rewind(tokenstr) // Setting type override for following operations + elsif const_offset <> 0 + valseq = gen_const(valseq, const_offset) // Structure member pointer + valseq = gen_op(valseq, ADD_TOKEN) fin break is DOT_TKN @@ -466,117 +410,97 @@ def parse_value(codeseq, rvalue) // // Structure member offset // - if ref_type & (VAR_TYPE | CONST_TYPE) - if token == DOT_TKN - ref_type = BYTE_TYPE - else - ref_type = WORD_TYPE - fin - else - if token == DOT_TKN - ref_type = BPTR_TYPE - else - ref_type = WPTR_TYPE - fin + if type & FUNC_TYPE // Function call dereference + valseq = gen_icall(valseq) + stackdepth = stackdepth + cfnvals + cfnparms - 1 + cfnparms = 0 + cfnvals = 1 + type = type & ~FUNC_TYPE fin - if parse_const(@const_offset) - ref_offset = ref_offset + const_offset + if type & (VAR_TYPE | CONST_TYPE) + type = token == DOT_TOKEN ?? BYTE_TYPE :: WORD_TYPE else - rewind(tknptr) + type = token == DOT_TOKEN ?? BPTR_TYPE : :WPTR_TYPE fin - if !emit_val - if type & CONST_TYPE - value = value + ref_offset - ref_offset = 0 - elsif type & FUNC_TYPE - emit_globaladdr(value, ref_offset) - ref_offset = 0 - emit_val = TRUE - fin + if not parse_const(@const_offset) + if token == EOL_TOKEN or token == CLOSE_PAREN_TOKEN; exit_err("Syntax"); fin + scan_rewind(tokenstr) // Setting type override for following operations + elsif const_offset <> 0 + valseq = gen_const(valseq, const_offset) // Structure member offset + valseq = gen_op(valseq, ADD_TKN) fin break + otherwise + operation = FALSE wend until not operation - if emit_val - if ref_offset <> 0 - emit_const(ref_offset) - emit_op($02) - ref_offset = 0 + // + //Resolve outstanding dereference pointer loads + // + while deref > rvalue + deref-- + if type & FUNC_TYPE + valseq = gen_icall(valseq) + stackdepth = stackdepth + cfnvals + cfnparms - 1 + cfnparms = 0 + cfnvals = 1 + type = type & ~FUNC_TYPE; + elsif type & VAR_TYPE + valseq = gen_lw(valseq) fin - if deref - if ref_type & BPTR_TYPE - emit_lb - elsif ref_type & WPTR_TYPE - emit_lw - fin - fin - else // emit_val - if deref - if ref_type & CONST_TYPE - emit_const(value) - if ref_type & VAR_TYPE - if ref_type & BYTE_TYPE - emit_lb() - else - emit_lw() - fin - fin - elsif ref_type & FUNC_TYPE - emit_call(value) - elsif ref_type & VAR_TYPE - if type & LOCAL_TYPE - if ref_type & BYTE_TYPE - emit_llb(value + ref_offset) - else - emit_llw(value + ref_offset) - fin - else - if ref_type & BYTE_TYPE - emit_lab(value, ref_offset) - else - emit_law(value, ref_offset) - fin - fin - fin - else - if type & CONST_TYPE - emit_const(value) - elsif type & ADDR_TYPE - if type & LOCAL_TYPE - emit_localaddr(value + ref_offset) - else - emit_globaladdr(value, ref_offset) - fin - fin - fin - fin // emit_val - while optos < opsp - emit_unaryop(pop_op) loop - if type & PTR_TYPE - ref_type = type + if deref + if type & FUNC_TYPE + valseq = gen_icall(valseq) + stackdepth = stackdepth + cfnvals + cfnparms - 1 + type = type & ~FUNC_TYPE + elsif type & (BYTE_TYPE | BPTR_TYPE) + valseq = gen_lb(valseq) + elsif type & (WORD_TYPE | WPTR_TYPE) + valseq = gen_lw(valseq) + fin fin - if !ref_type - ref_type = WORD_TYPE + // + //Output pre-operations + // + valseq = cat_seq(valseq, uopseq) + // + //Wrap up LVALUE store + // + if not rvalue + stackdepth-- + if type & (BYTE_TYPE | BPTR_TYPE) + valseq = gen_sb(valseq) + elsif type & (WORD_TYPE | WPTR_TYPE) + valseq = gen_sw(valseq) + else + release_seq(valseq) + return NULL, 0 // Function or const cannot be LVALUE, must be RVALUE + fin fin - return ref_type + return cat_seq(codeseq, valseq), stackdepth end -def parse_expr(codeseq) - byte prevmatch, matchop, i +def parse_expr(codeseq)#2 + byte stackdepth, matchdepth, stkdepth1, prevmatch, matchop, i word optos + word tag_else, tag_endtri - matchop = 0 - optos = opsp + stackdepth = 0 + matchop = 0 + optos = opsp repeat prevmatch = matchop matchop = 0 - if parse_value(1) + codeseq, matchdepth = parse_value(codeseq, RVALUE) + if matchdepth + stackdepth = stackdepth + matchdepth matchop = 1 for i = 0 to bops_tblsz if token == bops_tbl[i] matchop = 2 if bops_prec[i] >= tos_op_prec(optos) - emit_binaryop(pop_op) + codeseq = gen_op(codeseq, pop_op) + stackdepth-- fin push_op(token, bops_prec[i]) break @@ -586,25 +510,92 @@ def parse_expr(codeseq) until matchop <> 2 if matchop == 0 and prevmatch == 2; exit_err(@missing_op); fin while optos < opsp - emit_binaryop(pop_op) + codeseq = gen_op(codeseq, pop_op) + stackdepth-- loop - return matchop or prevmatch + // + //Look for ternary operator + // + if token == TERNARY_TOKEN + if stackdepth <> 1; exit_err("Ternary op must evaluate to single value"); fin + tag_else = tag_new(BRANCH_TYPE) + tag_endtri = tag_new(BRANCH_TYPE) + codeseq = gen_brfls(codeseq, tag_else) + codeseq, stkdepth1 = parse_expr(codeseq) + if token <> TRIELSE_TOKEN; exit_err("Missing '::' in ternary op"); fin + codeseq = gen_brnch(codeseq, tag_endtri) + codeseq = gen_codetag(codeseq, tag_else) + codeseq, stackdepth = parse_expr(codeseq) + if stkdepth1 <> stackdepth; exit_err("Inconsistent value counts in ternary op"); fin + codeseq = gen_codetag(codeseq, tag_endtri) + fin + return codeseq, stackdepth end -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 +def parse_set(codeseq) + word setptr, rseq, setseq[16] + byte lparms, rparms, i, lambda_set + + lparms = 0 + rparms = 0 + lambda_set = lambda_cnt + setptr = tknptr + memset(@setseq, 0, 16) + repeat + setseq[lparms], drop = parse_value(NULL, LVALUE) + if not setseq[lparms]; break; fin + lparms++ + until token <> COMMA_TKN + if not lparms or token <> SET_TKN + // + // Not a set list - free everything up + // + tknptr = setptr + scan_rewind(tknptr) + while lparms + lparms-- + release_seq(setseq[lparms]) + loop + while lambda_cnt > lambda_set + lambda_cnt-- + lambda_num-- + release_seq(lambda_seq[lambda_cnt]) + loop + return NULL + fin + rseq, rparms = parse_list(NULL) + if lparms > rparms; exit_err("Set value list underflow"); fin + if lparms <> rparms and rparms - lparms <> 1 + codeseq = gen_pushexp(codeseq) + fin + codeseq = cat_seq(codeseq, rseq) + for i = lparms - 1 downto 0 + codeseq = cat_seq(codeseq, setseq[i]) + next + if lparms <> rparms + codeseq = rparms - lparms == 1 ?? gen_drop(codeseq) :: gen_pullexp(codeseq) + fin + return codeseq +end +def parse_stmnt + byte type, elem_type, elem_size, i, cfnvals + word seq, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend + word tag_repeat, tag_for, tag_choice, tag_of, idptr, addr, stepdir if token <> END_TKN and token <> DONE_TKN and token <> OF_TKN and token <> DEFAULT_TKN prevstmnt = token fin when token is IF_TKN - if !parse_expr; return 0; fin + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(@bad_expr); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1; cfnvals--; seq = gen_drop(seq); loop + fin tag_else = ctag_new tag_endif = ctag_new - emit_brfls(tag_else) - scan + seq = gen_brfls(seq, tag_else) + emit_seq(seq) repeat while parse_stmnt nextln @@ -613,24 +604,30 @@ def parse_stmnt(codeseq) break fin emit_branch(tag_endif) - ctag_resolve(tag_else) - if !parse_expr; return FALSE; fin + emit_ctag(tag_else) + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(@bad_expr); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1; cfnvals--; seq = gen_drop(seq); loop + fin tag_else = ctag_new - emit_brfls(tag_else) + seq = gen_brfls(seq, tag_else) + emit_seq(seq) until FALSE if token == ELSE_TKN emit_branch(tag_endif) - ctag_resolve(tag_else) + emit_ctag_(tag_else) scan while parse_stmnt nextln loop - ctag_resolve(tag_endif) + emit_ctag(tag_endif) else - ctag_resolve(tag_else) - ctag_resolve(tag_endif) + emit_ctag(tag_else) + emit_ctag(tag_endif) fin - if token <> FIN_TKN; exit_err(@no_fin); fin + if token <> FIN_TKN; exit_err("Missing IF/FIN"); fin break is WHILE_TKN tag_while = ctag_new @@ -639,15 +636,21 @@ def parse_stmnt(codeseq) cont_tag = tag_while tag_prevbrk = break_tag break_tag = tag_wend - ctag_resolve(tag_while) - if !parse_expr; return FALSE; fin - emit_brfls(tag_wend) + emit_ctag(tag_while) + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(@bad_expr); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + fin + seq = gen_brfls(seq, tag_wend) + emit_seq(seq) while parse_stmnt nextln loop - if token <> LOOP_TKN; exit_err(@no_loop); fin + if token <> LOOP_TKN; exit_err("Missing WHILE/LOOP"); fin emit_branch(tag_while) - ctag_resolve(tag_wend) + emit_ctag(tag_wend) break_tag = tag_prevbrk cont_tag = tag_prevcnt break @@ -657,102 +660,115 @@ def parse_stmnt(codeseq) break_tag = ctag_new tag_prevcnt = cont_tag cont_tag = ctag_new - ctag_resolve(tag_repeat) + emit_ctag(tag_repeat) scan while parse_stmnt nextln loop - if token <> UNTIL_TKN; exit_err(@no_until); fin - ctag_resolve(cont_tag) + if token <> UNTIL_TKN; exit_err("Mising REPEAT/UNTIL"); fin + emit_ctag(cont_tag) cont_tag = tag_prevcnt - if !parse_expr; return FALSE; fin - emit_brfls(tag_repeat) - ctag_resolve(break_tag) + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(@bad_expr); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1; cfnvals--; seq = gen_drop(seq); loop + fin + seq = gen_brfls(seq, tag_repeat) + emit_seq(seq) + emit_ctag(break_tag) break_tag = tag_prevbrk break is FOR_TKN - stack_loop = stack_loop + 1 + stack_loop++ tag_for = ctag_new tag_prevcnt = cont_tag cont_tag = tag_for tag_prevbrk = break_tag break_tag = ctag_new - if scan <> ID_TKN; exit_err(@bad_stmnt); fin + if scan <> ID_TKN; exit_err("Missing FOR variable"); fin idptr = id_lookup(tknptr, tknlen) if idptr type = idptr->idtype addr = idptr=>idval else - return FALSE + exit_err("Bad FOR variable") fin - if scan <> SET_TKN; exit_err(@bad_stmnt); fin - parse_expr - ctag_resolve(tag_for) + if scan <> SET_TKN; exit_err("Missing FOR ="); fin + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(@bad_expr); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + fin + emit_ctag(tag_for) if type & LOCAL_TYPE - if type & BYTE_TYPE - emit_dlb(addr) - else - emit_dlw(addr) - fin + type & BYTE_TYPE ?? emit_dlb(addr) :: emit_dlw(addr) else - if type & BYTE_TYPE - emit_dab(addr, 0) - else - emit_daw(addr, 0) - fin + type & BYTE_TYPE ?? emit_dab(addr, 0) :: emit_daw(addr, 0) fin if token == TO_TKN stepdir = 1 elsif token == DOWNTO_TKN stepdir = -1 else - exit_err(@bad_stmnt) + exit_err("Missing FOR TO") fin - parse_expr - if stepdir > 0 - emit_brgt(break_tag) - else - emit_brlt(break_tag) + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err("Bad FOR TO expression"); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + fin + emit_seq(seq) + stepdir > 0 ?? emit_brgt(break_tag) :: emit_brlt(break_tag) fin if token == STEP_TKN - parse_expr - if stepdir > 0 - emit_binaryop(ADD_TKN) - else - emit_binaryop(SUB_TKN) + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err("Bad FOR STEP expression"); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop fin + emit_binaryop(stepdir > 0 ?? ADD_TKN :: SUB_TKN) else - if stepdir > 0 - emit_unaryop(INC_TKN) - else - emit_unaryop(DEC_TKN) - fin + emit_unaryop(stepdir > 0 ?? INC_TKN :: DEC_TKN) fin while parse_stmnt nextln loop - if token <> NEXT_TKN; exit_err(@bad_stmnt); fin + if token <> NEXT_TKN; exit_err("Missing FOR/NEXT"); fin emit_branch(tag_for) cont_tag = tag_prevcnt - ctag_resolve(break_tag) + emit_ctag(break_tag) emit_drop - break_tag = tag_prevbrk - stack_loop = stack_loop - 1 + break_tag = tag_prevbrk + stack_loop-- break is CASE_TKN - stack_loop = stack_loop + 1 + stack_loop++ tag_prevbrk = break_tag break_tag = ctag_new tag_choice = ctag_new tag_of = ctag_new - parse_expr + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err("Bad CASE expression"); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + fin nextln while token <> ENDCASE_TKN when token is OF_TKN - parse_expr + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err("Bad FOR TO expression"); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + fin emit_brne(tag_choice) - ctag_resolve(tag_of) + emit_ctag(tag_of) while parse_stmnt nextln loop @@ -760,45 +776,45 @@ def parse_stmnt(codeseq) if prevstmnt <> BREAK_TKN // Fall through to next OF if no break emit_branch(tag_of) fin - ctag_resolve(tag_choice) + emit_ctag(tag_choice) tag_choice = ctag_new break is DEFAULT_TKN - ctag_resolve(tag_of) + emit_ctag(tag_of) tag_of = 0 scan while parse_stmnt nextln loop - if token <> ENDCASE_TKN; exit_err(@bad_stmnt); fin + if token <> ENDCASE_TKN; exit_err("Bad WHEN OTHERWISE"); fin break is EOL_TKN nextln break otherwise - exit_err(@bad_stmnt) + exit_err("Bad WHEN") wend loop if (tag_of) - ctag_resolve(tag_of) + emit_ctag(tag_of) fin - ctag_resolve(break_tag) + emit_ctag(break_tag) emit_drop break_tag = tag_prevbrk - stack_loop = stack_loop - 1 + stack_loop-- break is BREAK_TKN if break_tag emit_branch(break_tag) else - exit_err(@bad_stmnt) + exit_err("BREAK outside FOR or WHEN") fin break is CONT_TKN if cont_tag emit_branch(cont_tag) else - exit_err(@bad_stmnt) + exit_err("CONTINUE outside FOR or WHEN") fin break is RETURN_TKN @@ -806,11 +822,27 @@ def parse_stmnt(codeseq) for i = 1 to stack_loop emit_drop next - fin - if !parse_expr - emit_const(0) - fin - emit_leave + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err("Bad CASE expression"); fin + if cfnvals > infuncvals + exit_err("Too many return values") + elsif cfnvals < infuncvals + parse_warn("Too few return values") + while cfnvals < infuncvals + cfnvals++ + emit_const(0) + loop + fin + emit_leave + else + seq, cfnvals = parse_expr(NULL) + if !seq + emit_const(0) + elsif cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_drop(seq); loop + fin + emit_ret break is EOL_TKN return TRUE @@ -827,128 +859,46 @@ def parse_stmnt(codeseq) is DONE_TKN is DEF_TKN return FALSE - is ID_TKN - saveptr = tknptr - idptr = id_lookup(tknptr, tknlen) - if !idptr; return FALSE; fin - type = idptr->idtype - addr = idptr=>idval - if type & VAR_TYPE - elem_type = type - elem_offset = 0 - if scan == DOT_TKN or token == COLON_TKN - // - // Structure member offset - // - if token == DOT_TKN - elem_type = BYTE_TYPE - else - elem_type = WORD_TYPE - fin - if !parse_const(@elem_offset) - token = ID_TKN - else - scan - fin - fin - if token == SET_TKN - parse_expr - if type & LOCAL_TYPE - if elem_type & BYTE_TYPE - emit_slb(addr + elem_offset) - else - emit_slw(addr + elem_offset) - fin - else - if elem_type & BYTE_TYPE - emit_sab(addr, elem_offset) - else - emit_saw(addr, elem_offset) - fin - fin - break - elsif token == INC_TKN or token == DEC_TKN - if type & LOCAL_TYPE - if elem_type & BYTE_TYPE - emit_llb(addr + elem_offset) - emit_unaryop(token) - emit_slb(addr + elem_offset) - else - emit_llw(addr + elem_offset) - emit_unaryop(token) - emit_slw(addr + elem_offset) - fin - else - if elem_type & BYTE_TYPE - emit_lab(addr, elem_offset) - emit_unaryop(token) - emit_sab(addr, elem_offset) - else - emit_law(addr, elem_offset) - emit_unaryop(token) - emit_saw(addr, elem_offset) - fin - fin - break - fin - elsif type & FUNC_TYPE - if scan == EOL_TKN - emit_call(addr) - emit_drop - break - fin - fin - tknptr = saveptr otherwise rewind(tknptr) - type = parse_value(0) - if type - if token == SET_TKN - parse_expr - if type & XBYTE_TYPE - emit_sb - else - emit_sw - fin - elsif token == INC_TKN or token == DEC_TKN - emit_dup - if type & XBYTE_TYPE - emit_lb + seq = parse_set(NULL) + if seq + emit_seq(seq) + else + idptr = tokenptr + seq, cfnvals = parse_value(NULL, RVALUE) + if seq + if token == INC_TKN or token == DEC_TKN + emit_seq(seq) emit_unaryop(token) - emit_sb + scanrewind(idptr) + seq, drop = parse_value(NULL, LVALUE) + emit_seq(seq) + elsif token <> SET_TKN + if cfnvals > 1 + seq = cat_seq(gen_pushexp(NULL), seq) + seq = cat_seq(seq, gen_pullexp(NULL) + elsif cfnvals == 1 + seq = cat_seq(seg, gen_drop(NULL)) + fin + emit_seq(seq) else - emit_lw - emit_unaryop(token) - emit_sw + exit_err("Invalid LVALUE") fin else - if type & BPTR_TYPE - emit_lb - elsif type & WPTR_TYPE - emit_lw - fin - emit_drop + exit_err("Syntax") fin - else - exit_err(@bad_syntax) fin wend - //if scan <> EOL_TKN; exit_err(@bad_syntax); fin - return TRUE + return scan == EOL_TKN end -def parse_var(type) +def parse_var(type, basesize)#0 byte consttype, constsize, idlen word idptr, constval, arraysize, size - //cout('T') idlen = 0 size = 1 - if scan == OPEN_BRACKET_TKN - size, constsize, consttype = parse_constexpr - if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin - scan - fin - if token == ID_TKN + if scan == ID_TKN idptr = tknptr idlen = tknlen if scan == OPEN_BRACKET_TKN @@ -957,11 +907,9 @@ def parse_var(type) scan fin fin - if type == WORD_TYPE - size = size * 2 - fin + size = size * basesize if token == SET_TKN - if infunc; exit_err(@no_local_init); fin + if type & (EXTERN_TYPE | LOCAL_TYPE); exit_err(@no_local_init); fin if idlen iddata_add(idptr, idlen, type, 0) fin @@ -979,14 +927,12 @@ def parse_var(type) iddata_add(idptr, idlen, type, size) fin fin - return TRUE end -def parse_struc +def parse_struc#0 byte strucid[16] byte type, idlen, struclen, constsize, consttype word size, offset, idstr - //cout('S') struclen = 0 if scan == ID_TKN struclen = tknlen @@ -998,50 +944,52 @@ def parse_struc next fin offset = 0 - while nextln == BYTE_TKN or token == WORD_TKN - size = 1 - if token == BYTE_TKN - type = BYTE_TYPE - else - type = WORD_TYPE - fin - if scan == OPEN_BRACKET_TKN - size, constsize, consttype = parse_constexpr - if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin - scan - fin - repeat - idlen = 0; - if token == ID_TKN - idstr = tknptr - idlen = tknlen - if scan == OPEN_BRACKET_TKN - size, constsize, consttype = parse_constexpr - if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin - scan + while nextln == BYTE_TKN or token == WORD_TKN or token == EOL_TKN + if token <> EOL_TKN + size = 1 + type = token == BYTE_TKN ?? BYTE_TYPE :: WORD_TYPE + if scan == OPEN_BRACKET_TKN + size, constsize, consttype = parse_constexpr + if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin + scan + fin + repeat + idlen = 0; + if token == ID_TKN + idstr = tknptr + idlen = tknlen + if scan == OPEN_BRACKET_TKN + size, constsize, consttype = parse_constexpr + if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin + scan + fin fin - fin - if type & WORD_TYPE - size = size * 2 - fin - if idlen - idconst_add(idstr, idlen, offset) - fin - offset = offset + size - until token <> COMMA_TKN - if token <> EOL_TKN; return FALSE; fin + if type & WORD_TYPE + size = size * 2 + fin + if idlen + idconst_add(idstr, idlen, offset) + fin + offset = offset + size + until token <> COMMA_TKN + fin loop if struclen idconst_add(@strucid, struclen, offset) fin - return token == END_TKN + if token <> END_TKN; exit_err("Missing STRUC/END"); fin + scan end -def parse_vars - byte idlen, type, size +def parse_vars(type) + byte idlen, size word value, idptr - //cout('V') when token + is SYSFLAGS_TKN + if type & (EXTERN_TYPE | LOCAL_TYPE); exit_err("SYSFLAGS must be global"); fin + value, drop, drop = parse_constexpr + emit_sysflags(value) + break is CONST_TKN if scan <> ID_TKN; exit_err(@bad_cnst); fin idptr = tknptr @@ -1053,56 +1001,153 @@ def parse_vars is STRUC_TKN parse_struc break + is EXPORT_TKN + if type & (EXTERN_TYPE | LOCAL_TYPE); exit_err("Cannot export local/imported variables"); fin + type = EXPORT_TYPE + idstr = tokenptr + if scan <> BYTE_TKN and token <> WORD_TKN // This could be an exported definition + scan_rewind(idstr) + scan + return + fin + // Fall through to BYTE or WORD declaration is BYTE_TKN is WORD_TKN - if token == BYTE_TKN - type = BYTE_TYPE + type = type | (token == BYTE_TKN ?? BYTE_TYPE :: WORD_TYPE) + size = 1 + if scan == OPEN_BRACKET_TKN // Get basesize for data elements + size, drop, drop = parse_constexpr + if token <> CLOSE_BRACKET_TKN; exit_err(@no_close_bracket); fin else - type = WORD_TYPE + scan_rewind(tokenptr) fin - repeat - if !parse_var(type) - return FALSE - fin - until token <> COMMA_TKN + if type & WORD_TYPE; size = size * 2; fin + repeat; parse_var(type, size); until token <> COMMA_TKN break is PREDEF_TKN repeat if scan == ID_TKN - idfunc_add(tknptr, tknlen, ctag_new) + type = type | PREDEF_TYPE + idstr = tokenptr + idlen = tokenlen + cfnparms = 0 + cfnvals = 1 // Default to one return value for compatibility + if scan == OPEN_PAREN_TKN + repeat + if scan == ID_TKN + cfnparms++ + scan + fin + until token <> COMMA_TOKEN + if token <> CLOSE_PAREN_TKN; exit_err("Bad function parameter list"); fin + scan + fin + if token == POUND_TKN + if not parse_const(@cfnvals); exit_err("Invalid def return value count"); fin + scan + fin + idfunc_add(idstr, idlen, type, tag_new(type), cfnparms, cfnvals) else - exit_err(@bad_decl) + exit_err("Bad function pre-declaration") fin - until scan <> COMMA_TKN + until token <> COMMA_TKN + break + is EOL_TKN break otherwise - return token == EOL_TKN ?? TRUE :: FALSE + return FALSE wend return TRUE end -def parse_defs +def parse_mods + if token == IMPORT_TKN + if scan <> ID_TKN; exit_err("Bad import definition"); fin + emit_moddep(tokenstr, tokenlen) + scan + while parse_vars(EXTERN_TYPE); next_line(); loop + if token <> END_TKN; exit_err("Missing IMPORT/END"); fin + scan + fin + if token == EOL_TOKEN + return TRUE + emit_moddep(0, 0) + return FALSE +} +def parse_lambda + word func_tag byte cfnparms + + if not infunc; exit_err("Lambda functions only allowed inside definitions"); fin + idlocal_save + // + //Parse parameters and return value count + // + cfnparms = 0 + if scan == OPEN_PAREN_TKN + repeat + if scan == ID_TKN + cfnparms++ + idlocal_add(tokenstr, tokenlen, WORD_TYPE, 2) + scan + fin + until token <> COMMA_TKN + if token <> CLOSE_PAREN_TKN; exit_err("Bad function parameter list"); fin + else + exit_err("Missing parameter list in lambda function"); + fin + expr = scanptr + if scan_lookahead == OPEN_PAREN_TKN + scan + lambda_seq[lambda_cnt], drop = parse_list(NULL) + if token <> CLOSE_PAREN_TKN; exit_error("Missing closing lambda function parenthesis"); fin + else + lambda_seq[lambda_cnt], drop = parse_expr(NULL) + scan_rewind(tknptr) + fin + // + // Build an anonymous ID string for the Lambda function + // + strcpy(lambda_id + lambda_cnt * 8, "_LAMB__") + ^(lambda_id + lambda_cnt * 8 + 6) = (lambda_num >> 3) & 0x07 + '0' + ^(lambda_id + lambda_cnt * 8 + 7) = lambda_num & 0x07 + '0' + if idglobal_lookup(lambda_id + lambda_cnt * 8, 7) >= 0 + // + // Lambda ID already exists (from failed scanning for '=') + // + func_tag = lambda_tag=>[lambda_cnt] + idfunc_set(lambda_id + lambda_cnt * 8 + 1, 7, func_tag, 0, 0) // Override any predef type & tag + else + // + // Creat new Lambda ID + // + func_tag = ctag_new + lambda_tag=>[lambda_cnt] = func_tag + idfunc_add(lambda_id + lambda_cnt * 8 + 1, 7, func_tag, 0, 0) + fin + lambda_cnt++ + idlocal_restore + return func_tag +end +def parse_defs + byte cfnparms, cfnvals, type word func_tag, idptr + type = DEF_TYPE + if token == EXPORT_TKN + if scan <> DEF_TKN; exit_err("Bad export definition"); fin + type = type | EXPORT_TYPE + fin if token == DEF_TKN - //cout('D') if scan <> ID_TKN; exit_err(@bad_decl); fin - cfnparms = 0 - infunc = TRUE - idptr = idglobal_lookup(tknptr, tknlen) - if idptr - func_tag = idptr=>idval - else - func_tag = ctag_new - idfunc_add(tknptr, tknlen, func_tag) - fin - ctag_resolve(func_tag) - retfunc_tag = ctag_new + lambda_cnt = 0 + cfnparms = 0 + infuncvals = 1 + infunc = TRUE idlocal_init if scan == OPEN_PAREN_TKN repeat if scan == ID_TKN - cfnparms = cfnparms + 1 + cfnparms++ idlocal_add(tknptr, tknlen, WORD_TYPE, 2) scan fin @@ -1110,7 +1155,23 @@ def parse_defs if token <> CLOSE_PAREN_TKN; exit_err(@bad_decl); fin scan fin - while parse_vars + if token == POUND_TKN + if not parse_const(@infuncvals); parse_error("Invalid def return value count"); fin + scan + fin + idptr = idglobal_lookup(tknptr, tknlen) + if idptr + if not idptr->type & PREDEF_TYPE; exit_err("Mismatch function type"); fin + if idptr->funcparms <> cfnparms or idptr->funcvals <> infuncvals; exit_err("Mismatch function params/return values"); fin + emit_idfunc(idptr) + func_tag = idptr=>idval + else + func_tag = ctag_new + idfunc_add(tknptr, tknlen, func_tag, 0, 0, cfnparms, infuncvals) + fin + emit_ctag(func_tag) + retfunc_tag = ctag_new + while parse_vars(LOCAL_TYPE) nextln loop emit_enter(cfnparms) @@ -1119,12 +1180,19 @@ def parse_defs nextln loop infunc = FALSE - if token <> END_TKN; exit_err(@bad_syntax); fin + if token <> END_TKN; exit_err("Missing DEF/END"); fin + scan if prevstmnt <> RETURN_TKN - emit_const(0) + if infuncvals; parse_warn("No return values"); fin + for cfnvals = infuncvals - 1 downto 0 + emit_const(0) emit_leave fin return TRUE + while lambda_cnt + lambda_cnt-- + emit_lambdafunc(lambda_tag[lambda_cnt], lambda_id + lambda_cnt * 8, lambda_cparams[lambda_cnt], lambda_seq[lambda_cnt]) + loop fin return token == EOL_TKN ?? TRUE :: FALSE end @@ -1161,9 +1229,6 @@ def parse_module fin fileio:close(srcref) //dumpsym(idglobal_tbl, globals) - // - // Write REL file - // return not parserr fin else diff --git a/src/toolsrc/plasm.pla b/src/toolsrc/plasm.pla index 30faae9..f42337c 100644 --- a/src/toolsrc/plasm.pla +++ b/src/toolsrc/plasm.pla @@ -272,17 +272,24 @@ byte no_ctag_offst[] = "CODE OFFSET NOT SUPPORTED" byte no_close_paren[] = "MISSING CLOSING PAREN" byte no_close_bracket[] = "MISSING CLOSING BRACKET" byte missing_op[] = "MISSING OPERAND" -byte no_fin[] = "MISSING FIN" byte no_loop[] = "MISSING LOOP" byte no_until[] = "MISSING UNTIL" byte no_done[] = "MISSING DONE" byte no_local_init[] = "NO INITIALIZED LOCALS" // +// Compiler optimizer flags +// +const OPTIMIZE = 1 +const OPTIMIZE2 = 2 +const NO_COMBINE = 4 +byte outflags +// // ProDOS/SOS file references // byte refnum, srcref, incref byte[32] srcfile byte[32] incfile +byte[32] relfile word parsefile // Pointer to current file word sysincbuf // System I/O buffer for include files word srcline // Saved source line number @@ -293,6 +300,7 @@ byte[128] strconst byte infunc = 0 byte stack_loop = 0 byte prevstmnt = 0 +word infunvals = 0 word retfunc_tag = 0 word break_tag = 0 word cont_tag = 0 @@ -308,6 +316,17 @@ word exit // //===================================== +// +// Handy functions +// +def strcpy(dst, src) + if ^src + memcpy(dst, src, ^src + 1) + else + ^dst = 0 + fin + return ^dst +end // // Error handler // @@ -333,14 +352,45 @@ include "toolsrc/parse.pla" // Look at command line arguments and compile module // arg = argNext(argFirst) +if ^arg and ^(arg + 1) == '-' + arg = arg + 2 + while TRUE + if toupper(^arg) == 'O' + outflags = outflags | OPTIMIZE + arg++ + if ^arg == '2' + outflags = outflags | OPTIMIZE + arg++ + fin + elsif toupper(^arg) == 'N' + outflags = outflags | NO_COMBINE + else + break + fin + loop + arg = argNext(arg) +fin if arg strcpy(@srcfile, arg) + arg = argNext(arg) + if arg + strcpy(@relfile, arg) + fin +fin +if srcfile and relfile exit = heapalloc(t_longjmp) if not setjmp(exit) + // + // Parse source code module + // parsemodule puts("Bytes compiled: "); puti(codeptr - codebuff); putln + // + // Write REL file + // + writerel fin else - puts("Usage: +PLASM [srcfile]\n") + puts("Usage: +PLASM [-O[2]] \n") fin done diff --git a/src/vmsrc/plvm.c b/src/vmsrc/plvm.c index 402c8bd..0ec356e 100755 --- a/src/vmsrc/plvm.c +++ b/src/vmsrc/plvm.c @@ -873,6 +873,7 @@ void interp(code *ip) */ default: fprintf(stderr, "Illegal opcode 0x%02X @ 0x%04X\n", ip[-1], ip - mem_data); + exit(-1); } } }