From: DeaDDooMER Date: Mon, 24 Jul 2017 19:17:03 +0000 (+0300) Subject: Добавлены процедуры-функции, объявления именованных констант, объявления типов алиасо... X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=063ba732ee8778c34a3781270b18d52481dbf0cd;p=dsw-obn.git Добавлены процедуры-функции, объявления именованных констант, объявления типов алиасов и типов массивов, добавлен селектор индекса массива --- diff --git a/generator.c b/generator.c index 07e7bc4..685786f 100644 --- a/generator.c +++ b/generator.c @@ -10,19 +10,6 @@ #include -/* - * oberon_object_t -> gen_var == gcc_jit_lvalue; - * oberon_type_t -> gen_type == gcc_jit_type; - * oberon_context_t -> gen_context == gen_context_t; - */ - -typedef struct -{ - gcc_jit_context * gcc_context; - gcc_jit_block * gcc_block; - gcc_jit_result * gcc_result; -} gen_context_t; - static void printcontext(oberon_context_t * ctx, char * s) { /* @@ -71,43 +58,80 @@ oberon_generator_destroy_context(oberon_context_t * ctx) void oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type) { - printcontext(ctx, "oberon_generator_init_type"); + gen_type_t * gen_type = malloc(sizeof *gen_type); + memset(gen_type, 0, sizeof *gen_type); + type -> gen_type = gen_type; gen_context_t * gen_context = ctx -> gen_context; gcc_jit_context * gcc_context = gen_context -> gcc_context; - gcc_jit_type * gen_type; - if(type -> class == OBERON_TYPE_INTEGER) + gcc_jit_type * gcc_type; + if(type -> class == OBERON_TYPE_VOID) { - gen_type = gcc_jit_context_get_int_type(gcc_context, type -> size, 1); + gcc_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_VOID); + } + else if(type -> class == OBERON_TYPE_INTEGER) + { + gcc_type = gcc_jit_context_get_int_type(gcc_context, type -> size, 1); } else if(type -> class == OBERON_TYPE_BOOLEAN) { - gen_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_BOOL); + gcc_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_BOOL); + } + else if(type -> class == OBERON_TYPE_PROCEDURE) + { + gcc_type = NULL; // not used + } + else if(type -> class == OBERON_TYPE_ARRAY) + { + if(type -> dim != 1) + { + oberon_error(ctx, "multidimension and open arrays not supported"); + } + + gen_type_t * gen_base = type -> base -> gen_type; + gcc_jit_type * gcc_base = gen_base -> gcc_type; + + gcc_type = gcc_jit_context_new_array_type(gcc_context, NULL, gcc_base, type -> size); } else { oberon_error(ctx, "oberon_generator_init_type: invalid type class %i", type -> class); } - type -> gen_type = gen_type; + gen_type -> gcc_type = gcc_type; } void oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var) { - printcontext(ctx, "oberon_generator_init_var"); - assert(var -> class == OBERON_CLASS_VAR); - gen_context_t * gen_context = ctx -> gen_context; + gen_type_t * gen_type = var -> type -> gen_type; + + gen_var_t * gen_var = malloc(sizeof *gen_var); + memset(gen_var, 0, sizeof *gen_var); + var -> gen_var = gen_var; + gcc_jit_context * gcc_context = gen_context -> gcc_context; - gcc_jit_type * gen_type = var -> type -> gen_type; + gcc_jit_type * gcc_type = gen_type -> gcc_type; const char * name = var -> name; - gcc_jit_lvalue * gen_var; - gen_var = gcc_jit_context_new_global(gcc_context, NULL, GCC_JIT_GLOBAL_INTERNAL, gen_type, name); - - var -> gen_var = gen_var; + // TODO var param + if(var -> class == OBERON_CLASS_VAR) + { + gen_var -> gcc_lvalue = gcc_jit_context_new_global( + gcc_context, NULL, GCC_JIT_GLOBAL_INTERNAL, gcc_type, name + ); + } + else if(var -> class == OBERON_CLASS_PARAM) + { + gen_var -> gcc_param = gcc_jit_context_new_param(gcc_context, NULL, gcc_type, name); + gen_var -> gcc_lvalue = gcc_jit_param_as_lvalue(gen_var -> gcc_param); + } + else + { + oberon_error(ctx, "oberon_generator_init_var: invalid class %i", var -> class); + } } void @@ -117,18 +141,32 @@ oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc) gen_context_t * gen_context = ctx -> gen_context; gcc_jit_context * gcc_context = gen_context -> gcc_context; - //gcc_jit_type * gen_type = proc -> type -> gen_type; - const char * name = proc -> name; - gcc_jit_function * gen_proc; + gen_proc_t * gen_proc = malloc(sizeof *gen_proc); + memset(gen_proc, 0, sizeof *gen_proc); + proc -> gen_proc = gen_proc; - // TODO make real signature - gcc_jit_type * void_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_VOID); - gen_proc = gcc_jit_context_new_function( - gcc_context, NULL, GCC_JIT_FUNCTION_EXPORTED, void_type, name, 0, NULL, 0 + const char * name = proc -> name; + gen_type_t * gen_result_type = proc -> type -> base -> gen_type; + gcc_jit_type * result_type = gen_result_type -> gcc_type; + + /* Строим список параметров */ + int num_param = proc -> type -> num_decl; + oberon_object_t * o = proc -> type -> decl; + gcc_jit_param * params[num_param]; + for(int i = 0; i < num_param; i++) + { + gen_var_t * param_var = o -> gen_var; + params[i] = param_var -> gcc_param; + o = o -> next; + } + + gcc_jit_function * gcc_func; + gcc_func = gcc_jit_context_new_function( + gcc_context, NULL, GCC_JIT_FUNCTION_EXPORTED, result_type, name, num_param, params, 0 ); - proc -> gen_proc = gen_proc; + gen_proc -> gcc_func = gcc_func; } // ======================================================================= @@ -171,8 +209,9 @@ void oberon_generate_begin_proc(oberon_context_t * ctx, oberon_object_t * proc) { gen_context_t * gen_context = ctx -> gen_context; + gen_proc_t * gen_proc = proc -> gen_proc; - gcc_jit_function * func = proc -> gen_proc; + gcc_jit_function * func = gen_proc -> gcc_func; gcc_jit_block * gcc_block = gcc_jit_function_new_block(func, NULL); // TODO make stack for block @@ -194,11 +233,24 @@ void oberon_generate_end_proc(oberon_context_t * ctx) { gen_context_t * gen_context = ctx -> gen_context; - gcc_jit_block * gcc_block = gen_context -> gcc_block; + gen_context -> gcc_block = NULL; +} - gcc_jit_block_end_with_void_return(gcc_block, NULL); +void +oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr) +{ + gen_context_t * gen_context = ctx -> gen_context; + gcc_jit_block * gcc_block = gen_context -> gcc_block; - gen_context -> gcc_block = NULL; + if(expr == NULL) + { + gcc_jit_block_end_with_void_return(gcc_block, NULL); + } + else + { + gcc_jit_rvalue * r = rvalue_from_expr(ctx, expr); + gcc_jit_block_end_with_return(gcc_block, NULL, r); + } } static gcc_jit_lvalue * @@ -214,7 +266,8 @@ lvalue_from_expr(oberon_context_t *ctx, oberon_expr_t * expr) { oberon_error(ctx, "invalid lvalue expression"); } - left = item -> var -> gen_var; + gen_var_t * gen_var = item -> var -> gen_var; + left = gen_var -> gcc_lvalue; } else { @@ -233,9 +286,10 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item) gcc_jit_rvalue * right; if(item -> mode == MODE_VAR) { - assert(item -> var -> class == OBERON_CLASS_VAR); - gcc_jit_lvalue * gen_var = item -> var -> gen_var; - right = gcc_jit_lvalue_as_rvalue(gen_var); + assert(item -> var -> class == OBERON_CLASS_VAR + || item -> var -> class == OBERON_CLASS_PARAM); + gen_var_t * gen_var = item -> var -> gen_var; + right = gcc_jit_lvalue_as_rvalue(gen_var -> gcc_lvalue); } else if(item -> mode == MODE_INTEGER) { @@ -257,10 +311,22 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item) else if(item -> mode == MODE_CALL) { assert(item -> var -> class == OBERON_CLASS_PROC); - /* TODO args */ - gcc_jit_function * func = item -> var -> gen_proc; + + gen_proc_t * gen_proc = item -> var -> gen_proc; + + int num_args = item -> num_args; + gcc_jit_rvalue *args[num_args]; + + oberon_expr_t * expr = item -> args; + for(int i = 0; i < num_args; i++) + { + args[i] = rvalue_from_expr(ctx, expr); + expr = expr -> next; + } + + gcc_jit_function * func = gen_proc -> gcc_func; right = gcc_jit_context_new_call( - gcc_context, NULL, func, 0, NULL + gcc_context, NULL, func, num_args, args ); } else @@ -303,8 +369,9 @@ rvalue_from_operator(oberon_context_t * ctx, oberon_oper_t * operator) gcc_jit_rvalue * right; gen_context_t * gen_context = ctx -> gen_context; + gen_type_t * gen_type = operator -> result -> gen_type; gcc_jit_context * gcc_context = gen_context -> gcc_context; - gcc_jit_type * result_type = operator -> result -> gen_type; + gcc_jit_type * result_type = gen_type -> gcc_type; int expr_type = op_table[operator -> op].type; if(expr_type == 0) diff --git a/generator.h b/generator.h index 6b97e0d..6a7321b 100644 --- a/generator.h +++ b/generator.h @@ -28,6 +28,7 @@ void oberon_generate_call_proc(oberon_context_t * ctx, oberon_expr_t * desig); */ void oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst); +void oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr); /* * Функции генерации кода diff --git a/notes b/notes new file mode 100644 index 0000000..b82a34f --- /dev/null +++ b/notes @@ -0,0 +1,6 @@ +- нету автокаста в присвоении и передачи параметров +- нету секции type +- нету локальных объявлений в процедурах +- нету свёртки констант +- нету полного контроля return +- нету селекторов diff --git a/oberon.c b/oberon.c index 98928fb..65803c0 100644 --- a/oberon.c +++ b/oberon.c @@ -3,6 +3,7 @@ #include #include #include +#include #include "oberon.h" #include "generator.h" @@ -38,7 +39,15 @@ enum { MOD, AND, NOT, - PROCEDURE + PROCEDURE, + COMMA, + RETURN, + CONST, + TYPE, + ARRAY, + OF, + LBRACE, + RBRACE, }; // ======================================================================= @@ -60,6 +69,33 @@ oberon_error(oberon_context_t * ctx, const char * fmt, ...) exit(1); } +static oberon_type_t * +oberon_new_type_ptr(int class) +{ + oberon_type_t * x = malloc(sizeof *x); + memset(x, 0, sizeof *x); + x -> class = class; + return x; +} + +static oberon_type_t * +oberon_new_type_integer(int size) +{ + oberon_type_t * x; + x = oberon_new_type_ptr(OBERON_TYPE_INTEGER); + x -> size = size; + return x; +} + +static oberon_type_t * +oberon_new_type_boolean(int size) +{ + oberon_type_t * x; + x = oberon_new_type_ptr(OBERON_TYPE_BOOLEAN); + x -> size = size; + return x; +} + // ======================================================================= // TABLE // ======================================================================= @@ -143,13 +179,14 @@ oberon_find_object(oberon_scope_t * scope, char * name) return result; } -static void +static oberon_object_t * oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type) { oberon_object_t * id; id = oberon_define_object(scope, name, OBERON_CLASS_TYPE); id -> type = type; oberon_generator_init_type(scope -> ctx, type); + return id; } static oberon_type_t * @@ -164,13 +201,14 @@ oberon_find_type(oberon_scope_t * scope, char * name) return x -> type; } -static void -oberon_define_var(oberon_scope_t * scope, char * name, oberon_type_t * type) +static oberon_object_t * +oberon_define_var(oberon_scope_t * scope, int class, char * name, oberon_type_t * type) { oberon_object_t * var; - var = oberon_define_object(scope, name, OBERON_CLASS_VAR); + var = oberon_define_object(scope, name, class); var -> type = type; oberon_generator_init_var(scope -> ctx, var); + return var; } /* @@ -189,10 +227,11 @@ oberon_find_var(oberon_scope_t * scope, char * name) */ static oberon_object_t * -oberon_define_proc(oberon_scope_t * scope, char * name) +oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signature) { 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; } @@ -279,6 +318,26 @@ oberon_read_ident(oberon_context_t * ctx) { ctx -> token = PROCEDURE; } + else if(strcmp(ident, "RETURN") == 0) + { + ctx -> token = RETURN; + } + else if(strcmp(ident, "CONST") == 0) + { + ctx -> token = CONST; + } + else if(strcmp(ident, "TYPE") == 0) + { + ctx -> token = TYPE; + } + else if(strcmp(ident, "ARRAY") == 0) + { + ctx -> token = ARRAY; + } + else if(strcmp(ident, "OF") == 0) + { + ctx -> token = OF; + } } static void @@ -399,6 +458,18 @@ oberon_read_symbol(oberon_context_t * ctx) ctx -> token = NOT; oberon_get_char(ctx); break; + case ',': + ctx -> token = COMMA; + oberon_get_char(ctx); + break; + case '[': + ctx -> token = LBRACE; + oberon_get_char(ctx); + break; + case ']': + ctx -> token = RBRACE; + oberon_get_char(ctx); + break; default: oberon_error(ctx, "invalid char"); break; @@ -433,6 +504,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 oberon_expr_t * oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right) @@ -498,38 +570,167 @@ oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a) return expr; } +static void +oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first) +{ + oberon_expr_t * last; + + *num_expr = 1; + *first = last = oberon_expr(ctx); + while(ctx -> token == COMMA) + { + oberon_assert_token(ctx, COMMA); + oberon_expr_t * current; + current = oberon_expr(ctx); + last -> next = current; + last = current; + *num_expr += 1; + } +} + static oberon_expr_t * -oberon_factor(oberon_context_t * ctx) +oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref) +{ + if(expr -> result -> class != pref -> class) + { + oberon_error(ctx, "incompatible types"); + } + + if(pref -> class == OBERON_TYPE_INTEGER) + { + if(expr -> result -> class > pref -> class) + { + oberon_error(ctx, "incompatible size"); + } + } + + // TODO cast + + return expr; +} + +static void +oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) +{ + if(desig -> is_item == 0) + { + oberon_error(ctx, "expected item"); + } + + if(desig -> item.mode != MODE_CALL) + { + oberon_error(ctx, "expected mode CALL"); + } + + if(desig -> item.var -> class != OBERON_CLASS_PROC) + { + oberon_error(ctx, "only procedures can be called"); + } + + oberon_type_t * fn = desig -> item.var -> type; + int num_args = desig -> item.num_args; + int num_decl = fn -> num_decl; + + if(num_args < num_decl) + { + oberon_error(ctx, "too few arguments"); + } + else if(num_args > num_decl) + { + oberon_error(ctx, "too many arguments"); + } + + oberon_expr_t * arg = desig -> item.args; + oberon_object_t * param = fn -> decl; + for(int i = 0; i < num_args; i++) + { + oberon_autocast_to(ctx, arg, param -> type); + arg = arg -> next; + param = param -> next; + } +} + +#define ISEXPR(x) \ + (((x) == PLUS) \ + || ((x) == MINUS) \ + || ((x) == IDENT) \ + || ((x) == INTEGER) \ + || ((x) == LPAREN) \ + || ((x) == NOT) \ + || ((x) == TRUE) \ + || ((x) == FALSE)) + +static oberon_expr_t * +oberon_designator(oberon_context_t * ctx) { char * name; oberon_object_t * var; oberon_expr_t * expr; + name = oberon_assert_ident(ctx); + var = oberon_find_object(ctx -> decl, name); + + switch(var -> class) + { + case OBERON_CLASS_CONST: + // TODO copy value + expr = (oberon_expr_t *) var -> value; + break; + case OBERON_CLASS_VAR: + case OBERON_CLASS_VAR_PARAM: + case OBERON_CLASS_PARAM: + expr = oberon_new_item(MODE_VAR, var -> type); + break; + case OBERON_CLASS_PROC: + expr = oberon_new_item(MODE_CALL, var -> type); + break; + default: + oberon_error(ctx, "invalid designator"); + break; + } + + expr -> item.var = var; + return expr; +} + +static oberon_expr_t * +oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr) +{ + assert(expr -> is_item == 1); + if(ctx -> token == LPAREN) + { + oberon_assert_token(ctx, LPAREN); + + int num_args = 0; + oberon_expr_t * arguments = NULL; + + if(ISEXPR(ctx -> token)) + { + oberon_expr_list(ctx, &num_args, &arguments); + } + + expr -> result = expr -> item.var -> type -> base; + expr -> item.mode = MODE_CALL; + expr -> item.num_args = num_args; + expr -> item.args = arguments; + oberon_assert_token(ctx, RPAREN); + + oberon_autocast_call(ctx, expr); + } + + return expr; +} + +static oberon_expr_t * +oberon_factor(oberon_context_t * ctx) +{ + oberon_expr_t * expr; + switch(ctx -> token) { case IDENT: - name = oberon_assert_ident(ctx); - var = oberon_find_object(ctx -> decl, name); - if(var -> class == OBERON_CLASS_VAR) - { - expr = oberon_new_item(MODE_VAR, var -> type); - } - else if(var -> class == OBERON_CLASS_PROC) - { - expr = oberon_new_item(MODE_CALL, var -> type); - } - else - { - oberon_error(ctx, "invalid designator"); - } - - expr -> item.var = var; - if(ctx -> token == LPAREN) - { - oberon_assert_token(ctx, LPAREN); - expr -> item.mode = MODE_CALL; - oberon_assert_token(ctx, RPAREN); - } + expr = oberon_designator(ctx); + expr = oberon_opt_proc_parens(ctx, expr); break; case INTEGER: expr = oberon_new_item(MODE_INTEGER, ctx -> int_type); @@ -613,14 +814,12 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ oberon_expr_t * expr; oberon_type_t * result; - oberon_autocast_binary_op(ctx, a -> result, b -> result, &result); - if(ITMAKESBOOLEAN(token)) { if(ITUSEONLYINTEGER(token)) { if(a -> result -> class != OBERON_TYPE_INTEGER - && b -> result -> class != OBERON_TYPE_INTEGER) + || b -> result -> class != OBERON_TYPE_INTEGER) { oberon_error(ctx, "used only with integer types"); } @@ -628,12 +827,14 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ else if(ITUSEONLYBOOLEAN(token)) { if(a -> result -> class != OBERON_TYPE_BOOLEAN - && b -> result -> class != OBERON_TYPE_BOOLEAN) + || b -> result -> class != OBERON_TYPE_BOOLEAN) { oberon_error(ctx, "used only with boolean type"); } } + result = ctx -> bool_type; + if(token == EQUAL) { expr = oberon_new_operator(OP_EQ, result, a, b); @@ -673,6 +874,8 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ } else { + oberon_autocast_binary_op(ctx, a -> result, b -> result, &result); + if(token == PLUS) { expr = oberon_new_operator(OP_ADD, result, a, b); @@ -786,6 +989,20 @@ oberon_expr(oberon_context_t * ctx) return expr; } +static oberon_item_t * +oberon_const_expr(oberon_context_t * ctx) +{ + oberon_expr_t * expr; + expr = oberon_expr(ctx); + + if(expr -> is_item == 0) + { + oberon_error(ctx, "const expression are required"); + } + + return (oberon_item_t *) expr; +} + // ======================================================================= // PARSER // ======================================================================= @@ -817,11 +1034,49 @@ 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 oberon_type_t * oberon_type(oberon_context_t * ctx) { - char * name = oberon_assert_ident(ctx); - oberon_type_t * type = oberon_find_type(ctx -> decl, name); + oberon_type_t * type; + + 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 + { + oberon_error(ctx, "invalid type declaration"); + } + return type; } @@ -831,26 +1086,113 @@ oberon_var_decl(oberon_context_t * ctx) char * name = oberon_assert_ident(ctx); oberon_assert_token(ctx, COLON); oberon_type_t * type = oberon_type(ctx); - oberon_define_var(ctx -> decl, name, type); + oberon_define_var(ctx -> decl, OBERON_CLASS_VAR, name, type); } -static void -oberon_make_procedure_begin(oberon_context_t * ctx, char * name) +static oberon_object_t * +oberon_make_param(oberon_context_t * ctx, int token, char * name, oberon_type_t * type) { - oberon_object_t * proc; - proc = oberon_define_proc(ctx -> decl, name); + oberon_object_t * param; - oberon_open_scope(ctx); + if(token == VAR) + { + param = oberon_define_var(ctx -> decl, OBERON_CLASS_VAR_PARAM, name, type); + } + else if(token == IDENT) + { + param = oberon_define_var(ctx -> decl, OBERON_CLASS_PARAM, name, type); + } + else + { + oberon_error(ctx, "oberon_make_param: wat"); + } - oberon_generate_begin_proc(ctx, proc); + return param; +} + +static oberon_object_t * +oberon_fp_section(oberon_context_t * ctx, int * num_decl) +{ + int modifer_token = ctx -> token; + if(ctx -> token == VAR) + { + oberon_read_token(ctx); + } + + char * name; + name = oberon_assert_ident(ctx); + + oberon_assert_token(ctx, COLON); + + oberon_type_t * type; + type = oberon_type(ctx); + + oberon_object_t * first; + first = oberon_make_param(ctx, modifer_token, name, type); + + *num_decl += 1; + return first; +} + +#define ISFPSECTION \ + ((ctx -> token == VAR) || (ctx -> token == IDENT)) + +static oberon_type_t * +oberon_formal_pars(oberon_context_t * ctx) +{ + 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); + while(ctx -> token == SEMICOLON) + { + oberon_assert_token(ctx, SEMICOLON); + oberon_fp_section(ctx, &tp -> num_decl); + } + } + + oberon_assert_token(ctx, RPAREN); + + if(ctx -> token == COLON) + { + oberon_assert_token(ctx, COLON); + tp -> base = oberon_type(ctx); + } + + oberon_generator_init_type(ctx, tp); + return tp; } static void -oberon_make_procedure_end(oberon_context_t * ctx) +oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr) { - oberon_generate_end_proc(ctx); + if(ctx -> result_type -> class == OBERON_TYPE_VOID) + { + if(expr != NULL) + { + oberon_error(ctx, "procedure has no result type"); + } + } + else + { + if(expr == NULL) + { + oberon_error(ctx, "procedure requires expression on result"); + } - oberon_close_scope(ctx -> decl); + oberon_autocast_to(ctx, expr, ctx -> result_type); + } + + ctx -> has_return = 1; + + oberon_generate_return(ctx, expr); } static void @@ -861,28 +1203,116 @@ oberon_proc_decl(oberon_context_t * ctx) char * name; name = oberon_assert_ident(ctx); + oberon_scope_t * this_proc_def_scope = ctx -> decl; + oberon_open_scope(ctx); + + oberon_type_t * signature; + if(ctx -> token == LPAREN) + { + signature = oberon_formal_pars(ctx); + } + else + { + signature = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE); + signature -> num_decl = 0; + signature -> base = ctx -> void_type; + signature -> decl = NULL; + oberon_generator_init_type(ctx, signature); + } + + oberon_object_t * proc; + proc = oberon_define_proc(this_proc_def_scope, name, signature); + + ctx -> result_type = signature -> base; + ctx -> has_return = 0; + oberon_assert_token(ctx, SEMICOLON); - oberon_make_procedure_begin(ctx, name); + oberon_generate_begin_proc(ctx, proc); + + // TODO declarations + if(ctx -> token == BEGIN) { oberon_assert_token(ctx, BEGIN); oberon_statement_seq(ctx); } - oberon_make_procedure_end(ctx); oberon_assert_token(ctx, END); char * name2 = oberon_assert_ident(ctx); - if(strcmp(name2, name) != 0) { oberon_error(ctx, "procedure name not matched"); } + + if(signature -> base -> class == OBERON_TYPE_VOID) + { + oberon_make_return(ctx, NULL); + } + + if(ctx -> has_return == 0) + { + oberon_error(ctx, "procedure requires return"); + } + ctx -> result_type = NULL; + + oberon_generate_end_proc(ctx); + oberon_close_scope(ctx -> decl); +} + +static void +oberon_const_decl(oberon_context_t * ctx) +{ + char * name; + oberon_item_t * value; + oberon_object_t * constant; + + name = oberon_assert_ident(ctx); + oberon_assert_token(ctx, EQUAL); + value = oberon_const_expr(ctx); + + constant = oberon_define_object(ctx -> decl, name, OBERON_CLASS_CONST); + constant -> value = value; +} + +static void +oberon_type_decl(oberon_context_t * ctx) +{ + char * name; + oberon_object_t * newtype; + oberon_type_t * type; + + name = oberon_assert_ident(ctx); + oberon_assert_token(ctx, EQUAL); + type = oberon_type(ctx); + + newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE); + newtype -> type = type; } static void oberon_decl_seq(oberon_context_t * ctx) { + if(ctx -> token == CONST) + { + oberon_assert_token(ctx, CONST); + while(ctx -> token == IDENT) + { + oberon_const_decl(ctx); + oberon_assert_token(ctx, SEMICOLON); + } + } + + if(ctx -> token == TYPE) + { + oberon_assert_token(ctx, TYPE); + while(ctx -> token == IDENT) + { + oberon_type_decl(ctx); + oberon_assert_token(ctx, SEMICOLON); + } + } + if(ctx -> token == VAR) { oberon_assert_token(ctx, VAR); @@ -893,7 +1323,7 @@ oberon_decl_seq(oberon_context_t * ctx) } } - if(ctx -> token == PROCEDURE) + while(ctx -> token == PROCEDURE) { oberon_proc_decl(ctx); oberon_assert_token(ctx, SEMICOLON); @@ -903,42 +1333,14 @@ oberon_decl_seq(oberon_context_t * ctx) static void oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst) { - if(src -> result -> class != dst -> result -> class) - { - oberon_error(ctx, "incompatible assignment types"); - } - - if(dst -> result -> class == OBERON_TYPE_INTEGER) - { - if((dst -> result -> size) < (src -> result -> size)) - { - oberon_error(ctx, "incompatible assignment type size"); - } - } - + oberon_autocast_to(ctx, src, dst -> result); oberon_generate_assign(ctx, src, dst); } static void oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig) { - if(desig -> is_item == 0) - { - oberon_error(ctx, "expected item"); - } - - if(desig -> item.mode != MODE_CALL) - { - oberon_error(ctx, "expected mode CALL"); - } - - if(desig -> item.var -> class != OBERON_CLASS_PROC) - { - oberon_error(ctx, "only procedures can be called"); - } - - // TODO check arguments - + oberon_autocast_call(ctx, desig); oberon_generate_call_proc(ctx, desig); } @@ -950,7 +1352,7 @@ oberon_statement(oberon_context_t * ctx) if(ctx -> token == IDENT) { - item1 = oberon_expr(ctx); + item1 = oberon_designator(ctx); if(ctx -> token == ASSIGN) { oberon_assert_token(ctx, ASSIGN); @@ -959,9 +1361,24 @@ oberon_statement(oberon_context_t * ctx) } else { + item1 = oberon_opt_proc_parens(ctx, item1); oberon_make_call(ctx, item1); } } + else if(ctx -> token == RETURN) + { + oberon_assert_token(ctx, RETURN); + if(ISEXPR(ctx -> token)) + { + oberon_expr_t * expr; + expr = oberon_expr(ctx); + oberon_make_return(ctx, expr); + } + else + { + oberon_make_return(ctx, NULL); + } + } } static void @@ -1010,40 +1427,16 @@ oberon_parse_module(oberon_context_t * ctx) // LIBRARY // ======================================================================= -static oberon_type_t * -oberon_new_type_ptr(int class) -{ - oberon_type_t * x = malloc(sizeof *x); - memset(x, 0, sizeof *x); - x -> class = class; - return x; -} - -static oberon_type_t * -oberon_new_type_integer(int size) -{ - oberon_type_t * x; - x = oberon_new_type_ptr(OBERON_TYPE_INTEGER); - x -> size = size; - return x; -} - -static oberon_type_t * -oberon_new_type_boolean(int size) -{ - oberon_type_t * x; - x = oberon_new_type_ptr(OBERON_TYPE_BOOLEAN); - x -> size = size; - return x; -} - static void register_default_types(oberon_context_t * ctx) { - ctx -> int_type = oberon_new_type_integer(sizeof(int)); - ctx -> bool_type = oberon_new_type_boolean(sizeof(int)); + ctx -> void_type = oberon_new_type_ptr(OBERON_TYPE_VOID); + oberon_generator_init_type(ctx, ctx -> void_type); + ctx -> int_type = oberon_new_type_integer(sizeof(int)); oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type); + + ctx -> bool_type = oberon_new_type_boolean(sizeof(int)); oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type); } diff --git a/oberon.h b/oberon.h index f29aa4d..becdd78 100644 --- a/oberon.h +++ b/oberon.h @@ -1,12 +1,56 @@ #ifndef EMBEDED_OBERON_SCRIPT_H #define EMBEDED_OBERON_SCRIPT_H +#include + +/* + * Стуктуры данных генератора + */ + +typedef struct +{ + gcc_jit_function * gcc_func; +} gen_proc_t; + +typedef struct +{ + gcc_jit_type * gcc_type; +} gen_type_t; + +typedef struct +{ + char stub[16]; + gcc_jit_lvalue * gcc_lvalue; + gcc_jit_param * gcc_param; +} gen_var_t; + +typedef struct +{ + gcc_jit_context * gcc_context; + gcc_jit_block * gcc_block; + gcc_jit_result * gcc_result; +} gen_context_t; + typedef struct oberon_type_s oberon_type_t; typedef struct oberon_object_s oberon_object_t; typedef struct oberon_module_s oberon_module_t; typedef struct oberon_context_s oberon_context_t; typedef struct oberon_scope_s oberon_scope_t; +typedef struct oberon_item_s oberon_item_t; +typedef struct oberon_oper_s oberon_oper_t; +typedef union oberon_expr_u oberon_expr_t; + +/* + * Структура oberon_scope_s (oberon_type_t) реализует стекообразную + * область видимости объектов. + * Поля: + * ctx -- контекст в котором область видимости была создана; + * list -- список объявлений. Первый элемент всегда существует, + * но не используется и должен быть пропущен. + * up -- ссылка на облась видимости уровнем выше. + */ + struct oberon_scope_s { oberon_context_t * ctx; @@ -14,40 +58,102 @@ struct oberon_scope_s oberon_scope_t * up; }; +/* + * Формы типов данных. + * Тип VOID используется как заглушка возврата типа в обычных процедурах + */ + enum { + OBERON_TYPE_VOID, OBERON_TYPE_INTEGER, OBERON_TYPE_BOOLEAN, + OBERON_TYPE_PROCEDURE, + OBERON_TYPE_ARRAY }; +/* + * Структура oberon_type_s (oberon_type_t) описывает типы данных. + * Поля: + * class -- Форма типа данных (OBERON_TYPE_*). + * size -- Размер примитива в байтах или количество ячеек массива. + * Ноль для открытых массивов. + * num_decl -- Количество объявленых полей в структуре или сигнатуре процедуры. + * base -- Базовый тип структуры или тип возврата процедуры. + * decl -- Список объявлений. Перебор начинается с первого элемента. + * + * Таблица использования полей: + * class size num_decl base decl + * VOID - - - - + * INT + - - - + * BOOL + - - - + * PROC - + + + + */ + struct oberon_type_s { int class; int size; - void * gen_type; + int dim; + + int num_decl; + oberon_type_t * base; + oberon_object_t * decl; + + gen_type_t * gen_type; }; +/* + * Классы объектов. + * VAR -- переменная. + * TYPE -- тип данных. + * PROC -- процедура. + * PARAM -- параметр процедуры. + * VAR_PARAM -- VAR-параметр процедуры. + */ + enum { OBERON_CLASS_VAR, OBERON_CLASS_TYPE, - OBERON_CLASS_PROC + OBERON_CLASS_PROC, + OBERON_CLASS_PARAM, + OBERON_CLASS_VAR_PARAM, + OBERON_CLASS_CONST }; +/* + * Структура oberon_object_s (oberon_object_t) описывает все + * объявления которые могут иметь имя. От констант, до процедур. + * Поля: + * name -- имя объекта. + * class -- класс объекта (OBERON_CLASS_*). + * type -- ссылка на тип переменной, дескриптор типа или сигнатуру процедуры. + * next -- ссылка на следующий объект в списке. + */ + struct oberon_object_s { char * name; int class; oberon_type_t * type; - - void * gen_var; - void * gen_proc; - + oberon_item_t * value; oberon_object_t * next; + + gen_var_t * gen_var; + gen_proc_t * gen_proc; }; +/* + * Структура oberon_module_s (oberon_module_t) описывает объявление модуля. + * Поля: + * name -- настоящее имя модуля. + * decl -- все глобальные объявления в модуле. + * begin -- Указатель на сгенерированный код тела модуля (секция BEGIN). + */ + struct oberon_module_s { char * name; @@ -57,6 +163,23 @@ struct oberon_module_s void (* begin)(); }; +/* + * Структура oberon_context_s (oberon_context_t) учитывает текущее состояние интерпретатора. + * Один экземпляр не может использоваться в нескольких потоках одновременно. + * Поля: + * code -- входной буффер для сканера. + * code_index -- Текущая позия в буффере. + * с -- последний прочитанный символ. + * token -- последний прочитанный токен. + * string -- буфер с прочитанной строкой / идентификатором. + * всегда имеет уникальный адрес и может изменяться. + * integer -- прочитанное целое число. + * decl -- текущая область видимости. + * mod -- текущий модуль. + * int_type, bool_type, void_type -- стандартные типы. + * world_scope -- область видимости "мир" - выше модуля. + */ + struct oberon_context_s { const char * code; @@ -67,24 +190,30 @@ struct oberon_context_s char * string; int integer; + int has_return; + oberon_type_t * result_type; + oberon_scope_t * decl; oberon_module_t * mod; oberon_type_t * int_type; oberon_type_t * bool_type; + oberon_type_t * void_type; oberon_scope_t * world_scope; - void * gen_context; + gen_context_t * gen_context; }; -enum { +enum +{ MODE_VAR, MODE_INTEGER, MODE_BOOLEAN, MODE_CALL }; -enum { +enum +{ OP_LOGIC_NOT, OP_UNARY_MINUS, OP_ADD, @@ -102,25 +231,26 @@ enum { OP_GEQ }; -typedef struct oberon_item_s oberon_item_t; -typedef struct oberon_oper_s oberon_oper_t; -typedef union oberon_expr_u oberon_expr_t; - struct oberon_item_s { - int is_item; + int is_item; // == 1 oberon_type_t * result; + oberon_expr_t * next; int mode; int integer; int boolean; oberon_object_t * var; + + int num_args; + oberon_expr_t * args; }; struct oberon_oper_s { - int is_item; + int is_item; // == 0 oberon_type_t * result; + oberon_expr_t * next; int op; oberon_expr_t * left; @@ -132,6 +262,7 @@ union oberon_expr_u struct { int is_item; oberon_type_t * result; + oberon_expr_t * next; }; oberon_item_t item; diff --git a/test.c b/test.c index da6a804..7c8e672 100644 --- a/test.c +++ b/test.c @@ -3,21 +3,42 @@ static const char source[] = "MODULE Test;" + "CONST" + " con = 3;" + "" + "TYPE" + " MyInt = INTEGER;" + " MyArr = ARRAY con OF MyInt;" + "" "VAR" " k : INTEGER;" " i : INTEGER;" " b : BOOLEAN;" + " arr : MyArr;" "" "PROCEDURE Tier;" "BEGIN" - " k := 314;" + " k := 314 + con;" "END Tier;" "" + "PROCEDURE Tier2(x : INTEGER; y : INTEGER);" + "BEGIN" + " k := x + y;" + "END Tier2;" + "" + "PROCEDURE Tier3(x : INTEGER) : INTEGER;" + "BEGIN" + " RETURN x * x * x;" + "END Tier3;" + "" "BEGIN" " k := 1;" " i := k;" - " b := TRUE;" - " Tier;" + " b := (TRUE # FALSE);" + " Tier();" + " Tier2(21, 13);" + " k := Tier3(2);" +// " arr[0] := 1;" "END Test." ;