From: DeaDDooMER Date: Thu, 3 Aug 2017 18:41:56 +0000 (+0300) Subject: Добавлены функции MIN, MAX и SIZE X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=commitdiff_plain;h=d31e6130ac411ef95be71674b2666a1a79a83602 Добавлены функции MIN, MAX и SIZE --- diff --git a/make.sh b/make.sh index 64ae77f..69ffaee 100755 --- a/make.sh +++ b/make.sh @@ -3,7 +3,7 @@ set -e CC="gcc" -CFLAGS="-g -Wall -Werror -std=c11 -lgc" +CFLAGS="-g -Wall -Werror -std=c11 -lm -lgc" case "$1" in jvm) diff --git a/notes b/notes index 15aa1da..416ccef 100644 --- a/notes +++ b/notes @@ -6,7 +6,7 @@ - Нет конструкции CASE - Нет конструкции WITH - Нет модуля SYSTEM -- Нет функций ASH CAP CHR ENTIER LEN LONG MAX MIN ODD ORD SHORT SIZE +- Нет функций ASH CAP CHR ENTIER LEN LONG ODD ORD SHORT - Нет процедур ASSERT COPY DEC EXCL HALT INC INCL - Не реализована свёртка констант - Не счёта строк / столбцов diff --git a/src/oberon-internals.h b/src/oberon-internals.h index 7a776d6..07d8d03 100644 --- a/src/oberon-internals.h +++ b/src/oberon-internals.h @@ -175,7 +175,8 @@ enum oberon_mode_kind MODE_NEW, MODE_REAL, MODE_CHAR, - MODE_STRING + MODE_STRING, + MODE_TYPE }; enum oberon_operator_kind diff --git a/src/oberon.c b/src/oberon.c index e95a9be..a2a5670 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -5,6 +5,7 @@ #include #include #include +#include #include "../include/oberon.h" @@ -1011,6 +1012,42 @@ oberon_check_record_compatibility(oberon_context_t * ctx, oberon_type_t * from, } } +static void +oberon_check_dst(oberon_context_t * ctx, oberon_expr_t * dst) +{ + if(dst -> is_item == false) + { + oberon_error(ctx, "not variable"); + } + + switch(dst -> item.mode) + { + case MODE_VAR: + case MODE_CALL: + case MODE_INDEX: + case MODE_FIELD: + case MODE_DEREF: + case MODE_NEW: + /* accept */ + break; + default: + oberon_error(ctx, "not variable"); + break; + } +} + +static void +oberon_check_src(oberon_context_t * ctx, oberon_expr_t * src) +{ + if(src -> is_item) + { + if(src -> item.mode == MODE_TYPE) + { + oberon_error(ctx, "not variable"); + } + } +} + static oberon_expr_t * oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref) { @@ -1019,6 +1056,8 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * // Если INTEGER переводится в REAL // Есди STRING переводится в ARRAY OF CHAR + oberon_check_src(ctx, expr); + bool error = false; if(pref -> class != expr -> result -> class) { @@ -1228,58 +1267,6 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args } } -/* -static void -oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args) -{ - switch(proc -> class) - { - case OBERON_CLASS_PROC: - if(proc -> class != OBERON_CLASS_PROC) - { - oberon_error(ctx, "not a procedure"); - } - break; - case OBERON_CLASS_VAR: - case OBERON_CLASS_VAR_PARAM: - case OBERON_CLASS_PARAM: - if(proc -> type -> class != OBERON_TYPE_PROCEDURE) - { - oberon_error(ctx, "not a procedure"); - } - break; - default: - oberon_error(ctx, "not a procedure"); - break; - } - - 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, 1); - 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) \ @@ -1489,6 +1476,9 @@ oberon_designator(oberon_context_t * ctx) // TODO copy value expr = (oberon_expr_t *) var -> value; break; + case OBERON_CLASS_TYPE: + expr = oberon_new_item(MODE_TYPE, var -> type, read_only); + break; case OBERON_CLASS_VAR: case OBERON_CLASS_VAR_PARAM: case OBERON_CLASS_PARAM: @@ -1942,6 +1932,7 @@ oberon_const_expr(oberon_context_t * ctx) case MODE_REAL: case MODE_CHAR: case MODE_STRING: + case MODE_TYPE: /* accept */ break; default: @@ -2988,6 +2979,7 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst) oberon_error(ctx, "read-only destination"); } + oberon_check_dst(ctx, dst); src = oberon_autocast_to(ctx, src, dst -> result); oberon_generate_assign(ctx, src, dst); } @@ -3382,6 +3374,118 @@ oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f proc -> type -> genproc = p; } +static oberon_expr_t * +oberon_make_min_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; + + if(!arg -> is_item || arg -> item.mode != MODE_TYPE) + { + oberon_error(ctx, "MIN accept only type"); + } + + oberon_expr_t * expr; + int bits = arg -> result -> size * 8; + switch(arg -> result -> class) + { + case OBERON_TYPE_INTEGER: + expr = oberon_integer_item(ctx, -powl(2, bits - 1)); + break; + default: + oberon_error(ctx, "allowed only basic types"); + break; + } + + return expr; +} + +static oberon_expr_t * +oberon_make_max_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; + + if(!arg -> is_item || arg -> item.mode != MODE_TYPE) + { + oberon_error(ctx, "MAX accept only type"); + } + + oberon_expr_t * expr; + int bits = arg -> result -> size * 8; + switch(arg -> result -> class) + { + case OBERON_TYPE_INTEGER: + expr = oberon_integer_item(ctx, powl(2, bits - 1) - 1); + break; + default: + oberon_error(ctx, "allowed only basic types"); + break; + } + + return expr; +} + +static oberon_expr_t * +oberon_make_size_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; + + if(!arg -> is_item || arg -> item.mode != MODE_TYPE) + { + oberon_error(ctx, "SIZE accept only type"); + } + + int size; + oberon_expr_t * expr; + oberon_type_t * type = arg -> result; + switch(type -> class) + { + case OBERON_TYPE_INTEGER: + case OBERON_TYPE_BOOLEAN: + case OBERON_TYPE_REAL: + size = type -> size; + break; + default: + oberon_error(ctx, "TODO SIZE"); + break; + } + + expr = oberon_integer_item(ctx, size); + return expr; +} + static oberon_expr_t * oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args) { @@ -3406,7 +3510,6 @@ oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ oberon_error(ctx, "ABS accepts only integers"); } - oberon_expr_t * expr; expr = oberon_new_operator(OP_ABS, result_type, arg, NULL); return expr; @@ -3507,7 +3610,14 @@ oberon_create_context(ModuleImportCallback import_module) oberon_generator_init_context(ctx); register_default_types(ctx); + + /* Functions */ oberon_new_intrinsic(ctx, "ABS", oberon_make_abs_call, NULL); + oberon_new_intrinsic(ctx, "MIN", oberon_make_min_call, NULL); + oberon_new_intrinsic(ctx, "MAX", oberon_make_max_call, NULL); + oberon_new_intrinsic(ctx, "SIZE", oberon_make_size_call, NULL); + + /* Procedures */ oberon_new_intrinsic(ctx, "NEW", NULL, oberon_make_new_call); return ctx; diff --git a/src/test.c b/src/test.c index ebb807b..33f1aeb 100644 --- a/src/test.c +++ b/src/test.c @@ -13,13 +13,19 @@ static char source_test[] = " i, len : INTEGER;" "" "BEGIN" - " Out.Open();" - " LOOP" - " Out.String('Count '); Out.Int(i, 0); Out.Ln;" - " i := i + 1;" - " IF i > 4 THEN EXIT END;" - " END;" - " Out.String('end'); Out.Ln;" + " Out.Open;" + " Out.Int(MIN(BYTE), 0); Out.Ln;" + " Out.Int(MIN(SHORTINT), 0); Out.Ln;" + " Out.Int(MIN(INTEGER), 0); Out.Ln;" + " Out.Int(MIN(LONGINT), 0); Out.Ln;" + " Out.Int(MAX(BYTE), 0); Out.Ln;" + " Out.Int(MAX(SHORTINT), 0); Out.Ln;" + " Out.Int(MAX(INTEGER), 0); Out.Ln;" + " Out.Int(MAX(LONGINT), 0); Out.Ln;" + " Out.Int(SIZE(BYTE), 0); Out.Ln;" + " Out.Int(SIZE(SHORTINT), 0); Out.Ln;" + " Out.Int(SIZE(INTEGER), 0); Out.Ln;" + " Out.Int(SIZE(LONGINT), 0); Out.Ln;" "END Test." ;