From 25b73915e7fe0ae7dc51cf6f4a012f021257a35d Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Sun, 30 Jul 2017 16:59:34 +0300 Subject: [PATCH] =?utf8?q?=D0=94=D0=BE=D0=B1=D0=B0=D0=B2=D0=BB=D0=B5=D0=BD?= =?utf8?q?=D1=8B=20=D1=82=D0=B8=D0=BF=D1=8B=20=D1=80=D0=B0=D0=B7=D0=BD?= =?utf8?q?=D1=8B=D1=85=20=D1=80=D0=B0=D0=B7=D0=BC=D0=B5=D1=80=D0=BE=D0=B2?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- jvm_test.sh | 5 +- notes | 2 +- rtl/Out.java | 7 +- src/backends/jvm/generator-jvm.c | 93 ++++++++++++- src/oberon-internals.h | 16 ++- src/oberon.c | 232 ++++++++++++++++++++----------- src/test.c | 39 +++--- 7 files changed, 285 insertions(+), 109 deletions(-) diff --git a/jvm_test.sh b/jvm_test.sh index 0c94910..6519656 100755 --- a/jvm_test.sh +++ b/jvm_test.sh @@ -3,10 +3,13 @@ set -e ./make.sh jvm -./run.sh rm -rf classes +rm -f *.j *.jad mkdir -p classes + +./run.sh + javac -d classes Launcher.java jasmin -d classes *.j diff --git a/notes b/notes index 2cfcb16..79510a0 100644 --- a/notes +++ b/notes @@ -7,7 +7,7 @@ - Нужно изменить передачу информации о вызываемой процедуре в MODE_CALL На данный момент конкретная процедура передаётся в поле var, вместо parent Что не позволяет делать процедуры-переменные в полях записей, массивах и т.д. -- Нужны средства создания биндингов. Хотя бы как заглушки для модулей. +- Нужны средства создания биндингов. На данный момент реализуемо как заглушки для модулей. - нужен автокаст int -> real для DIV. Да и вообще каст типов. - нет символов и строк diff --git a/rtl/Out.java b/rtl/Out.java index ca773d2..309578a 100644 --- a/rtl/Out.java +++ b/rtl/Out.java @@ -7,7 +7,7 @@ public class Out } - public static void Int(int i, int n) + public static void Int(long i, long n) { System.out.print(i); } @@ -17,6 +17,11 @@ public class Out System.out.print(x); } + public static void LongReal(double x, int n) + { + System.out.print(x); + } + public static void Ln() { System.out.println(); diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c index 497b99e..1225a86 100644 --- a/src/backends/jvm/generator-jvm.c +++ b/src/backends/jvm/generator-jvm.c @@ -128,6 +128,19 @@ jvm_generate(gen_proc_t * p, unsigned get, unsigned push, char * format, ...) va_end(ptr); } +static void +jvm_generate_comment(gen_proc_t * p, char * format, ...) +{ + va_list ptr; + va_start(ptr, format); + + fprintf(p -> class -> fp, " ;;;; "); + vfprintf(p -> class -> fp, format, ptr); + fprintf(p -> class -> fp, "\n"); + + va_end(ptr); +} + static void jvm_generate_push_int(gen_proc_t * p, int64_t i) { @@ -157,6 +170,60 @@ jvm_generate_push_int(gen_proc_t * p, int64_t i) } } +static void +jvm_generate_push_int_size(gen_proc_t * p, int64_t i, int size) +{ + int pushed_cell = 1; + + if(i == -1) + { + jvm_generate(p, 0, 1, "iconst_m1"); + } + else if(i >= 0 && i <= 5) + { + jvm_generate(p, 0, 1, "iconst_%li", i); + } + else if(i >= -128 && i <= 127) + { + jvm_generate(p, 0, 1, "bipush %li", i); + } + else if(i >= -32768 && i <= 32767) + { + jvm_generate(p, 0, 1, "sipush %li", i); + } + else if(i >= -2147483648 && i <= 2147483647) + { + jvm_generate(p, 0, 1, "ldc %li", i); + } + else + { + pushed_cell = 2; + jvm_generate(p, 0, 2, "ldc2 %li", i); + } + + assert(size <= 8); + if(size > 4 && pushed_cell == 1) + { + jvm_generate(p, pushed_cell, 2, "i2l"); + } + else if(size <= 4) + { + if(pushed_cell > 1) + { + jvm_generate(p, 2, 1, "l2i"); + } + + if(size == 2) + { + jvm_generate(p, 1, 1, "i2s"); + } + else if(size == 1) + { + jvm_generate(p, 1, 1, "i2b"); + } + } +} + static void jvm_generate_push_float(gen_proc_t * p, double f, int size) { @@ -1229,6 +1296,24 @@ jvm_generate_expr_new_pointer(gen_proc_t * p, oberon_type_t * type, int num, obe jvm_generate_new(p, type -> base, num); } +static void +jvm_generate_cast_type(gen_proc_t * p, oberon_type_t * from, oberon_type_t * to) +{ + char prefix = jvm_get_prefix(from); + char postfix = jvm_get_postfix(to); + int from_cell_size = jvm_cell_size_for_type(from); + int to_cell_size = jvm_cell_size_for_type(to); + + jvm_generate_comment(p, "cast type class from %i(%i) to %i(%i)", from -> class, from -> size, to -> class, to -> size); + + if(prefix == postfix) + { + return; + } + + jvm_generate(p, from_cell_size, to_cell_size, "%c2%c", prefix, postfix); +} + static void push_item(gen_proc_t * p, oberon_item_t * item) { @@ -1245,10 +1330,10 @@ push_item(gen_proc_t * p, oberon_item_t * item) } break; case MODE_INTEGER: - jvm_generate_push_int(p, item -> integer); + jvm_generate_push_int_size(p, item -> integer, item -> result -> size); break; case MODE_BOOLEAN: - jvm_generate_push_int(p, item -> boolean); + jvm_generate_push_int_size(p, item -> boolean, item -> result -> size); break; case MODE_CALL: jvm_generate_call_proc(p, (oberon_expr_t *) item); @@ -1278,6 +1363,10 @@ push_item(gen_proc_t * p, oberon_item_t * item) case MODE_REAL: jvm_generate_push_float(p, item -> real, item -> result -> size); break; + case MODE_CAST: + push_item(p, item -> parent); + jvm_generate_cast_type(p, item -> parent -> result, item -> result); + break; default: gen_error("push_item: unk mode %i", item -> mode); break; diff --git a/src/oberon-internals.h b/src/oberon-internals.h index ac6b695..b01a1d7 100644 --- a/src/oberon-internals.h +++ b/src/oberon-internals.h @@ -1,6 +1,9 @@ #ifndef OBERON_INTERNALS_H #define OBERON_INTERNALS_H +#include +#include + typedef struct gen_module_t gen_module_t; typedef struct gen_proc_t gen_proc_t; typedef struct gen_type_t gen_type_t; @@ -125,8 +128,9 @@ struct oberon_context_t char c; int token; char * string; - long integer; + int64_t integer; double real; + bool longmode; /*** END SCANER DATA ***/ /*** PARSER DATA ***/ @@ -134,11 +138,16 @@ struct oberon_context_t oberon_module_t * mod; /*** END PARSER DATA ***/ - oberon_type_t * int_type; oberon_type_t * bool_type; + oberon_type_t * byte_type; + oberon_type_t * shortint_type; + oberon_type_t * int_type; + oberon_type_t * longint_type; oberon_type_t * real_type; + oberon_type_t * longreal_type; oberon_type_t * void_type; oberon_type_t * void_ptr_type; + oberon_scope_t * world_scope; oberon_module_t * module_list; ModuleImportCallback import_module; @@ -156,7 +165,8 @@ enum MODE_DEREF, MODE_NIL, MODE_NEW, - MODE_REAL + MODE_REAL, + MODE_CAST }; enum diff --git a/src/oberon.c b/src/oberon.c index 251a7df..8de42d9 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -98,11 +98,10 @@ oberon_new_type_integer(int size) } static oberon_type_t * -oberon_new_type_boolean(int size) +oberon_new_type_boolean() { oberon_type_t * x; x = oberon_new_type_ptr(OBERON_TYPE_BOOLEAN); - x -> size = size; return x; } @@ -446,10 +445,12 @@ oberon_read_number(oberon_context_t * ctx) memcpy(ident, &ctx -> code[start_i], len); ident[len] = 0; + ctx -> longmode = false; if(mode == 3) { int i = exp_i - start_i; ident[i] = 'E'; + ctx -> longmode = true; } switch(mode) @@ -766,26 +767,88 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first, } } +static oberon_expr_t * +oberon_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref) +{ + assert(expr -> is_item); + oberon_expr_t * cast; + cast = oberon_new_item(MODE_CAST, pref, expr -> read_only); + cast -> item.parent = (oberon_item_t *) expr; + cast -> next = expr -> next; + return cast; +} + +static oberon_type_t * +oberon_get_equal_expr_type(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b) +{ + oberon_type_t * result; + if(a -> class == OBERON_TYPE_REAL && b -> class == OBERON_TYPE_INTEGER) + { + result = a; + } + else if(b -> class == OBERON_TYPE_REAL && a -> class == OBERON_TYPE_INTEGER) + { + result = b; + } + else if(a -> class != b -> class) + { + oberon_error(ctx, "oberon_get_equal_expr_type: incompatible types"); + } + else if(a -> size > b -> size) + { + result = a; + } + else + { + result = b; + } + + return result; +} + static oberon_expr_t * oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref) { if(pref -> class != expr -> result -> class) { - if(pref -> class != OBERON_TYPE_PROCEDURE) + if(pref -> class == OBERON_TYPE_POINTER) { - if(expr -> result -> class != OBERON_TYPE_POINTER) + if(expr -> result -> class == OBERON_TYPE_POINTER) + { + // accept + } + else + { + oberon_error(ctx, "incompatible types"); + } + } + else if(pref -> class == OBERON_TYPE_REAL) + { + if(expr -> result -> class == OBERON_TYPE_INTEGER) + { + // accept + } + else { oberon_error(ctx, "incompatible types"); } } + else + { + oberon_error(ctx, "incompatible types"); + } } - if(pref -> class == OBERON_TYPE_INTEGER) + if(pref -> class == OBERON_TYPE_INTEGER || pref -> class == OBERON_TYPE_REAL) { - if(expr -> result -> class > pref -> class) + if(expr -> result -> size > pref -> size) { oberon_error(ctx, "incompatible size"); } + else + { + expr = oberon_cast_expr(ctx, expr, pref); + } } else if(pref -> class == OBERON_TYPE_RECORD) { @@ -806,11 +869,19 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * } } - // TODO cast - return expr; } +static void +oberon_autocast_binary_op(oberon_context_t * ctx, oberon_expr_t ** ea, oberon_expr_t ** eb) +{ + oberon_type_t * a = (*ea) -> result; + oberon_type_t * b = (*eb) -> result; + oberon_type_t * preq = oberon_get_equal_expr_type(ctx, a, b); + *ea = oberon_autocast_to(ctx, *ea, preq); + *eb = oberon_autocast_to(ctx, *eb, preq); +} + static void oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) { @@ -842,6 +913,8 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) oberon_error(ctx, "too many arguments"); } + /* Делаем проверку на запись и делаем автокаст */ + oberon_expr_t * casted[num_args]; oberon_expr_t * arg = desig -> item.args; oberon_object_t * param = fn -> decl; for(int i = 0; i < num_args; i++) @@ -852,27 +925,23 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) { oberon_error(ctx, "assign to read-only var"); } + } - //if(arg -> is_item) - //{ - // switch(arg -> item.mode) - // { - // case MODE_VAR: - // case MODE_INDEX: - // case MODE_FIELD: - // // Допустимо разыменование? - // //case MODE_DEREF: - // break; - // default: - // oberon_error(ctx, "var-parameter accept only variables"); - // break; - // } - //} - } - oberon_autocast_to(ctx, arg, param -> type); + casted[i] = oberon_autocast_to(ctx, arg, param -> type); arg = arg -> next; param = param -> next; } + + /* Создаём новый список выражений */ + if(num_args > 0) + { + arg = casted[0]; + for(int i = 0; i < num_args - 1; i++) + { + casted[i] -> next = casted[i + 1]; + } + desig -> item.args = arg; + } } static oberon_expr_t * @@ -1258,10 +1327,32 @@ oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr) oberon_make_call_proc(ctx, expr -> item.var, num_args, arguments); } +static oberon_type_t * +oberon_get_type_of_int_value(oberon_context_t * ctx, int64_t i) +{ + if(i >= -128 && i <= 127) + { + return ctx -> byte_type; + } + else if(i >= -32768 && i <= 32767) + { + return ctx -> shortint_type; + } + else if(i >= -2147483648 && i <= 2147483647) + { + return ctx -> int_type; + } + else + { + return ctx -> longint_type; + } +} + static oberon_expr_t * oberon_factor(oberon_context_t * ctx) { oberon_expr_t * expr; + oberon_type_t * result; switch(ctx -> token) { @@ -1270,23 +1361,25 @@ oberon_factor(oberon_context_t * ctx) expr = oberon_opt_func_parens(ctx, expr); break; case INTEGER: - expr = oberon_new_item(MODE_INTEGER, ctx -> int_type, 1); + result = oberon_get_type_of_int_value(ctx, ctx -> integer); + expr = oberon_new_item(MODE_INTEGER, result, 1); expr -> item.integer = ctx -> integer; oberon_assert_token(ctx, INTEGER); break; case REAL: - expr = oberon_new_item(MODE_REAL, ctx -> real_type, 1); + result = (ctx -> longmode) ? (ctx -> longreal_type) : (ctx -> real_type); + expr = oberon_new_item(MODE_REAL, result, 1); expr -> item.real = ctx -> real; oberon_assert_token(ctx, REAL); break; case TRUE: expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, 1); - expr -> item.boolean = 1; + expr -> item.boolean = true; oberon_assert_token(ctx, TRUE); break; case FALSE: expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, 1); - expr -> item.boolean = 0; + expr -> item.boolean = false; oberon_assert_token(ctx, FALSE); break; case LPAREN: @@ -1310,41 +1403,6 @@ oberon_factor(oberon_context_t * ctx) return expr; } -/* - * oberon_autocast_binary_op автоматически переобразовывеат тип по след. правилам: - * 1. Классы обоих типов должны быть одинаковы - * 2. В качестве результата должен быть выбран больший тип. - * 3. Если размер результат не должен быть меньше чем базовый int - */ - -static void -oberon_autocast_binary_op(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b, oberon_type_t ** result) -{ - if((a -> class) != (b -> class)) - { - oberon_error(ctx, "incompatible types"); - } - - if((a -> size) > (b -> size)) - { - *result = a; - } - else - { - *result = b; - } - - if(((*result) -> class) == OBERON_TYPE_INTEGER) - { - if(((*result) -> size) < (ctx -> int_type -> size)) - { - *result = ctx -> int_type; - } - } - - /* TODO: cast types */ -} - #define ITMAKESBOOLEAN(x) \ (((x) >= EQUAL && (x) <= GEQ) || ((x) == OR) || ((x) == AND)) @@ -1444,8 +1502,8 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ } } - oberon_autocast_binary_op(ctx, a -> result, b -> result, &result); - expr = oberon_new_operator(OP_DIV, result, a, b); + oberon_autocast_binary_op(ctx, &a, &b); + expr = oberon_new_operator(OP_DIV, a -> result, a, b); } else if(token == DIV) { @@ -1455,28 +1513,28 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ oberon_error(ctx, "operator DIV requires integer type"); } - oberon_autocast_binary_op(ctx, a -> result, b -> result, &result); - expr = oberon_new_operator(OP_DIV, result, a, b); + oberon_autocast_binary_op(ctx, &a, &b); + expr = oberon_new_operator(OP_DIV, a -> result, a, b); } else { - oberon_autocast_binary_op(ctx, a -> result, b -> result, &result); + oberon_autocast_binary_op(ctx, &a, &b); if(token == PLUS) { - expr = oberon_new_operator(OP_ADD, result, a, b); + expr = oberon_new_operator(OP_ADD, a -> result, a, b); } else if(token == MINUS) { - expr = oberon_new_operator(OP_SUB, result, a, b); + expr = oberon_new_operator(OP_SUB, a -> result, a, b); } else if(token == STAR) { - expr = oberon_new_operator(OP_MUL, result, a, b); + expr = oberon_new_operator(OP_MUL, a -> result, a, b); } else if(token == MOD) { - expr = oberon_new_operator(OP_MOD, result, a, b); + expr = oberon_new_operator(OP_MOD, a -> result, a, b); } else { @@ -1814,7 +1872,7 @@ oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr) oberon_error(ctx, "procedure requires expression on result"); } - oberon_autocast_to(ctx, expr, result_type); + expr = oberon_autocast_to(ctx, expr, result_type); } proc -> has_return = 1; @@ -2551,7 +2609,7 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst) oberon_error(ctx, "read-only destination"); } - oberon_autocast_to(ctx, src, dst -> result); + src = oberon_autocast_to(ctx, src, dst -> result); oberon_generate_assign(ctx, src, dst); } @@ -2720,14 +2778,26 @@ register_default_types(oberon_context_t * ctx) ctx -> void_ptr_type -> base = ctx -> void_type; oberon_generator_init_type(ctx, ctx -> void_ptr_type); - ctx -> int_type = oberon_new_type_integer(sizeof(int)); + ctx -> bool_type = oberon_new_type_boolean(); + oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type, 1); + + ctx -> byte_type = oberon_new_type_integer(1); + oberon_define_type(ctx -> world_scope, "BYTE", ctx -> byte_type, 1); + + ctx -> shortint_type = oberon_new_type_integer(2); + oberon_define_type(ctx -> world_scope, "SHORTINT", ctx -> shortint_type, 1); + + ctx -> int_type = oberon_new_type_integer(4); oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type, 1); - ctx -> bool_type = oberon_new_type_boolean(sizeof(bool)); - oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type, 1); + ctx -> longint_type = oberon_new_type_integer(8); + oberon_define_type(ctx -> world_scope, "LONGINT", ctx -> longint_type, 1); - ctx -> real_type = oberon_new_type_real(sizeof(float)); + ctx -> real_type = oberon_new_type_real(4); oberon_define_type(ctx -> world_scope, "REAL", ctx -> real_type, 1); + + ctx -> longreal_type = oberon_new_type_real(8); + oberon_define_type(ctx -> world_scope, "LONGREAL", ctx -> longreal_type, 1); } static void @@ -2888,6 +2958,8 @@ oberon_compile_module(oberon_context_t * ctx, const char * newcode) int token = ctx -> token; char * string = ctx -> string; int integer = ctx -> integer; + int real = ctx -> real; + bool longmode = ctx -> longmode; oberon_scope_t * decl = ctx -> decl; oberon_module_t * mod = ctx -> mod; @@ -2913,6 +2985,8 @@ oberon_compile_module(oberon_context_t * ctx, const char * newcode) ctx -> token = token; ctx -> string = string; ctx -> integer = integer; + ctx -> real = real; + ctx -> longmode = longmode; ctx -> decl = decl; ctx -> mod = mod; diff --git a/src/test.c b/src/test.c index 5939fb6..2c5fb04 100644 --- a/src/test.c +++ b/src/test.c @@ -8,50 +8,45 @@ static char source_test[] = "(* Main module *)" "MODULE Test;" "IMPORT Out;" - "TYPE" - " P = PROCEDURE;" - " F = PROCEDURE (x : INTEGER) : INTEGER;" "" "VAR" - " p : P;" - " f : F;" - " i : INTEGER;" + " byte : BYTE;" + " short : SHORTINT;" + " int : INTEGER;" + " long : LONGINT;" + " real : REAL;" + " longreal : LONGREAL;" "" - "PROCEDURE Pow(x : INTEGER) : INTEGER;" "BEGIN" - " RETURN x * x;" - "END Pow;" - "" - "PROCEDURE Do;" - "END Do;" - "" - "BEGIN;" - " p := Do;" - " f := Pow;" - " i := f(7);" - " p;" " Out.Open;" - " Out.Int(i, 0); Out.Ln;" + " byte := 127;" + " int := 666;" + " long := int;" + " real := int;" + " longreal := int;" " Out.Int(666, 0); Out.Ln;" + " Out.Int(byte, 0); Out.Ln;" + " Out.LongReal(real, 0); Out.Ln;" "END Test." ; // PROCEDURE Char* (ch : CHAR); // PROCEDURE String* (str : ARRAY OF CHAR); -// PROCEDURE Int* (i, n : LONGINT); // Должно быть в таком виде -// PROCEDURE LongReal* (x : LONGREAL; n : INTEGER); static char source_out[] = "MODULE Out;" " PROCEDURE Open*;" " END Open;" "" - " PROCEDURE Int*(i, n : INTEGER);" + " PROCEDURE Int*(i, n : LONGINT);" " END Int;" "" " PROCEDURE Real*(x : REAL; n : INTEGER);" " END Real;" "" + " PROCEDURE LongReal*(x : LONGREAL; n : INTEGER);" + " END LongReal;" + "" " PROCEDURE Ln*;" " END Ln;" "" -- 2.29.2