X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Foberon.c;h=83f39cd2cebea39ac30fd54f1125ba11151bb045;hb=0b724e12457f2507d398c51dc35200d833ce9362;hp=4afd4c27825aa3eccf0f95c0d62e40c010e3366d;hpb=1128fa8566c932e3996abd427fc75bc4c946e656;p=dsw-obn.git diff --git a/src/oberon.c b/src/oberon.c index 4afd4c2..83f39cd 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -693,9 +693,9 @@ oberon_read_number(oberon_context_t * ctx) } static void -oberon_skip_space(oberon_context_t * ctx) +oberon_get_lined_char(oberon_context_t * ctx) { - while(isspace(ctx -> c)) + do { if(ctx -> c == 0xD) { @@ -717,6 +717,15 @@ oberon_skip_space(oberon_context_t * ctx) { oberon_get_char(ctx); } + } while(ctx -> c == 0xD || ctx -> c == 0xA); +} + +static void +oberon_skip_space(oberon_context_t * ctx) +{ + while(isspace(ctx -> c)) + { + oberon_get_lined_char(ctx); } } @@ -728,19 +737,19 @@ oberon_read_comment(oberon_context_t * ctx) { if(ctx -> c == '(') { - oberon_get_char(ctx); + oberon_get_lined_char(ctx); if(ctx -> c == '*') { - oberon_get_char(ctx); + oberon_get_lined_char(ctx); nesting += 1; } } else if(ctx -> c == '*') { - oberon_get_char(ctx); + oberon_get_lined_char(ctx); if(ctx -> c == ')') { - oberon_get_char(ctx); + oberon_get_lined_char(ctx); nesting -= 1; } } @@ -750,7 +759,7 @@ oberon_read_comment(oberon_context_t * ctx) } else { - oberon_get_char(ctx); + oberon_get_lined_char(ctx); } } } @@ -1150,8 +1159,6 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_item_t * desig) int num_args = desig -> num_args; int num_decl = fn -> num_decl; - printf("oberon_autocast_call: num_args %i num_decl %i\n", num_args, num_decl); - if(num_args < num_decl) { oberon_error(ctx, "too few arguments"); @@ -1285,6 +1292,7 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args || ((x) == CHAR) \ || ((x) == STRING) \ || ((x) == NIL) \ + || ((x) == LBRACE) \ || ((x) == LPAREN) \ || ((x) == NOT)) @@ -1951,7 +1959,7 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ break; } } - else if(oberon_is_number_type(result)) + else if(oberon_is_real_type(result)) { switch(token) { @@ -1965,6 +1973,32 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ expr = oberon_new_operator(OP_MUL, result, a, b); break; default: + printf("token %i line %i\n", token, ctx -> loc.line); + assert(0); + break; + } + } + else if(oberon_is_integer_type(result)) + { + switch(token) + { + case PLUS: + expr = oberon_new_operator(OP_ADD, result, a, b); + break; + case MINUS: + expr = oberon_new_operator(OP_SUB, result, a, b); + break; + case STAR: + expr = oberon_new_operator(OP_MUL, result, a, b); + break; + case DIV: + expr = oberon_new_operator(OP_DIV, result, a, b); + break; + case MOD: + expr = oberon_new_operator(OP_MOD, result, a, b); + break; + default: + printf("token %i line %i\n", token, ctx -> loc.line); assert(0); break; } @@ -2378,8 +2412,7 @@ oberon_proc_decl_body(oberon_context_t * ctx, oberon_object_t * proc) oberon_error(ctx, "procedure name not matched"); } - if(proc -> type -> base -> class == OBERON_TYPE_NOTYPE - && proc -> has_return == 0) + if(proc -> type -> base -> class == OBERON_TYPE_NOTYPE) { oberon_make_return(ctx, NULL); } @@ -3462,7 +3495,7 @@ oberon_statement(oberon_context_t * ctx) oberon_error(ctx, "condition must be boolean"); } - oberon_generate_branch(ctx, cond, true, begin); + oberon_generate_branch(ctx, cond, false, begin); } else if(ctx -> token == FOR) { @@ -3854,7 +3887,7 @@ oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ arg = list_args; oberon_check_src(ctx, arg); - if(oberon_is_number_type(arg -> result)) + if(!oberon_is_number_type(arg -> result)) { oberon_error(ctx, "ABS accepts only numbers"); } @@ -3888,7 +3921,7 @@ oberon_make_inc_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ oberon_error(ctx, "too few arguments"); } - if(num_args > 1) + if(num_args > 2) { oberon_error(ctx, "too mach arguments"); } @@ -3902,8 +3935,24 @@ oberon_make_inc_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ oberon_error(ctx, "expect integer"); } + oberon_expr_t * step; + if(num_args == 2) + { + step = list_args -> next; + oberon_check_src(ctx, step); + oberon_check_const(ctx, step); + if(!oberon_is_integer_type(step -> result)) + { + oberon_error(ctx, "expect integer"); + } + } + else + { + step = oberon_make_integer(ctx, 1); + } + oberon_expr_t * expr; - expr = oberon_make_bin_op(ctx, PLUS, dst, oberon_make_integer(ctx, 1)); + expr = oberon_make_bin_op(ctx, PLUS, dst, step); oberon_assign(ctx, expr, dst); } @@ -3987,7 +4036,7 @@ oberon_make_dec_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ oberon_error(ctx, "too few arguments"); } - if(num_args > 1) + if(num_args > 2) { oberon_error(ctx, "too mach arguments"); } @@ -4001,8 +4050,24 @@ oberon_make_dec_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ oberon_error(ctx, "expect integer"); } + oberon_expr_t * step; + if(num_args == 2) + { + step = list_args -> next; + oberon_check_src(ctx, step); + oberon_check_const(ctx, step); + if(!oberon_is_integer_type(step -> result)) + { + oberon_error(ctx, "expect integer"); + } + } + else + { + step = oberon_make_integer(ctx, 1); + } + oberon_expr_t * expr; - expr = oberon_make_bin_op(ctx, MINUS, dst, oberon_make_integer(ctx, 1)); + expr = oberon_make_bin_op(ctx, MINUS, dst, step); oberon_assign(ctx, expr, dst); } @@ -4470,7 +4535,7 @@ oberon_make_ord_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ } else { - expr = oberon_cast_expr(ctx, arg, ctx -> int_type); + expr = oberon_cast_expr(ctx, arg, ctx -> shortint_type); } return expr; } @@ -4895,6 +4960,8 @@ oberon_create_context(ModuleImportCallback import_module) /* Types */ oberon_new_intrinsic_type(ctx, "BYTE", ctx -> system_byte_type); oberon_new_intrinsic_type(ctx, "PTR", ctx -> system_ptr_type); + oberon_new_intrinsic_type(ctx, "INT32", ctx -> int_type); + oberon_new_intrinsic_type(ctx, "SET32", ctx -> set_type); /* Functions */ oberon_new_intrinsic(ctx, "CC", oberon_make_cc_call, NULL);