From 3376c57aa304940b405940c6463df71c7c1c7f01 Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Mon, 24 Jul 2017 22:27:59 +0300 Subject: [PATCH] =?utf8?q?=D0=A0=D0=B5=D0=B0=D0=BB=D0=B8=D0=B7=D0=BE=D0=B2?= =?utf8?q?=D0=B0=D0=BD=D1=8B=20=D0=BD=D0=B5=D1=8F=D0=B2=D0=BD=D1=8B=D0=B5?= =?utf8?q?=20=D0=BE=D0=B1=D1=8A=D1=8F=D0=B2=D0=BB=D0=B5=D0=BD=D0=B8=D1=8F?= =?utf8?q?=20=D1=82=D0=B8=D0=BF=D0=BE=D0=B2=20=D0=BD=D0=B0=D0=BF=D0=B5?= =?utf8?q?=D1=80=D1=91=D0=B4?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- generator.c | 41 ++-- generator.h | 1 + notes | 1 - oberon.c | 629 +++++++++++++++++++++++++++++++++++++------------- oberon.h | 3 + test.c | 16 +- test/Test | Bin 0 -> 10496 bytes test/Test.Mod | 6 + test/Test.c | 32 +++ test/make.sh | 5 + 10 files changed, 551 insertions(+), 183 deletions(-) create mode 100755 test/Test create mode 100644 test/Test.Mod create mode 100644 test/Test.c create mode 100755 test/make.sh diff --git a/generator.c b/generator.c index f65b066..a802a96 100644 --- a/generator.c +++ b/generator.c @@ -93,20 +93,7 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type) } else if(type -> class == OBERON_TYPE_RECORD) { - // TODO type exstension - - int num_fields = type -> num_decl; - gcc_jit_field * fields[num_fields]; - oberon_object_t * o = type -> decl; - for(int i = 0; i < num_fields; i++) - { - assert(o -> class == OBERON_CLASS_FIELD); - gen_var_t * var = o -> gen_var; - fields[i] = var -> gcc_field; - o = o -> next; - } - - gcc_struct = gcc_jit_context_new_struct_type(gcc_context, NULL, "", num_fields, fields); + gcc_struct = gcc_jit_context_new_opaque_struct(gcc_context, NULL, ""); gcc_type = gcc_jit_struct_as_type(gcc_struct); } else if(type -> class == OBERON_TYPE_POINTER) @@ -144,6 +131,32 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type) gen_type -> gcc_struct = gcc_struct; } +void +oberon_generator_init_record(oberon_context_t * ctx, oberon_type_t * type) +{ + assert(type -> class == OBERON_TYPE_RECORD); + + gen_type_t * gen_type = type -> gen_type; + gcc_jit_struct * gcc_struct = gen_type -> gcc_struct; + + // TODO type exstension + + int num_fields = type -> num_decl; + gcc_jit_field * fields[num_fields]; + oberon_object_t * o = type -> decl; + for(int i = 0; i < num_fields; i++) + { + assert(o -> class == OBERON_CLASS_FIELD); + gen_var_t * var = o -> gen_var; + fields[i] = var -> gcc_field; + o = o -> next; + } + + gcc_jit_struct_set_fields (gcc_struct, NULL, num_fields, fields); + + //gcc_struct = gcc_jit_context_new_struct_type(gcc_context, NULL, "", num_fields, fields); +} + void oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var) { diff --git a/generator.h b/generator.h index 2957aa8..085c2ca 100644 --- a/generator.h +++ b/generator.h @@ -4,6 +4,7 @@ void oberon_generator_init_context(oberon_context_t * ctx); void oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type); +void oberon_generator_init_record(oberon_context_t * ctx, oberon_type_t * type); void oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var); void oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc); void oberon_generator_destroy_context(oberon_context_t * ctx); diff --git a/notes b/notes index 0be804b..d895de7 100644 --- a/notes +++ b/notes @@ -1,6 +1,5 @@ - нету процедуры NEW - не реализовано расширение типа record -- не реализовано преждевременное объявление типа - не реализованы многомерные массивы - не реализованы локальные объявления в процедурах diff --git a/oberon.c b/oberon.c index 7ca600e..847e9c7 100644 --- a/oberon.c +++ b/oberon.c @@ -172,8 +172,6 @@ oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char * name, o field -> type = type; rec -> num_decl += 1; - oberon_generator_init_var(ctx, field); - x -> next = field; } @@ -189,7 +187,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) +oberon_find_object(oberon_scope_t * scope, char * name, int check_it) { oberon_object_t * result = NULL; @@ -200,7 +198,7 @@ oberon_find_object(oberon_scope_t * scope, char * name) s = s -> up; } - if(result == NULL) + if(check_it && result == NULL) { oberon_error(scope -> ctx, "undefined ident %s", name); } @@ -236,6 +234,7 @@ oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type) return id; } +/* static oberon_type_t * oberon_find_type(oberon_scope_t * scope, char * name) { @@ -247,6 +246,7 @@ oberon_find_type(oberon_scope_t * scope, char * name) return x -> type; } +*/ static oberon_object_t * oberon_define_var(oberon_scope_t * scope, int class, char * name, oberon_type_t * type) @@ -254,7 +254,6 @@ oberon_define_var(oberon_scope_t * scope, int class, char * name, oberon_type_t oberon_object_t * var; var = oberon_define_object(scope, name, class); var -> type = type; - oberon_generator_init_var(scope -> ctx, var); return var; } @@ -279,7 +278,6 @@ oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signatur oberon_object_t * proc; proc = oberon_define_object(scope, name, OBERON_CLASS_PROC); proc -> type = signature; - oberon_generator_init_proc(scope -> ctx, proc); return proc; } @@ -563,7 +561,7 @@ static void oberon_expect_token(oberon_context_t * ctx, int token); 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 oberon_type_t * oberon_type(oberon_context_t * ctx); +static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type); static oberon_expr_t * oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right) @@ -809,7 +807,7 @@ oberon_designator(oberon_context_t * ctx) oberon_expr_t * expr; name = oberon_assert_ident(ctx); - var = oberon_find_object(ctx -> decl, name); + var = oberon_find_object(ctx -> decl, name, 1); switch(var -> class) { @@ -1203,132 +1201,16 @@ oberon_assert_ident(oberon_context_t * ctx) return ident; } -static oberon_type_t * -oberon_make_array_type(oberon_context_t * ctx, int dim, oberon_item_t * size, oberon_type_t * base) -{ - assert(dim == 1); - oberon_type_t * newtype; - - if(size -> mode != MODE_INTEGER) - { - oberon_error(ctx, "requires integer constant"); - } - - newtype = oberon_new_type_ptr(OBERON_TYPE_ARRAY); - newtype -> dim = dim; - newtype -> size = size -> integer; - newtype -> base = base; - oberon_generator_init_type(ctx, newtype); - - return newtype; -} - static void -oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec) -{ - if(ctx -> token == IDENT) - { - char * name; - oberon_type_t * type; - name = oberon_assert_ident(ctx); - oberon_assert_token(ctx, COLON); - type = oberon_type(ctx); - oberon_define_field(ctx, rec, name, type); - } -} - -static oberon_type_t * -oberon_make_pointer(oberon_context_t * ctx, oberon_type_t * type) -{ - if(type -> class == OBERON_TYPE_POINTER) - { - return type; - } - - if(type -> class == OBERON_TYPE_INTEGER - || type -> class == OBERON_TYPE_BOOLEAN - || type -> class == OBERON_TYPE_PROCEDURE - || type -> class == OBERON_TYPE_VOID) - { - oberon_error(ctx, "oberon not support pointers to non structure types"); - } - - oberon_type_t * newtype; - newtype = oberon_new_type_ptr(OBERON_TYPE_POINTER); - newtype -> base = type; - - oberon_generator_init_type(ctx, newtype); - - return newtype; -} - -static oberon_type_t * oberon_opt_formal_pars(oberon_context_t * ctx, int class); - -static oberon_type_t * -oberon_type(oberon_context_t * ctx) +oberon_var_decl(oberon_context_t * ctx) { + char * name; oberon_type_t * type; + type = oberon_new_type_ptr(OBERON_TYPE_VOID); - if(ctx -> token == IDENT) - { - char * name = oberon_assert_ident(ctx); - type = oberon_find_type(ctx -> decl, name); - } - else if(ctx -> token == ARRAY) - { - oberon_assert_token(ctx, ARRAY); - oberon_item_t * size = oberon_const_expr(ctx); - oberon_assert_token(ctx, OF); - oberon_type_t * base = oberon_type(ctx); - type = oberon_make_array_type(ctx, 1, size, base); - } - else if(ctx -> token == RECORD) - { - type = oberon_new_type_ptr(OBERON_TYPE_RECORD); - oberon_object_t * list = malloc(sizeof *list); - memset(list, 0, sizeof *list); - type -> num_decl = 0; - type -> base = NULL; - type -> decl = list; - - oberon_assert_token(ctx, RECORD); - oberon_field_list(ctx, type); - while(ctx -> token == SEMICOLON) - { - oberon_assert_token(ctx, SEMICOLON); - oberon_field_list(ctx, type); - } - oberon_assert_token(ctx, END); - - type -> decl = type -> decl -> next; - oberon_generator_init_type(ctx, type); - } - else if(ctx -> token == POINTER) - { - oberon_assert_token(ctx, POINTER); - oberon_assert_token(ctx, TO); - type = oberon_type(ctx); - type = oberon_make_pointer(ctx, type); - } - else if(ctx -> token == PROCEDURE) - { - oberon_assert_token(ctx, PROCEDURE); - type = oberon_opt_formal_pars(ctx, OBERON_TYPE_PROCEDURE); - } - else - { - oberon_error(ctx, "invalid type declaration"); - } - - return type; -} - -static void -oberon_var_decl(oberon_context_t * ctx) -{ - char * name = oberon_assert_ident(ctx); + name = oberon_assert_ident(ctx); oberon_assert_token(ctx, COLON); - oberon_type_t * type = oberon_type(ctx); + oberon_type(ctx, &type); oberon_define_var(ctx -> decl, OBERON_CLASS_VAR, name, type); } @@ -1368,7 +1250,8 @@ oberon_fp_section(oberon_context_t * ctx, int * num_decl) oberon_assert_token(ctx, COLON); oberon_type_t * type; - type = oberon_type(ctx); + type = oberon_new_type_ptr(OBERON_TYPE_VOID); + oberon_type(ctx, &type); oberon_object_t * first; first = oberon_make_param(ctx, modifer_token, name, type); @@ -1380,24 +1263,18 @@ oberon_fp_section(oberon_context_t * ctx, int * num_decl) #define ISFPSECTION \ ((ctx -> token == VAR) || (ctx -> token == IDENT)) -static oberon_type_t * -oberon_formal_pars(oberon_context_t * ctx) +static void +oberon_formal_pars(oberon_context_t * ctx, oberon_type_t * signature) { - oberon_type_t * tp; - tp = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE); - tp -> num_decl = 0; - tp -> base = ctx -> void_type; - tp -> decl = NULL; - oberon_assert_token(ctx, LPAREN); if(ISFPSECTION) { - tp -> decl = oberon_fp_section(ctx, &tp -> num_decl); + signature -> decl = oberon_fp_section(ctx, &signature -> num_decl); while(ctx -> token == SEMICOLON) { oberon_assert_token(ctx, SEMICOLON); - oberon_fp_section(ctx, &tp -> num_decl); + oberon_fp_section(ctx, &signature -> num_decl); } } @@ -1406,32 +1283,24 @@ oberon_formal_pars(oberon_context_t * ctx) if(ctx -> token == COLON) { oberon_assert_token(ctx, COLON); - tp -> base = oberon_type(ctx); + oberon_type(ctx, &signature -> base); } - - oberon_generator_init_type(ctx, tp); - return tp; } -static oberon_type_t * -oberon_opt_formal_pars(oberon_context_t * ctx, int class) +static void +oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type) { oberon_type_t * signature; + signature = *type; + signature -> class = OBERON_TYPE_PROCEDURE; + signature -> num_decl = 0; + signature -> base = ctx -> void_type; + signature -> decl = NULL; if(ctx -> token == LPAREN) { - signature = oberon_formal_pars(ctx); - } - else - { - signature = oberon_new_type_ptr(class); - signature -> num_decl = 0; - signature -> base = ctx -> void_type; - signature -> decl = NULL; - oberon_generator_init_type(ctx, signature); + oberon_formal_pars(ctx, signature); } - - return signature; } static void @@ -1471,7 +1340,8 @@ oberon_proc_decl(oberon_context_t * ctx) oberon_open_scope(ctx); oberon_type_t * signature; - signature = oberon_opt_formal_pars(ctx, OBERON_TYPE_PROCEDURE); + signature = oberon_new_type_ptr(OBERON_TYPE_VOID); + oberon_opt_formal_pars(ctx, &signature); oberon_object_t * proc; proc = oberon_define_proc(this_proc_def_scope, name, signature); @@ -1528,6 +1398,140 @@ oberon_const_decl(oberon_context_t * ctx) constant -> value = value; } +static void +oberon_make_array_type(oberon_context_t * ctx, int dim, oberon_item_t * size, oberon_type_t * base, oberon_type_t ** type) +{ + assert(dim == 1); + if(size -> mode != MODE_INTEGER) + { + oberon_error(ctx, "requires integer constant"); + } + + oberon_type_t * arr; + arr = *type; + arr -> class = OBERON_TYPE_ARRAY; + arr -> dim = dim; + arr -> size = size -> integer; + arr -> base = base; +} + +static void +oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec) +{ + if(ctx -> token == IDENT) + { + char * name; + oberon_type_t * type; + type = oberon_new_type_ptr(OBERON_TYPE_VOID); + + name = oberon_assert_ident(ctx); + oberon_assert_token(ctx, COLON); + oberon_type(ctx, &type); + oberon_define_field(ctx, rec, name, type); + } +} + +static void +oberon_qualident_type(oberon_context_t * ctx, oberon_type_t ** type) +{ + char * name; + oberon_object_t * to; + + name = oberon_assert_ident(ctx); + to = oberon_find_object(ctx -> decl, name, 0); + + if(to != NULL) + { + if(to -> class != OBERON_CLASS_TYPE) + { + oberon_error(ctx, "not a type"); + } + } + else + { + to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE); + to -> type = oberon_new_type_ptr(OBERON_TYPE_VOID); + } + + *type = to -> type; +} + +static void oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type); + +/* + * Правило граматики "type". Указатель type должен указывать на существующий объект! + */ + +static void +oberon_type(oberon_context_t * ctx, oberon_type_t ** type) +{ + if(ctx -> token == IDENT) + { + oberon_qualident_type(ctx, type); + } + else if(ctx -> token == ARRAY) + { + oberon_assert_token(ctx, ARRAY); + + oberon_item_t * size; + size = oberon_const_expr(ctx); + + oberon_assert_token(ctx, OF); + + oberon_type_t * base; + base = oberon_new_type_ptr(OBERON_TYPE_VOID); + oberon_type(ctx, &base); + + oberon_make_array_type(ctx, 1, size, base, type); + } + else if(ctx -> token == RECORD) + { + oberon_type_t * rec; + rec = *type; + rec -> class = OBERON_TYPE_RECORD; + oberon_object_t * list = malloc(sizeof *list); + memset(list, 0, sizeof *list); + rec -> num_decl = 0; + rec -> base = NULL; + rec -> decl = list; + + 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_assert_token(ctx, END); + + rec -> decl = rec -> decl -> next; + *type = rec; + } + else if(ctx -> token == POINTER) + { + oberon_assert_token(ctx, POINTER); + oberon_assert_token(ctx, TO); + + oberon_type_t * base; + base = oberon_new_type_ptr(OBERON_TYPE_VOID); + oberon_type(ctx, &base); + + oberon_type_t * ptr; + ptr = *type; + ptr -> class = OBERON_TYPE_POINTER; + ptr -> base = base; + } + else if(ctx -> token == PROCEDURE) + { + oberon_assert_token(ctx, PROCEDURE); + oberon_opt_formal_pars(ctx, type); + } + else + { + oberon_error(ctx, "invalid type declaration"); + } +} + static void oberon_type_decl(oberon_context_t * ctx) { @@ -1536,11 +1540,313 @@ oberon_type_decl(oberon_context_t * ctx) oberon_type_t * type; name = oberon_assert_ident(ctx); + + newtype = oberon_find_object(ctx -> decl, name, 0); + if(newtype == NULL) + { + newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE); + newtype -> type = oberon_new_type_ptr(OBERON_TYPE_VOID); + assert(newtype -> type); + } + else + { + if(newtype -> class != OBERON_CLASS_TYPE) + { + oberon_error(ctx, "mult definition"); + } + + if(newtype -> linked) + { + oberon_error(ctx, "mult definition - already linked"); + } + } + oberon_assert_token(ctx, EQUAL); - type = oberon_type(ctx); - newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE); + type = newtype -> type; + oberon_type(ctx, &type); + + if(type -> class == OBERON_TYPE_VOID) + { + oberon_error(ctx, "recursive alias declaration"); + } + newtype -> type = type; + newtype -> linked = 1; +} + +static void oberon_prevent_recursive_object(oberon_context_t * ctx, oberon_object_t * x); +static void oberon_prevent_recursive_type(oberon_context_t * ctx, oberon_type_t * type); + +static void +oberon_prevent_recursive_pointer(oberon_context_t * ctx, oberon_type_t * type) +{ + if(type -> class != OBERON_TYPE_POINTER + && type -> class != OBERON_TYPE_ARRAY) + { + return; + } + + if(type -> recursive) + { + oberon_error(ctx, "recursive pointer declaration"); + } + + if(type -> base -> class == OBERON_TYPE_POINTER) + { + oberon_error(ctx, "attempt to make pointer to pointer"); + } + + type -> recursive = 1; + + oberon_prevent_recursive_pointer(ctx, type -> base); + + type -> recursive = 0; +} + +static void +oberon_prevent_recursive_record(oberon_context_t * ctx, oberon_type_t * type) +{ + if(type -> class != OBERON_TYPE_RECORD) + { + return; + } + + if(type -> recursive) + { + oberon_error(ctx, "recursive record declaration"); + } + + type -> recursive = 1; + + int num_fields = type -> num_decl; + oberon_object_t * field = type -> decl; + for(int i = 0; i < num_fields; i++) + { + oberon_prevent_recursive_object(ctx, field); + field = field -> next; + } + + type -> recursive = 0; +} +static void +oberon_prevent_recursive_procedure(oberon_context_t * ctx, oberon_type_t * type) +{ + if(type -> class != OBERON_TYPE_PROCEDURE) + { + return; + } + + if(type -> recursive) + { + oberon_error(ctx, "recursive procedure declaration"); + } + + type -> recursive = 1; + + int num_fields = type -> num_decl; + oberon_object_t * field = type -> decl; + for(int i = 0; i < num_fields; i++) + { + oberon_prevent_recursive_object(ctx, field); + field = field -> next; + } + + type -> recursive = 0; +} + +static void +oberon_prevent_recursive_array(oberon_context_t * ctx, oberon_type_t * type) +{ + if(type -> class != OBERON_TYPE_ARRAY) + { + return; + } + + if(type -> recursive) + { + oberon_error(ctx, "recursive array declaration"); + } + + type -> recursive = 1; + + oberon_prevent_recursive_type(ctx, type -> base); + + type -> recursive = 0; +} + +static void +oberon_prevent_recursive_type(oberon_context_t * ctx, oberon_type_t * type) +{ + if(type -> class == OBERON_TYPE_POINTER) + { + oberon_prevent_recursive_pointer(ctx, type); + } + else if(type -> class == OBERON_TYPE_RECORD) + { + oberon_prevent_recursive_record(ctx, type); + } + else if(type -> class == OBERON_TYPE_ARRAY) + { + oberon_prevent_recursive_array(ctx, type); + } + else if(type -> class == OBERON_TYPE_PROCEDURE) + { + oberon_prevent_recursive_procedure(ctx, type); + } +} + +static void +oberon_prevent_recursive_object(oberon_context_t * ctx, oberon_object_t * x) +{ + switch(x -> class) + { + case OBERON_CLASS_VAR: + case OBERON_CLASS_TYPE: + case OBERON_CLASS_PARAM: + case OBERON_CLASS_VAR_PARAM: + case OBERON_CLASS_FIELD: + oberon_prevent_recursive_type(ctx, x -> type); + break; + case OBERON_CLASS_CONST: + case OBERON_CLASS_PROC: + break; + default: + oberon_error(ctx, "oberon_prevent_recursive_object: wat"); + break; + } +} + +static void +oberon_prevent_recursive_decl(oberon_context_t * ctx) +{ + oberon_object_t * x = ctx -> decl -> list -> next; + + while(x) + { + oberon_prevent_recursive_object(ctx, x); + x = x -> next; + } +} + +static void oberon_initialize_object(oberon_context_t * ctx, oberon_object_t * x); +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; + } + + 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; + } + + oberon_generator_init_record(ctx, type); +} + +static void +oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type) +{ + if(type -> class == OBERON_TYPE_VOID) + { + oberon_error(ctx, "undeclarated type"); + } + + if(type -> initialized) + { + return; + } + + type -> initialized = 1; + + 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); + } + } + else if(type -> class == OBERON_TYPE_ARRAY) + { + oberon_generator_init_type(ctx, type); + oberon_initialize_type(ctx, type -> base); + } + else if(type -> class == OBERON_TYPE_RECORD) + { + oberon_generator_init_type(ctx, type); + oberon_initialize_record_fields(ctx, type); + } + else if(type -> class == OBERON_TYPE_PROCEDURE) + { + 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); + field = field -> next; + } + + oberon_generator_init_type(ctx, type); + } + else + { + oberon_generator_init_type(ctx, 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); + switch(x -> class) + { + case OBERON_CLASS_TYPE: + oberon_initialize_type(ctx, x -> type); + break; + case OBERON_CLASS_VAR: + case OBERON_CLASS_PARAM: + case OBERON_CLASS_VAR_PARAM: + case OBERON_CLASS_FIELD: + oberon_initialize_type(ctx, x -> type); + oberon_generator_init_var(ctx, x); + break; + case OBERON_CLASS_CONST: + case OBERON_CLASS_PROC: + break; + default: + oberon_error(ctx, "oberon_prevent_recursive_object: wat"); + break; + } +} + +static void +oberon_initialize_decl(oberon_context_t * ctx) +{ + oberon_object_t * x = ctx -> decl -> list; + + while(x -> next) + { + oberon_initialize_object(ctx, x -> next); + x = x -> next; + } } static void @@ -1576,6 +1882,9 @@ oberon_decl_seq(oberon_context_t * ctx) } } + oberon_prevent_recursive_decl(ctx); + oberon_initialize_decl(ctx); + while(ctx -> token == PROCEDURE) { oberon_proc_decl(ctx); diff --git a/oberon.h b/oberon.h index 16044d4..41cec62 100644 --- a/oberon.h +++ b/oberon.h @@ -104,6 +104,8 @@ struct oberon_type_s oberon_type_t * base; oberon_object_t * decl; + int recursive; + int initialized; gen_type_t * gen_type; }; @@ -142,6 +144,7 @@ struct oberon_object_s char * name; int class; + int linked; oberon_type_t * type; oberon_item_t * value; oberon_object_t * next; diff --git a/test.c b/test.c index 8f3edc4..960bef8 100644 --- a/test.c +++ b/test.c @@ -4,19 +4,19 @@ static const char source[] = "MODULE Test;" - "" "TYPE" - " MyInt = INTEGER;" - " MyRec = POINTER TO RECORD" - " a : MyInt;" - " next : MyRec;" - " END;" + " MyArr = ARRAY 3 OF INTEGER;" + " MyArrPtr = POINTER TO MyArr;" + " MyRec = POINTER TO MyRecDesc;" + " MyRecDesc = RECORD next : POINTER TO MyRecDesc END;" "" "VAR" - " r : MyRec;" + " a : MyArr;" + " b : MyArrPtr;" + " c : MyRec;" + " d : MyRecDesc;" "" "BEGIN" - " " "END Test." ; diff --git a/test/Test b/test/Test new file mode 100755 index 0000000000000000000000000000000000000000..2c0d9836ae6b2a1da66ff6035c51c769e557a57c GIT binary patch literal 10496 zcmeHNeQ;b=6~FIoHrZ{O%{FOC%7Q;Nl59Ax}}89x|@KllS398}VYQkh|xI!f&bY80v|P#aK~ij?>}_uaGE zec6olAICp9?cQ_F@1AqN-hKC-dvEUQ?OU&Fnqbn!je@j+>WGA#RET{csVb~f_(eoq zA}$uyK)m=xWDaphVtz&y&D^K#Jm6LMb?Oe#sYj&1{6Ys7%(;ccslGXiDAD1+@jEJW zAwm)$KWeK8NELj*5ftA+4FZiT&VJN9@(U`zpt5H^r5eVZ`$v7FU%%>KzaD``dW4wh zk?9;KTcRx|>;%bAsDhsGMF@uO@HJ8sf;s!$3_saFmH(euP#J7h^({0mLbac{>aJ)_ zB?mj!w5Ad*sbo68r)5uPM@z?=a4r*Wm;I*l$#%o0?Xo5w#}G7X^HTh1s40JH|I%Hr zeCqVJ$yB??JpPL%dvAL7hm=Q;lAqg`CqkO2iuehu#jg&(uHKj4eCE}!-g*3UJ1+e3 z!M6f${Q5LMUF4S2MNk{cA*roe0N=R)zHb5ivkTzVpb&m;x*0&F_S~=l{#D>X(Ij>( z8GtlL--Q?y&0^eze_i2j`>TLAU<8kQBar6k6A&9P2_91OteAu6ygM`0vbi14R+#3< zSSD@e?0D8TO|dbP$fvBFX~a{uFq7$|EetC@Zf@<}(0}U|vF+Av{k}kCY~0*a^p6!i*T*(R`}zbb9iq9^ff`9xHIBuTX<=H4xE)8vU@qt2fYJ%Ep)c0e zZMKKo!&es@&y$zt5&v^CN!tyP--G=5NlYzW{6P86)DK9B-YI^^2sl%Mm%eY!!2!w^ zHTdy6LVBnKpKFZ}D@*X=k^}oyC3xvN*I9y79ZZoDoYx-8GxopfGY)u{EeZ+a-U(Zu zJ!sLe|kv>W;C#PmXmn|Zlx^VKS)OFIS=_ed5^Cp45bVEi?ak<)$Tw{_3MZz&h!#KRT?a(lIVsEkJ6J>vhwE3| zLk&Syg%dm9C=kOC2Mb?#-zel~jDy=}4)j7iRyZ>K{0FnMKO*^Xf|OV3XpiheSBORVtQ z==NxT-@(gX^oB432V015ix$qt3h(w^Ndw_C4xjZ*f9Wi0xc8JDYI~W-tFQ20U*X-J z!s+Pj(pQZAlbUhu@AI$IT>SLT=x3rkqr0N!uJ5F$<>3Z?gW1dybt^U+WZ}G8>91c@Ylc>WAN!aL!{lYRcL#H+69Yie227}AmJ2S z48Z?mWT2?By%3iopX?{zpPd~i+dy!Ap!ufy+S`5m#JcmZziRcRmk>-gJ^1|*WOCrvH=Y!b{=@07>V#U2)sLIhf z<~pi7`Xbm6{m5Z*Z$M(R(w8aDtQc#lxQW-!L&|{He~z)56mF<^nek?&bGzxgL`3@& zBCa3Hv+U0q)qZ@Iq|W0zqx54c-|_z6rM!=I*H~R0k+*8 z+d{9Zxs5R08$iCU*X$uptEM^bX&|}dE{XWUgq$L|&!)7hiq;3+SM?h(uMa-gK&YNV zqBZ^$soz79FHwze4N~9bsNuNQWPth40&qmJ$c~RdmL~F*a^#@j14Bn{_FpXR$tL9Y zOMC~?mHuB!oc1sgKfQ;J{e=I;qWsH6<91fnbyU<+5#+kK1p>|&9z#OzQg3qd_pn|s z>Zs9L6CzdgXP;U~0xv_=meVl0hhO`~AK*}brf8r)n5u84GL}<@{@_4x48iTUWqAW? zd@w+-A+yH!7+|3-(Jl)#)_MXL1eRzGH9;&(`lX___C`Q>1m_7);JVuDYh#UghziFX z^47xy7XV5vd`ZY<-QICs12Ut{PN-UD2=;ev6>`oMK6>)wEb6nJvCp#2Q#xq=rVCzt**!eCoZ$qRBJ}PgOLj!p2XRb63;;6{r&$h`Npc zt(kGV6-N-Q?XAi5P%59WaEgWWm>g>U^;LI*+|)xpu+PBBZLQYWpp~!^W@gaJX40)T?Ojrt^hl`aOs`mOG?TT< zA*>al?zXnF<)Xba)G}u0)7IJ%D{WdESM5zmec341)784@XLx0Mp<_?V?yMeRfW zZl~F#6-!B2IXUVy@(Ys(52I6$%ro%NUalhU5q3qqsu%~97Un@zz~BFJyjpOaP>$D# zO5axxq7MEpm)rXVf8WdTMS|mia(w=I8s&QsEzPJnq1?W%c)nhaS2%x@<-za<)@ufKT9w;@HvPUcvd_Gp1=@IAQ&8}qMBnB$t z&GXJPsXUJ;MvRJ)UQioYy zCl0ydB8o!^pK#&wb4;h%>RZqC+z3HK6iLTgMAQzVjreI|{_}Dc&^l3!=cTm}`=tH+ z=T0A+O8xqtv~LppSvwA$=qdcDJ^Xp1{u3=U4$mM@!#q6dkC0gzRjT)SY0)rm9{vuv zhSLuBJbYEzyXW(}5}*HG$oQbb{9J*7ZJ_6+-WT2vv`SnSR+fAXcnIh4?)iMf0`?Tx zR64i6Qrgdd-#0H%&Sw_DKM#Bfo(qRn{9L}gfc-B7$68I9mNsPMQ z-=7jL=GG-A4i(}B;543eyi0_SwWODjR=THnMA;9h_u^y9{uSV4&+}iwVp`ercYa!B zoRTZjAyg)y|~Y?vwOvG z79V9Zkslk|3zrg2UbU2&s(`5cLp>I5yS8mLT-R@nZtOLCH}&Ao#w>SE2(#zbP0@{r zA=B{X;xq1EiZN2?wf3&Nwmr9k_G()+(bIVh9GgNvf zq;79GU*7!8yW@#ON-uMYouU{% z+{u4e;En*uwv;{!h0b)?pW{=$w-1#XL*{jk;Wh}R{v5~Js=!OxP;s|^5Ab(!2E_G0 ztVg8f!wTq>+T1x9ukQ*Ln;>8(R%}1V#YdI@7S-Wu*pSHn&5((1!Ow#q*U#~DNHvtt z)yS5}J$}1@;kcvNevY$`DSsY+I+`HjdYIn^jLyhd=Xm^#@(+;{$lZPi72*yEWXk>= zw>PT_`CN|cclZAu<=>?Wg&Xoq&WB6!{KFkoP+Tg5373 zGk*a#_4v^{M8x|j-#PjphYvj}_UAa4|K4ayy>L9gxL%$Ie}XTWus`q1W~fmhwsW+( z{%|>eK}M;+;5bh?8tkYz`!PT5^5?j6K>43>`G;KkJJ6{tZa>FqJC-ZHXIG@~YN2=Z$D`1$d3 krS*lMJ;WldR9p0=uEM!qHl$&$