X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=oberon.c;h=b56a458a6c1e979a743c9d4139b5df3044f1cdc3;hp=5b4c4ea84efada1e388a0c775f4d363e16df49d8;hb=89dfaf94ddbbc501020554232ce026b6584e8045;hpb=3818049ca3679e8fcc432345d41a2d930f7874e4 diff --git a/oberon.c b/oberon.c index 5b4c4ea..b56a458 100644 --- a/oberon.c +++ b/oberon.c @@ -155,42 +155,13 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class, int export, newvar -> read_only = read_only; newvar -> local = scope -> local; newvar -> parent = scope -> parent; + newvar -> module = scope -> ctx -> mod; x -> next = newvar; return newvar; } -/* -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) - { - x = x -> next; - } - - if(x -> next) - { - oberon_error(ctx, "multiple definition"); - } - - oberon_object_t * field = malloc(sizeof *field); - memset(field, 0, sizeof *field); - field -> name = name; - field -> class = OBERON_CLASS_FIELD; - field -> type = type; - field -> local = 1; - field -> parent = NULL; - - rec -> num_decl += 1; - x -> next = field; -} -*/ - static oberon_object_t * oberon_find_object_in_list(oberon_object_t * list, char * name) { @@ -554,6 +525,7 @@ oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon operator -> is_item = 0; operator -> result = result; + operator -> read_only = 1; operator -> op = op; operator -> left = left; operator -> right = right; @@ -562,7 +534,7 @@ oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon } static oberon_expr_t * -oberon_new_item(int mode, oberon_type_t * result) +oberon_new_item(int mode, oberon_type_t * result, int read_only) { oberon_item_t * item; item = malloc(sizeof *item); @@ -570,6 +542,7 @@ oberon_new_item(int mode, oberon_type_t * result) item -> is_item = 1; item -> result = result; + item -> read_only = read_only; item -> mode = mode; return (oberon_expr_t *)item; @@ -776,7 +749,7 @@ oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_ar oberon_error(ctx, "attempt to call procedure in expression"); } - call = oberon_new_item(MODE_CALL, proc -> type -> base); + call = oberon_new_item(MODE_CALL, proc -> type -> base, 1); call -> item.var = proc; call -> item.num_args = num_args; call -> item.args = list_args; @@ -827,7 +800,7 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_ar } oberon_expr_t * call; - call = oberon_new_item(MODE_CALL, proc -> type -> base); + call = oberon_new_item(MODE_CALL, proc -> type -> base, 1); call -> item.var = proc; call -> item.num_args = num_args; call -> item.args = list_args; @@ -857,7 +830,7 @@ oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr) assert(expr -> is_item); oberon_expr_t * selector; - selector = oberon_new_item(MODE_DEREF, expr -> result -> base); + selector = oberon_new_item(MODE_DEREF, expr -> result -> base, expr -> read_only); selector -> item.parent = (oberon_item_t *) expr; return selector; @@ -901,7 +874,7 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon } oberon_expr_t * selector; - selector = oberon_new_item(MODE_INDEX, base); + selector = oberon_new_item(MODE_INDEX, base, desig -> read_only); selector -> item.parent = (oberon_item_t *) desig; selector -> item.num_args = 1; selector -> item.args = index; @@ -929,8 +902,25 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * oberon_object_t * field; field = oberon_find_field(ctx, rec, name); + if(field -> export == 0) + { + if(field -> module != ctx -> mod) + { + oberon_error(ctx, "field not exported"); + } + } + + int read_only = 0; + if(field -> read_only) + { + if(field -> module != ctx -> mod) + { + read_only = 1; + } + } + oberon_expr_t * selector; - selector = oberon_new_item(MODE_FIELD, field -> type); + selector = oberon_new_item(MODE_FIELD, field -> type, read_only); selector -> item.var = field; selector -> item.parent = (oberon_item_t *) expr; @@ -984,6 +974,15 @@ oberon_designator(oberon_context_t * ctx) var = oberon_qualident(ctx, NULL, 1); + int read_only = 0; + if(var -> read_only) + { + if(var -> module != ctx -> mod) + { + read_only = 1; + } + } + switch(var -> class) { case OBERON_CLASS_CONST: @@ -993,8 +992,10 @@ oberon_designator(oberon_context_t * ctx) case OBERON_CLASS_VAR: case OBERON_CLASS_VAR_PARAM: case OBERON_CLASS_PARAM: + expr = oberon_new_item(MODE_VAR, var -> type, read_only); + break; case OBERON_CLASS_PROC: - expr = oberon_new_item(MODE_VAR, var -> type); + expr = oberon_new_item(MODE_VAR, var -> type, 1); break; default: oberon_error(ctx, "invalid designator"); @@ -1098,17 +1099,17 @@ oberon_factor(oberon_context_t * ctx) expr = oberon_opt_func_parens(ctx, expr); break; case INTEGER: - expr = oberon_new_item(MODE_INTEGER, ctx -> int_type); + expr = oberon_new_item(MODE_INTEGER, ctx -> int_type, 1); expr -> item.integer = ctx -> integer; oberon_assert_token(ctx, INTEGER); break; case TRUE: - expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type); + expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, 1); expr -> item.boolean = 1; oberon_assert_token(ctx, TRUE); break; case FALSE: - expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type); + expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, 1); expr -> item.boolean = 0; oberon_assert_token(ctx, FALSE); break; @@ -1124,7 +1125,7 @@ oberon_factor(oberon_context_t * ctx) break; case NIL: oberon_assert_token(ctx, NIL); - expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type); + expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type, 1); break; default: oberon_error(ctx, "invalid expression"); @@ -2294,6 +2295,11 @@ oberon_decl_seq(oberon_context_t * ctx) static void oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst) { + if(dst -> read_only) + { + oberon_error(ctx, "read-only destination"); + } + oberon_autocast_to(ctx, src, dst -> result); oberon_generate_assign(ctx, src, dst); } @@ -2420,17 +2426,11 @@ oberon_parse_module(oberon_context_t * ctx) oberon_assert_token(ctx, SEMICOLON); ctx -> mod -> name = name1; - oberon_object_t * this_module; - this_module = oberon_define_object(ctx -> decl, name1, OBERON_CLASS_MODULE, 0, 0); - this_module -> module = ctx -> mod; - if(ctx -> token == IMPORT) { oberon_import_list(ctx); } - ctx -> decl -> parent = this_module; - oberon_decl_seq(ctx); oberon_generate_begin_module(ctx);