X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=src%2Foberon.c;h=a2a567036598a90f005bcc1780531e18e6d54701;hp=e95a9bef396271f68b2dff5a6af06147cc530c09;hb=d31e6130ac411ef95be71674b2666a1a79a83602;hpb=5b29102a5440d6511087356b9d9579b7501ca1ec 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;