From c055d16f1d6ca38c5c2171dbafd1a25305fb909c Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Tue, 1 Aug 2017 20:56:01 +0300 Subject: [PATCH] =?utf8?q?=D0=A2=D0=B5=D0=BF=D0=B5=D1=80=D1=8C=20=D0=B2?= =?utf8?q?=D0=BE=D0=B7=D0=BC=D0=BE=D0=B6=D0=B5=D0=BD=20=D0=B2=D1=8B=D0=B7?= =?utf8?q?=D0=BE=D0=B2=20=D0=BF=D1=80=D0=BE=D1=86=D0=B5=D0=B4=D1=83=D1=80-?= =?utf8?q?=D0=BF=D0=B5=D1=80=D0=B5=D0=BC=D0=B5=D0=BD=D0=BD=D1=8B=D1=85=20?= =?utf8?q?=D0=B8=D0=B7=20=D0=BF=D0=BE=D0=BB=D0=B5=D0=B9=20=D0=B7=D0=B0?= =?utf8?q?=D0=BF=D0=B8=D1=81=D0=B5=D0=B9?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- notes | 6 +- src/backends/jvm/generator-jvm.c | 72 +++++++++------- src/oberon-internals.h | 20 +++-- src/oberon.c | 141 ++++++++++++++++++------------- src/test.c | 40 ++++++--- 5 files changed, 164 insertions(+), 115 deletions(-) diff --git a/notes b/notes index 2f6fc26..7431ec7 100644 --- a/notes +++ b/notes @@ -1,9 +1,5 @@ -- Нет оператора IS -- Нужно изменить передачу информации о вызываемой процедуре в MODE_CALL - На данный момент конкретная процедура передаётся в поле var, вместо parent - Что не позволяет делать процедуры-переменные в полях записей, массивах и т.д. - - нет символов и строк +- Нет оператора IS - нету типа set - нету операторов if, while и т.д. diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c index 8c9d69f..d986a8e 100644 --- a/src/backends/jvm/generator-jvm.c +++ b/src/backends/jvm/generator-jvm.c @@ -166,7 +166,7 @@ jvm_generate_push_int(gen_proc_t * p, int64_t i) } else { - jvm_generate(p, 0, 2, "ldc2 %li", i); + jvm_generate(p, 0, 2, "ldc2_w %li", i); } } @@ -198,7 +198,7 @@ jvm_generate_push_int_size(gen_proc_t * p, int64_t i, int size) else { pushed_cell = 2; - jvm_generate(p, 0, 2, "ldc2 %li", i); + jvm_generate(p, 0, 2, "ldc2_w %li", i); } assert(size <= 8); @@ -258,7 +258,7 @@ jvm_generate_push_float(gen_proc_t * p, double f, int size) } else { - jvm_generate(p, 0, 2, "ldc2 %lf", f); + jvm_generate(p, 0, 2, "ldc2_w %lf", f); } } } @@ -689,6 +689,9 @@ jvm_generate_push_procedure_pointer(gen_proc_t * p, oberon_object_t * proc) // ========================================== // ========================================== +static void +push_item(gen_proc_t * p, oberon_item_t * item); + void oberon_generator_init_context(oberon_context_t * ctx) { @@ -1224,30 +1227,39 @@ oberon_generate_end_proc(oberon_context_t * ctx) } static void -jvm_generate_call_proc(gen_proc_t * p, oberon_expr_t * desig) +jvm_generate_call_proc(gen_proc_t * p, oberon_item_t * desig) { - assert(desig -> is_item); - assert(desig -> item.mode == MODE_CALL); - - oberon_object_t * proc; - char * fullname; - char * signature; + assert(desig -> var == NULL); + assert(desig -> mode == MODE_CALL); - proc = desig -> item.var; - fullname = jvm_get_field_full_name(proc); - signature = jvm_get_procedure_signature(proc -> type); + char * signature = NULL; + + bool direct_call = false; + if(desig -> parent -> mode == MODE_VAR) + { + if(desig -> parent -> var -> class == OBERON_CLASS_PROC) + { + direct_call = true; + } + } + + printf("direct_call == %i\n", direct_call); + + oberon_type_t * procsig; + procsig = desig -> parent -> result; + signature = jvm_get_procedure_signature(procsig); - if(proc -> class != OBERON_CLASS_PROC) + if(direct_call == false) { /* Загружаем указатель на процедуру */ - jvm_generate_load(p, proc -> type, proc -> gen_var); + push_item(p, desig -> parent); } int args_cells = 0; - int result_cells = jvm_cell_size_for_type(proc -> type -> base); + int result_cells = jvm_cell_size_for_type(procsig -> base); - int num = desig -> item.num_args; - oberon_expr_t * arg = desig -> item.args; + int num = desig -> num_args; + oberon_expr_t * arg = desig -> args; for(int i = 0; i < num; i++) { args_cells += jvm_cell_size_for_type(arg -> result); @@ -1255,23 +1267,23 @@ jvm_generate_call_proc(gen_proc_t * p, oberon_expr_t * desig) arg = arg -> next; } - if(proc -> class == OBERON_CLASS_PROC) + if(direct_call) { - /* Обычная статическая процедура */ - jvm_generate(p, args_cells, result_cells, "invokestatic %s%s", fullname, signature); + char * full_name = jvm_get_field_full_name(desig -> parent -> var); + jvm_generate(p, args_cells, result_cells, "invokestatic %s%s", full_name, signature); } else { - /* Процедура-переменная */ - char * class = jvm_get_class_full_name(proc -> type); - jvm_generate(p, 1 + args_cells, result_cells, "invokevirtual %s/invoke%s", class, signature); + char * cname = jvm_get_class_full_name(procsig); + jvm_generate(p, 1 + args_cells, result_cells, "invokevirtual %s/invoke%s", cname, signature); } } void oberon_generate_call_proc(oberon_context_t * ctx, oberon_expr_t * desig) { - jvm_generate_call_proc(ctx -> mod -> gen_mod -> class -> p, desig); + assert(desig -> is_item); + jvm_generate_call_proc(ctx -> mod -> gen_mod -> class -> p, (oberon_item_t *) desig); } void @@ -1360,7 +1372,7 @@ push_item(gen_proc_t * p, oberon_item_t * item) jvm_generate_push_int_size(p, item -> boolean, item -> result -> size); break; case MODE_CALL: - jvm_generate_call_proc(p, (oberon_expr_t *) item); + jvm_generate_call_proc(p, item); break; case MODE_INDEX: ; @@ -1390,10 +1402,6 @@ 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_expr(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; @@ -1573,6 +1581,10 @@ push_operator(gen_proc_t * p, oberon_oper_t * oper) int op = oper -> op; switch(op) { + case OP_CAST: + push_expr(p, oper -> left); + jvm_generate_cast_type(p, oper -> left -> result, oper -> result); + break; case OP_UNARY_MINUS: case OP_BITWISE_NOT: case OP_LOGIC_NOT: diff --git a/src/oberon-internals.h b/src/oberon-internals.h index 1e92de1..c28cfa5 100644 --- a/src/oberon-internals.h +++ b/src/oberon-internals.h @@ -44,6 +44,9 @@ enum OBERON_TYPE_REAL }; +typedef oberon_expr_t * (*GenerateFuncCallback)(oberon_context_t *, int, oberon_expr_t *); +typedef void (*GenerateProcCallback)(oberon_context_t *, int, oberon_expr_t *); + struct oberon_type_t { int class; @@ -54,6 +57,10 @@ struct oberon_type_t oberon_object_t * decl; oberon_scope_t * scope; + bool sysproc; + GenerateFuncCallback genfunc; + GenerateProcCallback genproc; + oberon_module_t * module; int recursive; @@ -73,9 +80,6 @@ enum OBERON_CLASS_MODULE }; -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_t { char * name; @@ -92,9 +96,6 @@ struct oberon_object_t 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; @@ -167,7 +168,6 @@ enum MODE_NIL, MODE_NEW, MODE_REAL, - MODE_CAST }; enum @@ -193,7 +193,9 @@ enum OP_LSS, OP_LEQ, OP_GRT, - OP_GEQ + OP_GEQ, + + OP_CAST }; struct oberon_item_t @@ -209,7 +211,7 @@ struct oberon_item_t int boolean; oberon_object_t * var; - oberon_expr_t * parent; + oberon_item_t * parent; int num_args; oberon_expr_t * args; diff --git a/src/oberon.c b/src/oberon.c index cefd469..570db39 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -33,6 +33,8 @@ enum { LEQ, GREAT, GEQ, + IN, + IS, PLUS, MINUS, OR, @@ -350,6 +352,14 @@ oberon_read_ident(oberon_context_t * ctx) { ctx -> token = IMPORT; } + else if(strcmp(ident, "IN") == 0) + { + ctx -> token = IN; + } + else if(strcmp(ident, "IS") == 0) + { + ctx -> token = IS; + } } static void @@ -760,11 +770,7 @@ 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) { - oberon_expr_t * cast; - cast = oberon_new_item(MODE_CAST, pref, expr -> read_only); - cast -> item.parent = expr; - cast -> next = expr -> next; - return cast; + return oberon_new_operator(OP_CAST, pref, expr, NULL); } static oberon_expr_t * @@ -893,25 +899,15 @@ oberon_autocast_binary_op(oberon_context_t * ctx, oberon_expr_t ** ea, oberon_ex } static void -oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) +oberon_autocast_call(oberon_context_t * ctx, oberon_item_t * desig) { - if(desig -> is_item == 0) - { - oberon_error(ctx, "expected item"); - } - - if(desig -> item.mode != MODE_CALL) + if(desig -> mode != MODE_CALL) { oberon_error(ctx, "expected mode CALL"); } - if(desig -> item.var -> type -> class != OBERON_TYPE_PROCEDURE) - { - oberon_error(ctx, "only procedures can be called"); - } - - oberon_type_t * fn = desig -> item.var -> type; - int num_args = desig -> item.num_args; + oberon_type_t * fn = desig -> parent -> result; + int num_args = desig -> num_args; int num_decl = fn -> num_decl; if(num_args < num_decl) @@ -925,7 +921,7 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) /* Делаем проверку на запись и делаем автокаст */ oberon_expr_t * casted[num_args]; - oberon_expr_t * arg = desig -> item.args; + oberon_expr_t * arg = desig -> args; oberon_object_t * param = fn -> decl; for(int i = 0; i < num_args; i++) { @@ -950,62 +946,84 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) { casted[i] -> next = casted[i + 1]; } - desig -> item.args = arg; + desig -> args = arg; } } static oberon_expr_t * -oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args) +oberon_make_call_func(oberon_context_t * ctx, oberon_item_t * item, int num_args, oberon_expr_t * list_args) { - switch(proc -> class) + oberon_type_t * signature = item -> result; + if(signature -> class != OBERON_TYPE_PROCEDURE) { - 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; + oberon_error(ctx, "not a procedure"); } oberon_expr_t * call; - if(proc -> sysproc) + if(signature -> sysproc) { - if(proc -> genfunc == NULL) + if(signature -> genfunc == NULL) { oberon_error(ctx, "not a function-procedure"); } - call = proc -> genfunc(ctx, num_args, list_args); + call = signature -> genfunc(ctx, num_args, list_args); } else { - if(proc -> type -> base -> class == OBERON_TYPE_VOID) + if(signature -> base -> class == OBERON_TYPE_VOID) { oberon_error(ctx, "attempt to call procedure in expression"); } - call = oberon_new_item(MODE_CALL, proc -> type -> base, 1); - call -> item.var = proc; + call = oberon_new_item(MODE_CALL, signature -> base, true); + call -> item.parent = item; call -> item.num_args = num_args; call -> item.args = list_args; - oberon_autocast_call(ctx, call); + oberon_autocast_call(ctx, (oberon_item_t *) call); } return call; } +static void +oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args, oberon_expr_t * list_args) +{ + oberon_type_t * signature = item -> result; + if(signature -> class != OBERON_TYPE_PROCEDURE) + { + oberon_error(ctx, "not a procedure"); + } + + oberon_expr_t * call; + + if(signature -> sysproc) + { + if(signature -> genproc == NULL) + { + oberon_error(ctx, "not a procedure"); + } + + signature -> genproc(ctx, num_args, list_args); + } + else + { + if(signature -> base -> class != OBERON_TYPE_VOID) + { + oberon_error(ctx, "attempt to call function as non-typed procedure"); + } + + call = oberon_new_item(MODE_CALL, signature -> base, true); + call -> item.parent = item; + call -> item.num_args = num_args; + call -> item.args = list_args; + oberon_autocast_call(ctx, (oberon_item_t *) call); + oberon_generate_call_proc(ctx, call); + } +} + +/* static void oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args) { @@ -1055,6 +1073,7 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_ar oberon_generate_call_proc(ctx, call); } } +*/ #define ISEXPR(x) \ (((x) == PLUS) \ @@ -1078,7 +1097,7 @@ oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr) oberon_expr_t * selector; selector = oberon_new_item(MODE_DEREF, expr -> result -> base, expr -> read_only); - selector -> item.parent = expr; + selector -> item.parent = (oberon_item_t *) expr; return selector; } @@ -1125,7 +1144,7 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon oberon_expr_t * selector; selector = oberon_new_item(MODE_INDEX, base, desig -> read_only); - selector -> item.parent = desig; + selector -> item.parent = (oberon_item_t *) desig; selector -> item.num_args = 1; selector -> item.args = index; @@ -1140,7 +1159,7 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * expr = oberno_make_dereferencing(ctx, expr); } - assert(expr -> is_item == 1); + assert(expr -> is_item); if(expr -> result -> class != OBERON_TYPE_RECORD) { @@ -1172,7 +1191,7 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * oberon_expr_t * selector; selector = oberon_new_item(MODE_FIELD, field -> type, read_only); selector -> item.var = field; - selector -> item.parent = expr; + selector -> item.parent = (oberon_item_t *) expr; return selector; } @@ -1254,7 +1273,8 @@ oberon_designator(oberon_context_t * ctx) } expr -> item.var = var; - while(ISSELECTOR(ctx -> token)) + bool brk = false; + while(brk == false && ISSELECTOR(ctx -> token)) { switch(ctx -> token) { @@ -1281,6 +1301,11 @@ oberon_designator(oberon_context_t * ctx) expr = oberno_make_dereferencing(ctx, expr); break; case LPAREN: + if(expr -> result -> class == OBERON_TYPE_PROCEDURE) + { + brk = true; + break; + } oberon_assert_token(ctx, LPAREN); oberon_object_t * objtype = oberon_qualident(ctx, NULL, 1); if(objtype -> class != OBERON_CLASS_TYPE) @@ -1316,7 +1341,7 @@ oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr) oberon_expr_list(ctx, &num_args, &arguments, 0); } - expr = oberon_make_call_func(ctx, expr -> item.var, num_args, arguments); + expr = oberon_make_call_func(ctx, (oberon_item_t *) expr, num_args, arguments); oberon_assert_token(ctx, RPAREN); } @@ -1345,7 +1370,7 @@ oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr) } /* Вызов происходит даже без скобок */ - oberon_make_call_proc(ctx, expr -> item.var, num_args, arguments); + oberon_make_call_proc(ctx, (oberon_item_t *) expr, num_args, arguments); } static oberon_type_t * @@ -1629,7 +1654,7 @@ oberon_simple_expr(oberon_context_t * ctx) } #define ISRELATION(x) \ - ((x) >= EQUAL && (x) <= GEQ) + ((x) >= EQUAL && (x) <= IS) static oberon_expr_t * oberon_expr(oberon_context_t * ctx) @@ -2870,10 +2895,10 @@ oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f { oberon_object_t * proc; proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, true, false, false); - proc -> sysproc = 1; - proc -> genfunc = f; - proc -> genproc = p; proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE); + proc -> type -> sysproc = true; + proc -> type -> genfunc = f; + proc -> type -> genproc = p; } static oberon_expr_t * diff --git a/src/test.c b/src/test.c index c6d49e4..3305807 100644 --- a/src/test.c +++ b/src/test.c @@ -9,24 +9,38 @@ static char source_test[] = "MODULE Test;" "IMPORT Out;" "TYPE" - " Baser = RECORD a : INTEGER; END;" - " R1 = RECORD (Baser)" - " b : R2;" - " END;" - " " - " R2 = RECORD" - " a : POINTER TO R1;" + " Callback = PROCEDURE;" + " Callfront = PROCEDURE(x : LONGINT) : LONGINT;" + " RecDesc = RECORD" + " cb : Callback;" + " cf : Callfront;" " END;" "" "VAR" - " baser : Baser;" - " r : R1;" - " inv : R2;" + " r : RecDesc;" + " i : LONGINT;" + "" + "PROCEDURE Stuff;" + "BEGIN" + " Out.Int(0123456789, 0); Out.Ln;" + "END Stuff;" + "" + "PROCEDURE Ffuts (x : LONGINT) : LONGINT;" + "BEGIN" + " RETURN 9876543210 + x;" + "END Ffuts;" "" "BEGIN" - " r.a := 1;" - " baser := baser;" - " baser := r;" + " Out.Open;" + " Out.Int(1, 0); Out.Ln;" + " r.cb := Stuff;" + " Out.Int(2, 0); Out.Ln;" + " r.cb();" + " Out.Int(3, 0); Out.Ln;" + " r.cf := Ffuts;" + " Out.Int(4, 0); Out.Ln;" + " i := r.cf(0123456789);" + " Out.Int(i, 0); Out.Ln;" "END Test." ; -- 2.29.2