X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=src%2Foberon.c;h=437e7694205489c681c5da3757bdc7e58a42ad39;hp=04d4c6d75a736a8e1d1f57e909ba6d509775fcf4;hb=35e75d29be18a7355aaaea9e146f3fda1d91857f;hpb=ba1a55241f3841d1254317d76d45322c85fb687b diff --git a/src/oberon.c b/src/oberon.c index 04d4c6d..437e769 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -10,8 +10,6 @@ #include -#include "../include/oberon.h" - #include "oberon-internals.h" #include "oberon-type-compat.h" #include "oberon-common.h" @@ -362,15 +360,20 @@ oberon_get_char(oberon_context_t * ctx) if(ctx -> code[ctx -> code_index]) { ctx -> code_index += 1; + ctx -> xloc.col += 1; ctx -> c = ctx -> code[ctx -> code_index]; } } static void -oberon_init_scaner(oberon_context_t * ctx, const char * code) +oberon_init_scaner(oberon_context_t * ctx, oberon_scanner_t * s) { - ctx -> code = code; + ctx -> code = s -> code; ctx -> code_index = 0; + ctx -> xloc.source = s -> source; + ctx -> xloc.line = 1; + ctx -> xloc.col = 1; + ctx -> loc = ctx -> xloc; ctx -> c = ctx -> code[ctx -> code_index]; } @@ -689,12 +692,40 @@ oberon_read_number(oberon_context_t * ctx) ctx -> real = real; } +static void +oberon_get_lined_char(oberon_context_t * ctx) +{ + do + { + if(ctx -> c == 0xD) + { + oberon_get_char(ctx); + if(ctx -> c == 0xA) + { + oberon_get_char(ctx); + } + ctx -> xloc.line += 1; + ctx -> xloc.col = 1; + } + else if(ctx -> c == 0xA) + { + oberon_get_char(ctx); + ctx -> xloc.line += 1; + ctx -> xloc.col = 1; + } + else + { + 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_char(ctx); + oberon_get_lined_char(ctx); } } @@ -706,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; } } @@ -728,7 +759,7 @@ oberon_read_comment(oberon_context_t * ctx) } else { - oberon_get_char(ctx); + oberon_get_lined_char(ctx); } } } @@ -910,6 +941,8 @@ oberon_read_token(oberon_context_t * ctx) { oberon_skip_space(ctx); + ctx -> loc = ctx -> xloc; + int c = ctx -> c; if(isalpha(c) || c == '_') { @@ -1259,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)) @@ -1925,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) { @@ -1939,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_DIV, result, a, b); + break; + default: + printf("token %i line %i\n", token, ctx -> loc.line); assert(0); break; } @@ -2352,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); } @@ -2758,7 +2817,14 @@ oberon_prevent_recursive_pointer(oberon_context_t * ctx, oberon_type_t * type) if(type -> recursive) { - oberon_error(ctx, "recursive pointer declaration"); + if(type -> class == OBERON_TYPE_POINTER) + { + oberon_error(ctx, "recursive pointer declaration"); + } + else + { + oberon_error(ctx, "recursive array declaration (pointer)"); + } } if(type -> class == OBERON_TYPE_POINTER @@ -2911,20 +2977,12 @@ static void oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type) static void oberon_initialize_record_fields(oberon_context_t * ctx, oberon_type_t * type) { - if(type -> class != OBERON_TYPE_RECORD) - { - return; - } + assert(type -> class == OBERON_TYPE_RECORD); int num_fields = type -> num_decl; oberon_object_t * field = type -> decl; for(int i = 0; i < num_fields; i++) { - if(field -> type -> class == OBERON_TYPE_POINTER) - { - oberon_initialize_type(ctx, field -> type); - } - oberon_initialize_object(ctx, field); field = field -> next; } @@ -2947,39 +3005,50 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type) type -> initialized = 1; - if(type -> class == OBERON_TYPE_POINTER) - { - oberon_initialize_type(ctx, type -> base); - oberon_generator_init_type(ctx, type); - } - else if(type -> class == OBERON_TYPE_ARRAY) + if(type -> class == OBERON_TYPE_POINTER || type -> class == OBERON_TYPE_ARRAY) { - if(type -> size != 0) + if(type -> class == OBERON_TYPE_ARRAY + && type -> size != 0 + && type -> base -> class == OBERON_TYPE_ARRAY + && type -> base -> size == 0) { - if(type -> base -> class == OBERON_TYPE_ARRAY) - { - if(type -> base -> size == 0) - { - oberon_error(ctx, "open array not allowed as array element"); - } - } + oberon_error(ctx, "open array not allowed as array element"); } - oberon_initialize_type(ctx, type -> base); - oberon_generator_init_type(ctx, type); + oberon_type_t * rec = type -> base; + while(rec -> class == OBERON_TYPE_ARRAY || rec -> class == OBERON_TYPE_POINTER) + { + rec = rec -> base; + } + + if(rec -> class == OBERON_TYPE_RECORD + && rec -> initialized == 0) + { + rec -> initialized = 1; + oberon_generator_init_type(ctx, rec); + oberon_initialize_type(ctx, type -> base); + oberon_generator_init_type(ctx, type); + oberon_initialize_record_fields(ctx, rec); + } + else + { + oberon_initialize_type(ctx, type -> base); + oberon_generator_init_type(ctx, type); + } } else if(type -> class == OBERON_TYPE_RECORD) { + printf("Init type: RECORD\n"); oberon_generator_init_type(ctx, type); oberon_initialize_record_fields(ctx, type); } else if(type -> class == OBERON_TYPE_PROCEDURE) { + printf("Init type: PROCEDURE\n"); int num_fields = type -> num_decl; oberon_object_t * field = type -> decl; for(int i = 0; i < num_fields; i++) { - //oberon_initialize_object(ctx, field); oberon_initialize_type(ctx, field -> type); field = field -> next; } @@ -3156,7 +3225,7 @@ oberon_case_labels(oberon_context_t * ctx, oberon_expr_t * val) oberon_expr_t * cond2; e1 = (oberon_expr_t *) oberon_const_expr(ctx); - + e2 = NULL; if(ctx -> token == DOTDOT) { @@ -3567,14 +3636,14 @@ oberon_import_module(oberon_context_t * ctx, char * alias, char * name) if(m == NULL) { - const char * code; - code = ctx -> import_module(name); - if(code == NULL) + oberon_scanner_t * s; + s = ctx -> import_module(name); + if(s == NULL) { - oberon_error(ctx, "no such module"); + oberon_error(ctx, "no such module %s", name); } - m = oberon_compile_module(ctx, code); + m = oberon_compile_module(ctx, s); assert(m); } @@ -3818,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"); } @@ -3852,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"); } @@ -3866,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); } @@ -3951,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"); } @@ -3965,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); } @@ -4859,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); @@ -4878,10 +4981,12 @@ oberon_destroy_context(oberon_context_t * ctx) } oberon_module_t * -oberon_compile_module(oberon_context_t * ctx, const char * newcode) +oberon_compile_module(oberon_context_t * ctx, oberon_scanner_t * s) { const char * code = ctx -> code; int code_index = ctx -> code_index; + oberon_location_t loc = ctx -> loc; + oberon_location_t xloc = ctx -> xloc; char c = ctx -> c; int token = ctx -> token; char * string = ctx -> string; @@ -4903,13 +5008,15 @@ oberon_compile_module(oberon_context_t * ctx, const char * newcode) ctx -> mod = module; ctx -> module_list = module; - oberon_init_scaner(ctx, newcode); + oberon_init_scaner(ctx, s); oberon_parse_module(ctx); module -> ready = 1; ctx -> code = code; ctx -> code_index = code_index; + ctx -> loc = loc; + ctx -> xloc = xloc; ctx -> c = c; ctx -> token = token; ctx -> string = string;