X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=oberon.c;h=ac695d384bd17567d76620269a3ad02ac3929d57;hb=2d029d2c2b27639e3a2b6c43e63788b00110818e;hp=f4a711f5da3156912e43afb4bc8887dd076936a3;hpb=7bff9378302d5e23c6e9eabe7e6edc8034dcd562;p=dsw-obn.git diff --git a/oberon.c b/oberon.c index f4a711f..ac695d3 100644 --- a/oberon.c +++ b/oberon.c @@ -50,7 +50,9 @@ enum { RBRACE, RECORD, POINTER, - TO + TO, + UPARROW, + NIL }; // ======================================================================= @@ -116,6 +118,12 @@ oberon_open_scope(oberon_context_t * ctx) scope -> list = list; scope -> up = ctx -> decl; + if(scope -> up) + { + scope -> parent = scope -> up -> parent; + scope -> local = scope -> up -> local; + } + ctx -> decl = scope; return scope; } @@ -145,6 +153,8 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class) memset(newvar, 0, sizeof *newvar); newvar -> name = name; newvar -> class = class; + newvar -> local = scope -> local; + newvar -> parent = scope -> parent; x -> next = newvar; @@ -154,6 +164,8 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class) static void oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char * name, oberon_type_t * type) { + // TODO check base fields + oberon_object_t * x = rec -> decl; while(x -> next && strcmp(x -> next -> name, name) != 0) { @@ -170,6 +182,8 @@ oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char * name, o field -> name = name; field -> class = OBERON_CLASS_FIELD; field -> type = type; + field -> local = 1; + field -> parent = NULL; rec -> num_decl += 1; x -> next = field; @@ -395,6 +409,10 @@ oberon_read_ident(oberon_context_t * ctx) { ctx -> token = TO; } + else if(strcmp(ident, "NIL") == 0) + { + ctx -> token = NIL; + } } static void @@ -527,6 +545,10 @@ oberon_read_symbol(oberon_context_t * ctx) ctx -> token = RBRACE; oberon_get_char(ctx); break; + case '^': + ctx -> token = UPARROW; + oberon_get_char(ctx); + break; default: oberon_error(ctx, "invalid char"); break; @@ -562,6 +584,7 @@ static oberon_expr_t * oberon_expr(oberon_context_t * ctx); static void oberon_assert_token(oberon_context_t * ctx, int token); static char * oberon_assert_ident(oberon_context_t * ctx); static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type); +static oberon_item_t * oberon_const_expr(oberon_context_t * ctx); static oberon_expr_t * oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right) @@ -628,7 +651,7 @@ oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a) } static void -oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first) +oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first, int const_expr) { oberon_expr_t * last; @@ -638,7 +661,16 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first) { oberon_assert_token(ctx, COMMA); oberon_expr_t * current; - current = oberon_expr(ctx); + + if(const_expr) + { + current = (oberon_expr_t *) oberon_const_expr(ctx); + } + else + { + current = oberon_expr(ctx); + } + last -> next = current; last = current; *num_expr += 1; @@ -653,7 +685,6 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * oberon_error(ctx, "incompatible types"); } - if(pref -> class == OBERON_TYPE_INTEGER) { if(expr -> result -> class > pref -> class) @@ -669,6 +700,16 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * oberon_error(ctx, "incompatible record types"); } } + else if(pref -> class == OBERON_TYPE_POINTER) + { + if(expr -> result -> base != pref -> base) + { + if(expr -> result -> base -> class != OBERON_TYPE_VOID) + { + oberon_error(ctx, "incompatible pointer types"); + } + } + } // TODO cast @@ -710,6 +751,24 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) oberon_object_t * param = fn -> decl; for(int i = 0; i < num_args; i++) { + if(param -> class == OBERON_CLASS_VAR_PARAM) + { + if(arg -> is_item) + { + switch(arg -> item.mode) + { + case MODE_VAR: + case MODE_INDEX: + case MODE_FIELD: + // Допустимо разыменование? + //case MODE_DEREF: + break; + default: + oberon_error(ctx, "var-parameter accept only variables"); + break; + } + } + } oberon_autocast_to(ctx, arg, param -> type); arg = arg -> next; param = param -> next; @@ -726,51 +785,65 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) || ((x) == TRUE) \ || ((x) == FALSE)) -#define ISSELECTOR(x) \ - (((x) == LBRACE) \ - || ((x) == DOT)) - static oberon_expr_t * -oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int num_indexes, oberon_expr_t * indexes) +oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr) { - assert(desig -> is_item == 1); - - if(desig -> item.mode != MODE_VAR) + if(expr -> result -> class != OBERON_TYPE_POINTER) { - oberon_error(ctx, "not MODE_VAR"); + oberon_error(ctx, "not a pointer"); } - int class = desig -> item.var -> class; - switch(class) + assert(expr -> is_item); + + oberon_expr_t * selector; + selector = oberon_new_item(MODE_DEREF, expr -> result -> base); + selector -> item.parent = (oberon_item_t *) expr; + + return selector; +} + +static oberon_expr_t * +oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon_expr_t * index) +{ + if(desig -> result -> class == OBERON_TYPE_POINTER) { - case OBERON_CLASS_VAR: - case OBERON_CLASS_VAR_PARAM: - case OBERON_CLASS_PARAM: - break; - default: - oberon_error(ctx, "not variable"); - break; + desig = oberno_make_dereferencing(ctx, desig); } - oberon_type_t * type = desig -> item.var -> type; - if(type -> class != OBERON_TYPE_ARRAY) + assert(desig -> is_item); + + if(desig -> result -> class != OBERON_TYPE_ARRAY) { oberon_error(ctx, "not array"); } -// int dim = desig -> item.var -> type -> dim; -// if(num_indexes != dim) -// { -// oberon_error(ctx, "dimesions not matched"); -// } + oberon_type_t * base; + base = desig -> result -> base; - oberon_type_t * base = desig -> item.var -> type -> base; + if(index -> result -> class != OBERON_TYPE_INTEGER) + { + oberon_error(ctx, "index must be integer"); + } + + // Статическая проверка границ массива + if(index -> is_item) + { + if(index -> item.mode == MODE_INTEGER) + { + int arr_size = desig -> result -> size; + int index_int = index -> item.integer; + if(index_int < 0 || index_int > arr_size - 1) + { + oberon_error(ctx, "not in range (dimension size 0..%i)", arr_size - 1); + } + } + } oberon_expr_t * selector; selector = oberon_new_item(MODE_INDEX, base); selector -> item.parent = (oberon_item_t *) desig; - selector -> item.num_args = num_indexes; - selector -> item.args = indexes; + selector -> item.num_args = 1; + selector -> item.args = index; return selector; } @@ -778,10 +851,14 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int nu static oberon_expr_t * oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * name) { + if(expr -> result -> class == OBERON_TYPE_POINTER) + { + expr = oberno_make_dereferencing(ctx, expr); + } + assert(expr -> is_item == 1); - int class = expr -> result -> class; - if(class != OBERON_TYPE_RECORD) + if(expr -> result -> class != OBERON_TYPE_RECORD) { oberon_error(ctx, "not record"); } @@ -799,6 +876,11 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * return selector; } +#define ISSELECTOR(x) \ + (((x) == LBRACE) \ + || ((x) == DOT) \ + || ((x) == UPARROW)) + static oberon_expr_t * oberon_designator(oberon_context_t * ctx) { @@ -842,9 +924,18 @@ oberon_designator(oberon_context_t * ctx) oberon_assert_token(ctx, LBRACE); int num_indexes = 0; oberon_expr_t * indexes = NULL; - oberon_expr_list(ctx, &num_indexes, &indexes); + oberon_expr_list(ctx, &num_indexes, &indexes, 0); oberon_assert_token(ctx, RBRACE); - expr = oberon_make_array_selector(ctx, expr, num_indexes, indexes); + + for(int i = 0; i < num_indexes; i++) + { + expr = oberon_make_array_selector(ctx, expr, indexes); + indexes = indexes -> next; + } + break; + case UPARROW: + oberon_assert_token(ctx, UPARROW); + expr = oberno_make_dereferencing(ctx, expr); break; default: oberon_error(ctx, "oberon_designator: wat"); @@ -873,7 +964,7 @@ oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr) if(ISEXPR(ctx -> token)) { - oberon_expr_list(ctx, &num_args, &arguments); + oberon_expr_list(ctx, &num_args, &arguments, 0); } expr -> result = expr -> item.var -> type -> base; @@ -924,6 +1015,10 @@ oberon_factor(oberon_context_t * ctx) expr = oberon_factor(ctx); expr = oberon_make_unary_op(ctx, NOT, expr); break; + case NIL: + oberon_assert_token(ctx, NIL); + expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type); + break; default: oberon_error(ctx, "invalid expression"); } @@ -1174,7 +1269,9 @@ oberon_const_expr(oberon_context_t * ctx) // PARSER // ======================================================================= +static void oberon_decl_seq(oberon_context_t * ctx); static void oberon_statement_seq(oberon_context_t * ctx); +static void oberon_initialize_decl(oberon_context_t * ctx); static void oberon_expect_token(oberon_context_t * ctx, int token) @@ -1283,6 +1380,7 @@ oberon_formal_pars(oberon_context_t * ctx, oberon_type_t * signature) if(ctx -> token == COLON) { oberon_assert_token(ctx, COLON); + // TODO get by qualident oberon_type(ctx, &signature -> base); } } @@ -1306,7 +1404,10 @@ oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type) static void oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr) { - if(ctx -> result_type -> class == OBERON_TYPE_VOID) + oberon_object_t * proc = ctx -> decl -> parent; + oberon_type_t * result_type = proc -> type -> base; + + if(result_type -> class == OBERON_TYPE_VOID) { if(expr != NULL) { @@ -1320,10 +1421,10 @@ oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr) oberon_error(ctx, "procedure requires expression on result"); } - oberon_autocast_to(ctx, expr, ctx -> result_type); + oberon_autocast_to(ctx, expr, result_type); } - ctx -> has_return = 1; + proc -> has_return = 1; oberon_generate_return(ctx, expr); } @@ -1338,6 +1439,7 @@ oberon_proc_decl(oberon_context_t * ctx) oberon_scope_t * this_proc_def_scope = ctx -> decl; oberon_open_scope(ctx); + ctx -> decl -> local = 1; oberon_type_t * signature; signature = oberon_new_type_ptr(OBERON_TYPE_VOID); @@ -1346,14 +1448,18 @@ oberon_proc_decl(oberon_context_t * ctx) oberon_object_t * proc; proc = oberon_define_proc(this_proc_def_scope, name, signature); - ctx -> result_type = signature -> base; - ctx -> has_return = 0; + // процедура как новый родительский объект + ctx -> decl -> parent = proc; + + oberon_initialize_decl(ctx); + oberon_generator_init_proc(ctx, proc); oberon_assert_token(ctx, SEMICOLON); - oberon_generate_begin_proc(ctx, proc); + oberon_decl_seq(ctx); + oberon_generator_init_type(ctx, signature); - // TODO declarations + oberon_generate_begin_proc(ctx, proc); if(ctx -> token == BEGIN) { @@ -1373,11 +1479,10 @@ oberon_proc_decl(oberon_context_t * ctx) oberon_make_return(ctx, NULL); } - if(ctx -> has_return == 0) + if(proc -> has_return == 0) { oberon_error(ctx, "procedure requires return"); } - ctx -> result_type = NULL; oberon_generate_end_proc(ctx); oberon_close_scope(ctx -> decl); @@ -1399,9 +1504,14 @@ oberon_const_decl(oberon_context_t * ctx) } static void -oberon_make_array_type(oberon_context_t * ctx, oberon_item_t * size, oberon_type_t * base, oberon_type_t ** type) +oberon_make_array_type(oberon_context_t * ctx, oberon_expr_t * size, oberon_type_t * base, oberon_type_t ** type) { - if(size -> mode != MODE_INTEGER) + if(size -> is_item == 0) + { + oberon_error(ctx, "requires constant"); + } + + if(size -> item.mode != MODE_INTEGER) { oberon_error(ctx, "requires integer constant"); } @@ -1409,7 +1519,7 @@ oberon_make_array_type(oberon_context_t * ctx, oberon_item_t * size, oberon_type oberon_type_t * arr; arr = *type; arr -> class = OBERON_TYPE_ARRAY; - arr -> size = size -> integer; + arr -> size = size -> item.integer; arr -> base = base; } @@ -1460,6 +1570,23 @@ static void oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type * Правило граматики "type". Указатель type должен указывать на существующий объект! */ +static void +oberon_make_multiarray(oberon_context_t * ctx, oberon_expr_t * sizes, oberon_type_t * base, oberon_type_t ** type) +{ + if(sizes == NULL) + { + *type = base; + return; + } + + oberon_type_t * dim; + dim = oberon_new_type_ptr(OBERON_TYPE_VOID); + + oberon_make_multiarray(ctx, sizes -> next, base, &dim); + + oberon_make_array_type(ctx, sizes, dim, type); +} + static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type) { @@ -1471,8 +1598,9 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type) { oberon_assert_token(ctx, ARRAY); - oberon_item_t * size; - size = oberon_const_expr(ctx); + int num_sizes = 0; + oberon_expr_t * sizes; + oberon_expr_list(ctx, &num_sizes, &sizes, 1); oberon_assert_token(ctx, OF); @@ -1480,7 +1608,7 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type) base = oberon_new_type_ptr(OBERON_TYPE_VOID); oberon_type(ctx, &base); - oberon_make_array_type(ctx, size, base, type); + oberon_make_multiarray(ctx, sizes, base, type); } else if(ctx -> token == RECORD) { @@ -1773,16 +1901,8 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type) if(type -> class == OBERON_TYPE_POINTER) { - if(type -> base -> class == OBERON_TYPE_RECORD) - { - oberon_generator_init_type(ctx, type -> base); - oberon_generator_init_type(ctx, type); - } - else - { - oberon_initialize_type(ctx, type -> base); - oberon_generator_init_type(ctx, type); - } + oberon_initialize_type(ctx, type -> base); + oberon_generator_init_type(ctx, type); } else if(type -> class == OBERON_TYPE_ARRAY) { @@ -1815,7 +1935,13 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type) static void oberon_initialize_object(oberon_context_t * ctx, oberon_object_t * x) { - printf("oberon_initialize_object: name %s class %i\n", x -> name, x -> class); + if(x -> initialized) + { + return; + } + + x -> initialized = 1; + switch(x -> class) { case OBERON_CLASS_TYPE: @@ -1902,6 +2028,14 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst) static void oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig) { + if(desig -> result -> class != OBERON_TYPE_VOID) + { + if(desig -> result -> class != OBERON_TYPE_PROCEDURE) + { + oberon_error(ctx, "procedure with result"); + } + } + oberon_autocast_call(ctx, desig); oberon_generate_call_proc(ctx, desig); } @@ -1995,6 +2129,10 @@ register_default_types(oberon_context_t * ctx) ctx -> void_type = oberon_new_type_ptr(OBERON_TYPE_VOID); oberon_generator_init_type(ctx, ctx -> void_type); + ctx -> void_ptr_type = oberon_new_type_ptr(OBERON_TYPE_POINTER); + ctx -> void_ptr_type -> base = ctx -> void_type; + oberon_generator_init_type(ctx, ctx -> void_ptr_type); + ctx -> int_type = oberon_new_type_integer(sizeof(int)); oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type);