From 90882596d1b4b9ef59880c878118e4f9da49eede Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Tue, 1 Aug 2017 16:12:51 +0300 Subject: [PATCH] =?utf8?q?=D0=94=D0=BE=D0=B1=D0=B0=D0=B2=D0=BB=D0=B5=D0=BD?= =?utf8?q?=D0=BE=20=D1=80=D0=B0=D1=81=D1=88=D0=B8=D1=80=D0=B5=D0=BD=D0=B8?= =?utf8?q?=D0=B5=20=D1=82=D0=B8=D0=BF=D0=B0?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- notes | 10 +- src/backends/jvm/generator-jvm.c | 20 ++- src/backends/jvm/generator-jvm.h | 1 + src/oberon-internals.h | 1 + src/oberon.c | 218 ++++++++++++++++++------------- src/test.c | 27 ++-- 6 files changed, 159 insertions(+), 118 deletions(-) diff --git a/notes b/notes index 7092150..b580745 100644 --- a/notes +++ b/notes @@ -1,15 +1,11 @@ -- Какие-то проблемы с определением типов наперёд: - (* - TYPE - R2 = RECORD r : R1 END; - R1 = RECORD END; - *) +- Нет оператора IS +- Нет ручного каста записей +- Нет автокаста записей - Нужно изменить передачу информации о вызываемой процедуре в MODE_CALL На данный момент конкретная процедура передаётся в поле var, вместо parent Что не позволяет делать процедуры-переменные в полях записей, массивах и т.д. - нет символов и строк -- не реализовано расширение типа record - нету типа set - нету операторов if, while и т.д. diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c index 581faf9..d99d1da 100644 --- a/src/backends/jvm/generator-jvm.c +++ b/src/backends/jvm/generator-jvm.c @@ -827,7 +827,16 @@ oberon_generate_record_class(gen_module_t * m, oberon_type_t * rec) fprintf(class -> fp, ".source %s\n", rec -> module -> name); fprintf(class -> fp, ".class public %s\n", cname); - fprintf(class -> fp, ".super java/lang/Object\n\n"); + + if(rec -> base == NULL) + { + fprintf(class -> fp, ".super java/lang/Object\n\n"); + } + else + { + class -> base = rec -> base -> gen_type -> class; + fprintf(class -> fp, ".super %s\n\n", class -> base -> full_name); + } rec -> gen_type -> class = class; } @@ -887,7 +896,14 @@ oberon_generator_init_record(oberon_context_t * ctx, oberon_type_t * rec) jvm_generate_function_header(p, "public", "", "()V"); jvm_alloc_register_untyped(p -> rf, false); jvm_generate(p, 0, 1, "aload_0"); - jvm_generate(p, 1, 0, "invokespecial java/lang/Object/()V"); + if(class -> base) + { + jvm_generate(p, 1, 0, "invokespecial %s/()V", class -> base -> full_name); + } + else + { + jvm_generate(p, 1, 0, "invokespecial java/lang/Object/()V"); + } num = rec -> num_decl; field = rec -> decl; for(int i = 0; i < num; i++) diff --git a/src/backends/jvm/generator-jvm.h b/src/backends/jvm/generator-jvm.h index ad1b982..67abe23 100644 --- a/src/backends/jvm/generator-jvm.h +++ b/src/backends/jvm/generator-jvm.h @@ -22,6 +22,7 @@ struct gen_class char * full_name; FILE * fp; gen_proc_t * p; + struct gen_class * base; }; enum gen_storage diff --git a/src/oberon-internals.h b/src/oberon-internals.h index 5cfaa13..1e92de1 100644 --- a/src/oberon-internals.h +++ b/src/oberon-internals.h @@ -52,6 +52,7 @@ struct oberon_type_t int num_decl; oberon_type_t * base; oberon_object_t * decl; + oberon_scope_t * scope; oberon_module_t * module; diff --git a/src/oberon.c b/src/oberon.c index 6a74f92..0118ff9 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -146,36 +146,6 @@ oberon_close_scope(oberon_scope_t * scope) ctx -> decl = scope -> up; } -static oberon_object_t * -oberon_define_object(oberon_scope_t * scope, char * name, int class, int export, int read_only) -{ - oberon_object_t * x = scope -> list; - while(x -> next && strcmp(x -> next -> name, name) != 0) - { - x = x -> next; - } - - if(x -> next) - { - oberon_error(scope -> ctx, "already defined"); - } - - oberon_object_t * newvar = malloc(sizeof *newvar); - memset(newvar, 0, sizeof *newvar); - newvar -> name = name; - newvar -> class = class; - newvar -> export = export; - newvar -> read_only = read_only; - newvar -> local = scope -> local; - newvar -> parent = scope -> parent; - newvar -> parent_type = scope -> parent_type; - newvar -> module = scope -> ctx -> mod; - - x -> next = newvar; - - return newvar; -} - static oberon_object_t * oberon_find_object_in_list(oberon_object_t * list, char * name) { @@ -188,7 +158,7 @@ oberon_find_object_in_list(oberon_object_t * list, char * name) } static oberon_object_t * -oberon_find_object(oberon_scope_t * scope, char * name, int check_it) +oberon_find_object(oberon_scope_t * scope, char * name, bool check_it) { oberon_object_t * result = NULL; @@ -208,28 +178,48 @@ oberon_find_object(oberon_scope_t * scope, char * name, int check_it) } static oberon_object_t * -oberon_find_field(oberon_context_t * ctx, oberon_type_t * rec, char * name) +oberon_define_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only, bool check_upscope) { - oberon_object_t * x = rec -> decl; - for(int i = 0; i < rec -> num_decl; i++) + if(check_upscope) { - if(strcmp(x -> name, name) == 0) + if(oberon_find_object(scope -> up, name, false)) { - return x; + oberon_error(scope -> ctx, "already defined"); } + } + + oberon_object_t * x = scope -> list; + while(x -> next && strcmp(x -> next -> name, name) != 0) + { x = x -> next; } - oberon_error(ctx, "field not defined"); + if(x -> next) + { + oberon_error(scope -> ctx, "already defined"); + } + + oberon_object_t * newvar = malloc(sizeof *newvar); + memset(newvar, 0, sizeof *newvar); + newvar -> name = name; + newvar -> class = class; + newvar -> export = export; + newvar -> read_only = read_only; + newvar -> local = scope -> local; + newvar -> parent = scope -> parent; + newvar -> parent_type = scope -> parent_type; + newvar -> module = scope -> ctx -> mod; + + x -> next = newvar; - return NULL; + return newvar; } static oberon_object_t * oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type, int export) { oberon_object_t * id; - id = oberon_define_object(scope, name, OBERON_CLASS_TYPE, export, 0); + id = oberon_define_object(scope, name, OBERON_CLASS_TYPE, export, false, false); id -> type = type; oberon_generator_init_type(scope -> ctx, type); return id; @@ -1139,7 +1129,7 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * oberon_type_t * rec = expr -> result; oberon_object_t * field; - field = oberon_find_field(ctx, rec, name); + field = oberon_find_object(rec -> scope, name, true); if(field -> export == 0) { @@ -1697,7 +1687,7 @@ oberon_def(oberon_context_t * ctx, int * export, int * read_only) } static oberon_object_t * -oberon_ident_def(oberon_context_t * ctx, int class) +oberon_ident_def(oberon_context_t * ctx, int class, bool check_upscope) { char * name; int export; @@ -1707,19 +1697,19 @@ oberon_ident_def(oberon_context_t * ctx, int class) name = oberon_assert_ident(ctx); oberon_def(ctx, &export, &read_only); - x = oberon_define_object(ctx -> decl, name, class, export, read_only); + x = oberon_define_object(ctx -> decl, name, class, export, read_only, check_upscope); return x; } static void -oberon_ident_list(oberon_context_t * ctx, int class, int * num, oberon_object_t ** list) +oberon_ident_list(oberon_context_t * ctx, int class, bool check_upscope, int * num, oberon_object_t ** list) { *num = 1; - *list = oberon_ident_def(ctx, class); + *list = oberon_ident_def(ctx, class, check_upscope); while(ctx -> token == COMMA) { oberon_assert_token(ctx, COMMA); - oberon_ident_def(ctx, class); + oberon_ident_def(ctx, class, check_upscope); *num += 1; } } @@ -1732,7 +1722,7 @@ oberon_var_decl(oberon_context_t * ctx) oberon_type_t * type; type = oberon_new_type_ptr(OBERON_TYPE_VOID); - oberon_ident_list(ctx, OBERON_CLASS_VAR, &num, &list); + oberon_ident_list(ctx, OBERON_CLASS_VAR, false, &num, &list); oberon_assert_token(ctx, COLON); oberon_type(ctx, &type); @@ -1756,7 +1746,7 @@ oberon_fp_section(oberon_context_t * ctx, int * num_decl) int num; oberon_object_t * list; - oberon_ident_list(ctx, class, &num, &list); + oberon_ident_list(ctx, class, false, &num, &list); oberon_assert_token(ctx, COLON); @@ -1976,7 +1966,7 @@ oberon_proc_decl(oberon_context_t * ctx) } else { - proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, export, read_only); + proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, export, read_only, false); proc -> type = signature; proc -> scope = proc_scope; oberon_generator_init_proc(ctx, proc); @@ -1997,7 +1987,7 @@ oberon_const_decl(oberon_context_t * ctx) oberon_item_t * value; oberon_object_t * constant; - constant = oberon_ident_def(ctx, OBERON_CLASS_CONST); + constant = oberon_ident_def(ctx, OBERON_CLASS_CONST, false); oberon_assert_token(ctx, EQUAL); value = oberon_const_expr(ctx); constant -> value = value; @@ -2023,31 +2013,6 @@ oberon_make_array_type(oberon_context_t * ctx, oberon_expr_t * size, oberon_type arr -> base = base; } -static void -oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec) -{ - if(ctx -> token == IDENT) - { - int num; - oberon_object_t * list; - oberon_type_t * type; - type = oberon_new_type_ptr(OBERON_TYPE_VOID); - - oberon_ident_list(ctx, OBERON_CLASS_FIELD, &num, &list); - oberon_assert_token(ctx, COLON); - oberon_type(ctx, &type); - - oberon_object_t * field = list; - for(int i = 0; i < num; i++) - { - field -> type = type; - field = field -> next; - } - - rec -> num_decl += num; - } -} - static void oberon_qualident_type(oberon_context_t * ctx, oberon_type_t ** type) { @@ -2068,7 +2033,7 @@ oberon_qualident_type(oberon_context_t * ctx, oberon_type_t ** type) } else { - to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, 0, 0); + to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, false, false, false); to -> type = oberon_new_type_ptr(OBERON_TYPE_VOID); } @@ -2106,6 +2071,87 @@ oberon_make_open_array(oberon_context_t * ctx, oberon_type_t * base, oberon_type type -> base = base; } +static void +oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec, oberon_scope_t * modscope) +{ + if(ctx -> token == IDENT) + { + int num; + oberon_object_t * list; + oberon_type_t * type; + type = oberon_new_type_ptr(OBERON_TYPE_VOID); + + oberon_ident_list(ctx, OBERON_CLASS_FIELD, true, &num, &list); + oberon_assert_token(ctx, COLON); + + oberon_scope_t * current = ctx -> decl; + ctx -> decl = modscope; + oberon_type(ctx, &type); + ctx -> decl = current; + + oberon_object_t * field = list; + for(int i = 0; i < num; i++) + { + field -> type = type; + field = field -> next; + } + + rec -> num_decl += num; + } +} + +static void +oberon_type_record_body(oberon_context_t * ctx, oberon_type_t * rec) +{ + oberon_scope_t * modscope = ctx -> mod -> decl; + oberon_scope_t * oldscope = ctx -> decl; + ctx -> decl = modscope; + + if(ctx -> token == LPAREN) + { + oberon_assert_token(ctx, LPAREN); + + oberon_object_t * typeobj; + typeobj = oberon_qualident(ctx, NULL, true); + + if(typeobj -> class != OBERON_CLASS_TYPE) + { + oberon_error(ctx, "base must be type"); + } + + if(typeobj -> type -> class != OBERON_TYPE_RECORD) + { + oberon_error(ctx, "base must be record type"); + } + + rec -> base = typeobj -> type; + ctx -> decl = rec -> base -> scope; + + oberon_assert_token(ctx, RPAREN); + } + else + { + ctx -> decl = NULL; + } + + oberon_scope_t * this_scope; + this_scope = oberon_open_scope(ctx); + this_scope -> local = true; + this_scope -> parent = NULL; + this_scope -> parent_type = rec; + + oberon_field_list(ctx, rec, modscope); + while(ctx -> token == SEMICOLON) + { + oberon_assert_token(ctx, SEMICOLON); + oberon_field_list(ctx, rec, modscope); + } + + rec -> scope = this_scope; + rec -> decl = this_scope -> list -> next; + ctx -> decl = oldscope; +} + static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type) { @@ -2147,24 +2193,10 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type) rec -> class = OBERON_TYPE_RECORD; rec -> module = ctx -> mod; - oberon_scope_t * record_scope; - record_scope = oberon_open_scope(ctx); - record_scope -> local = 1; - record_scope -> parent = NULL; - record_scope -> parent_type = rec; - oberon_assert_token(ctx, RECORD); - oberon_field_list(ctx, rec); - while(ctx -> token == SEMICOLON) - { - oberon_assert_token(ctx, SEMICOLON); - oberon_field_list(ctx, rec); - } + oberon_type_record_body(ctx, rec); oberon_assert_token(ctx, END); - rec -> decl = record_scope -> list -> next; - oberon_close_scope(record_scope); - *type = rec; } else if(ctx -> token == POINTER) @@ -2209,7 +2241,7 @@ oberon_type_decl(oberon_context_t * ctx) newtype = oberon_find_object(ctx -> decl, name, 0); if(newtype == NULL) { - newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, export, read_only); + newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, export, read_only, false); newtype -> type = oberon_new_type_ptr(OBERON_TYPE_VOID); assert(newtype -> type); } @@ -2689,7 +2721,7 @@ oberon_import_module(oberon_context_t * ctx, char * alias, char * name) } oberon_object_t * ident; - ident = oberon_define_object(ctx -> decl, alias, OBERON_CLASS_MODULE, 0, 0); + ident = oberon_define_object(ctx -> decl, alias, OBERON_CLASS_MODULE, false, false, false); ident -> module = m; } @@ -2805,7 +2837,7 @@ static void oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f, GenerateProcCallback p) { oberon_object_t * proc; - proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, 1, 0); + proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, true, false, false); proc -> sysproc = 1; proc -> genfunc = f; proc -> genproc = p; diff --git a/src/test.c b/src/test.c index 9fad93d..6a08bce 100644 --- a/src/test.c +++ b/src/test.c @@ -8,26 +8,21 @@ static char source_test[] = "(* Main module *)" "MODULE Test;" "IMPORT Out;" + "TYPE" + " Baser = RECORD a : INTEGER; END;" + " R1 = RECORD (Baser)" + " b : R2;" + " END;" + " " + " R2 = RECORD" + " a : POINTER TO R1;" + " END;" "" "VAR" - " byte : BYTE;" - " short : SHORTINT;" - " int : INTEGER;" - " long : LONGINT;" - " real : REAL;" - " longreal : LONGREAL;" + " r : R1;" "" "BEGIN" - " Out.Open;" - " byte := 127;" - " int := 666 DIV 2;" - " long := int;" - " real := (4 / 1) - (4 / 3) + (4 / 5) - (4 / 7) + (4 / 9) - (4 / 11) + (4 / 13) - (4 / 15) + (4 / 17);" - " longreal := (4 / 1) - (4 / 3) + (4 / 5) - (4 / 7) + (4 / 9) - (4 / 11) + (4 / 13) - (4 / 15) + (4 / 17);" - " Out.Int(666, 0); Out.Ln;" - " Out.Int(byte, 0); Out.Ln;" - " Out.Real(real, 0); Out.Ln;" - " Out.LongReal(longreal, 0); Out.Ln;" + " r.a := 1;" "END Test." ; -- 2.29.2