From 89dfaf94ddbbc501020554232ce026b6584e8045 Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Mon, 24 Jul 2017 22:55:59 +0300 Subject: [PATCH] =?utf8?q?=D0=98=D1=81=D0=BF=D1=80=D0=B0=D0=B2=D0=BB=D0=B5?= =?utf8?q?=D0=BD=20=D1=8D=D0=BA=D1=81=D0=BF=D0=BE=D1=80=D1=82=20=D0=BF?= =?utf8?q?=D0=BE=D0=BB=D0=B5=D0=B9=20=D0=B8=20=D1=8D=D0=BA=D1=81=D0=BF?= =?utf8?q?=D0=BE=D1=80=D1=82=20=D0=B4=D0=BB=D1=8F=20"=D1=82=D0=BE=D0=BB?= =?utf8?q?=D1=8C=D0=BA=D0=BE=20=D1=87=D1=82=D0=B5=D0=BD=D0=B8=D1=8F"?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- generator.c | 14 +++++--- notes | 2 -- oberon.c | 94 ++++++++++++++++++++++++++--------------------------- oberon.h | 5 +++ test.c | 14 +++++--- 5 files changed, 71 insertions(+), 58 deletions(-) diff --git a/generator.c b/generator.c index 991b6dd..ff4896d 100644 --- a/generator.c +++ b/generator.c @@ -161,25 +161,31 @@ oberon_generator_get_full_name(char * name, int max_len, oberon_object_t * x) return; } - char parent[256]; - parent[0] = 0; - + int add_module_prefix; switch(x -> class) { case OBERON_CLASS_FIELD: case OBERON_CLASS_PARAM: case OBERON_CLASS_VAR_PARAM: /* В локальных областях префиксы излишни */ + add_module_prefix = 0; break; default: - oberon_generator_get_full_name(parent, 256, x -> parent); + add_module_prefix = 1; break; } + char parent[256]; + oberon_generator_get_full_name(parent, 256, x -> parent); + if(strlen(parent) > 0) { snprintf(name, max_len, "%s_%s", parent, x -> name); } + else if(add_module_prefix) + { + snprintf(name, max_len, "%s_%s", x -> module -> name, x -> name); + } else { snprintf(name, max_len, "%s", x -> name); diff --git a/notes b/notes index 148c0b4..c1a8b0b 100644 --- a/notes +++ b/notes @@ -1,5 +1,3 @@ -- поля структур всегда доступны -- нету проверки экспорта для чтения - нету комментариев - нету тестовых процедур для ввода-вывода 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); diff --git a/oberon.h b/oberon.h index 86f95de..ef9ad7f 100644 --- a/oberon.h +++ b/oberon.h @@ -114,6 +114,8 @@ struct oberon_type_s oberon_type_t * base; oberon_object_t * decl; + oberon_module_t * module; + int recursive; int initialized; gen_type_t * gen_type; @@ -289,6 +291,7 @@ struct oberon_item_s int is_item; // == 1 oberon_type_t * result; oberon_expr_t * next; + int read_only; int mode; int integer; @@ -306,6 +309,7 @@ struct oberon_oper_s int is_item; // == 0 oberon_type_t * result; oberon_expr_t * next; + int read_only; int op; oberon_expr_t * left; @@ -318,6 +322,7 @@ union oberon_expr_u int is_item; oberon_type_t * result; oberon_expr_t * next; + int read_only; }; oberon_item_t item; diff --git a/test.c b/test.c index 4bef02c..541b3a5 100644 --- a/test.c +++ b/test.c @@ -10,25 +10,29 @@ static char source_test[] = "VAR" " x, y : I.Rider;" "PROCEDURE Proc(x, y, z : INTEGER);" - "END Proc;" "BEGIN" - " x.i := 1;" - " I.Ln;" - " I.i := 666;" + " x := 1;" + "END Proc;" + "BEGIN;" + " y.i := 1;" + " I.a[0] := 1;" "END Test." ; static char source_imported[] = "MODULE Imported;" "TYPE" - " Rider* = RECORD i, j, k : INTEGER; END;" + " Rider* = RECORD i*, j-, k : INTEGER; END;" "VAR" " i- : INTEGER;" + " a* : ARRAY 3 OF INTEGER;" "" "PROCEDURE Ln*;" "END Ln;" "" "BEGIN;" + " i := 1;" + " a[0] := 555;" "END Imported." ; -- 2.29.2