From: DeaDDooMER Date: Mon, 24 Jul 2017 19:42:56 +0000 (+0300) Subject: Добавлены встроенные процедуры X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=commitdiff_plain;h=1bf625553dc35ac4a5c1afceb6950fd44776a424 Добавлены встроенные процедуры --- diff --git a/generator.c b/generator.c index b17a8cd..709e5a6 100644 --- a/generator.c +++ b/generator.c @@ -519,14 +519,19 @@ struct { enum gcc_jit_comparison comp_op; }; } op_table[] = { - { 0, .unary_op = GCC_JIT_UNARY_OP_LOGICAL_NEGATE }, { 0, .unary_op = GCC_JIT_UNARY_OP_MINUS }, + { 0, .unary_op = GCC_JIT_UNARY_OP_BITWISE_NEGATE }, + { 0, .unary_op = GCC_JIT_UNARY_OP_LOGICAL_NEGATE }, + { 0, .unary_op = GCC_JIT_UNARY_OP_ABS }, { 1, .binary_op = GCC_JIT_BINARY_OP_PLUS }, { 1, .binary_op = GCC_JIT_BINARY_OP_MINUS }, { 1, .binary_op = GCC_JIT_BINARY_OP_MULT }, { 1, .binary_op = GCC_JIT_BINARY_OP_DIVIDE }, { 1, .binary_op = GCC_JIT_BINARY_OP_MODULO }, + { 1, .binary_op = GCC_JIT_BINARY_OP_BITWISE_AND }, + { 1, .binary_op = GCC_JIT_BINARY_OP_BITWISE_XOR }, + { 1, .binary_op = GCC_JIT_BINARY_OP_BITWISE_OR }, { 1, .binary_op = GCC_JIT_BINARY_OP_LOGICAL_AND }, { 1, .binary_op = GCC_JIT_BINARY_OP_LOGICAL_OR }, diff --git a/notes b/notes index ec0a69c..3c1b0db 100644 --- a/notes +++ b/notes @@ -1,4 +1,4 @@ -- нужно сделать объявление встроенных процедур +- нету тестовых процедур для ввода-вывода - нету процедуры NEW - нету открытых массивов @@ -10,7 +10,7 @@ - не реализована свёртка констант - не протестированы типы разнных размеров -- не реализовано расширение типа record +- не реализовано расширение типа record (libgccjit не умеет в классы) - не работает присваивание к переменным-процедурам. - не реализован автокаст (libgccjit сам разруливает) - libgccjit не умеет в локальные функции (опять пилить костыли как в jvm) diff --git a/oberon.c b/oberon.c index c3a6f86..6dd84f1 100644 --- a/oberon.c +++ b/oberon.c @@ -777,6 +777,76 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) } } +static oberon_expr_t * +oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args) +{ + if(proc -> class != OBERON_CLASS_PROC) + { + oberon_error(ctx, "not a procedure"); + } + + oberon_expr_t * call; + + if(proc -> sysproc) + { + if(proc -> genfunc == NULL) + { + oberon_error(ctx, "not a function-procedure"); + } + + call = proc -> genfunc(ctx, num_args, list_args); + } + else + { + if(proc -> type -> base -> class == OBERON_TYPE_VOID) + { + oberon_error(ctx, "attempt to call procedure in expression"); + } + + call = oberon_new_item(MODE_CALL, proc -> type -> base); + call -> item.var = proc; + call -> item.num_args = num_args; + call -> item.args = list_args; + oberon_autocast_call(ctx, call); + } + + return call; +} + +static void +oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args) +{ + if(proc -> class != OBERON_CLASS_PROC) + { + oberon_error(ctx, "not a procedure"); + } + + if(proc -> sysproc) + { + if(proc -> genproc == NULL) + { + oberon_error(ctx, "requres non-typed procedure"); + } + + proc -> genproc(ctx, num_args, list_args); + } + else + { + if(proc -> type -> base -> class != OBERON_TYPE_VOID) + { + oberon_error(ctx, "attempt to call function as non-typed procedure"); + } + + oberon_expr_t * call; + call = oberon_new_item(MODE_CALL, proc -> type -> base); + call -> item.var = proc; + call -> item.num_args = num_args; + call -> item.args = list_args; + oberon_autocast_call(ctx, call); + oberon_generate_call_proc(ctx, call); + } +} + #define ISEXPR(x) \ (((x) == PLUS) \ || ((x) == MINUS) \ @@ -905,6 +975,7 @@ oberon_designator(oberon_context_t * ctx) expr = oberon_new_item(MODE_VAR, var -> type); break; case OBERON_CLASS_PROC: + //expr = oberon_make_call_expr(var, 0, NULL); expr = oberon_new_item(MODE_CALL, var -> type); break; default: @@ -948,17 +1019,37 @@ oberon_designator(oberon_context_t * ctx) } static oberon_expr_t * -oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr) +oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr) { assert(expr -> is_item == 1); if(ctx -> token == LPAREN) { - if(expr -> result -> class != OBERON_TYPE_PROCEDURE) + oberon_assert_token(ctx, LPAREN); + + int num_args = 0; + oberon_expr_t * arguments = NULL; + + if(ISEXPR(ctx -> token)) { - oberon_error(ctx, "not a procedure"); + oberon_expr_list(ctx, &num_args, &arguments, 0); } + expr = oberon_make_call_func(ctx, expr -> item.var, num_args, arguments); + + oberon_assert_token(ctx, RPAREN); + } + + return expr; +} + +static void +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; @@ -969,16 +1060,10 @@ oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr) oberon_expr_list(ctx, &num_args, &arguments, 0); } - 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_make_call_proc(ctx, expr -> item.var, num_args, arguments); - oberon_autocast_call(ctx, expr); + oberon_assert_token(ctx, RPAREN); } - - return expr; } static oberon_expr_t * @@ -990,7 +1075,7 @@ oberon_factor(oberon_context_t * ctx) { case IDENT: expr = oberon_designator(ctx); - expr = oberon_opt_proc_parens(ctx, expr); + expr = oberon_opt_func_parens(ctx, expr); break; case INTEGER: expr = oberon_new_item(MODE_INTEGER, ctx -> int_type); @@ -2118,21 +2203,6 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst) oberon_generate_assign(ctx, src, dst); } -static void -oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig) -{ - if(desig -> result -> class != OBERON_TYPE_VOID) - { - if(desig -> result -> class != OBERON_TYPE_PROCEDURE) - { - oberon_error(ctx, "procedure with result"); - } - } - - oberon_autocast_call(ctx, desig); - oberon_generate_call_proc(ctx, desig); -} - static void oberon_statement(oberon_context_t * ctx) { @@ -2150,8 +2220,7 @@ oberon_statement(oberon_context_t * ctx) } else { - item1 = oberon_opt_proc_parens(ctx, item1); - oberon_make_call(ctx, item1); + oberon_opt_proc_parens(ctx, item1); } } else if(ctx -> token == RETURN) @@ -2233,6 +2302,58 @@ register_default_types(oberon_context_t * ctx) oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type); } +static void +oberon_new_intrinsic_function(oberon_context_t * ctx, char * name, GenerateFuncCallback generate) +{ + oberon_object_t * proc; + proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC); + proc -> sysproc = 1; + proc -> genfunc = generate; + proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE); +} + +/* +static void +oberon_new_intrinsic_procedure(oberon_context_t * ctx, char * name, GenerateProcCallback generate) +{ + oberon_object_t * proc; + proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC); + proc -> sysproc = 1; + proc -> genproc = generate; + proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE); +} +*/ + +static oberon_expr_t * +oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args) +{ + if(num_args < 1) + { + oberon_error(ctx, "too few arguments"); + } + + if(num_args > 1) + { + oberon_error(ctx, "too mach arguments"); + } + + oberon_expr_t * arg; + arg = list_args; + + oberon_type_t * result_type; + result_type = arg -> result; + + if(result_type -> class != OBERON_TYPE_INTEGER) + { + oberon_error(ctx, "ABS accepts only integers"); + } + + + oberon_expr_t * expr; + expr = oberon_new_operator(OP_ABS, result_type, arg, NULL); + return expr; +} + oberon_context_t * oberon_create_context() { @@ -2245,7 +2366,8 @@ oberon_create_context() oberon_generator_init_context(ctx); - register_default_types(ctx); + register_default_types(ctx); + oberon_new_intrinsic_function(ctx, "ABS", oberon_make_abs_call); return ctx; } diff --git a/oberon.h b/oberon.h index 30c4cbe..09a24c9 100644 --- a/oberon.h +++ b/oberon.h @@ -139,6 +139,11 @@ enum OBERON_CLASS_FIELD }; +enum +{ + OBERON_SYSPROC_ABS +}; + /* * Структура oberon_object_s (oberon_object_t) описывает все * объявления которые могут иметь имя. От констант, до процедур. @@ -149,6 +154,9 @@ enum * next -- ссылка на следующий объект в списке. */ +typedef oberon_expr_t * (*GenerateFuncCallback)(oberon_context_t *, int, oberon_expr_t *); +typedef void (*GenerateProcCallback)(oberon_context_t *, int, oberon_expr_t *); + struct oberon_object_s { char * name; @@ -159,9 +167,12 @@ struct oberon_object_s int initialized; oberon_object_t * parent; + oberon_scope_t * scope; // for proc int has_return; // for proc - + int sysproc; + GenerateFuncCallback genfunc; + GenerateProcCallback genproc; oberon_type_t * type; oberon_item_t * value; @@ -241,15 +252,22 @@ enum enum { - OP_LOGIC_NOT, OP_UNARY_MINUS, + OP_BITWISE_NOT, + OP_LOGIC_NOT, + OP_ABS, + OP_ADD, OP_SUB, OP_MUL, OP_DIV, OP_MOD, + OP_BITWISE_AND, + OP_BITWISE_XOR, + OP_BITWISE_OP, OP_LOGIC_AND, OP_LOGIC_OR, + OP_EQ, OP_NEQ, OP_LSS, diff --git a/test.c b/test.c index b07a08d..914764e 100644 --- a/test.c +++ b/test.c @@ -21,8 +21,9 @@ static const char source[] = "PROCEDURE ^ Tier(x : INTEGER);" "" "BEGIN;" - " i := 666;" - " Tier(1);" + " i := ABS(-666);" + " Tier(i);" + " ABS(1);" "END Test." ;