From: DeaDDooMER Date: Mon, 24 Jul 2017 19:27:59 +0000 (+0300) Subject: Реализованы неявные объявления типов наперёд X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=3376c57aa304940b405940c6463df71c7c1c7f01;p=dsw-obn.git Реализованы неявные объявления типов наперёд --- 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 0000000..2c0d983 Binary files /dev/null and b/test/Test differ diff --git a/test/Test.Mod b/test/Test.Mod new file mode 100644 index 0000000..5454854 --- /dev/null +++ b/test/Test.Mod @@ -0,0 +1,6 @@ +MODULE Test; + +TYPE + MyArr = POINTER TO ARRAY OF MyArr; + +END Test. diff --git a/test/Test.c b/test/Test.c new file mode 100644 index 0000000..c1cde12 --- /dev/null +++ b/test/Test.c @@ -0,0 +1,32 @@ +/* voc 2.1.0 [2017/06/08] for gcc LP64 on arch xtpam */ + +#define SHORTINT INT8 +#define INTEGER INT16 +#define LONGINT INT32 +#define SET UINT32 + +#include "SYSTEM.h" + +struct Test__1 { + char _prvt0[1]; +}; + +typedef + struct Test__1 *Test_MyRecDesc; + + + +export ADDRESS *Test__1__typ; + + + +__TDESC(Test__1, 1, 0) = {__TDFLDS("", 1), {-8}}; + +export int main(int argc, char **argv) +{ + __INIT(argc, argv); + __REGMAIN("Test", 0); + __INITYP(Test__1, Test__1, 0); +/* BEGIN */ + __FINI; +} diff --git a/test/make.sh b/test/make.sh new file mode 100755 index 0000000..74c6cf1 --- /dev/null +++ b/test/make.sh @@ -0,0 +1,5 @@ +#!/bin/sh + +set -e + +voc Test.Mod -m