From: DeaDDooMER <deaddoomer@deadsoftware.ru>
Date: Thu, 27 Jul 2017 10:26:19 +0000 (+0300)
Subject: JVM: Реализован доступ к полям записей и NEW для записей(без инициализации полей)
X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=351f950548241d4c4bd799acabbcd98a39b096cc;p=dsw-obn.git

JVM: Реализован доступ к полям записей и NEW для записей(без инициализации полей)
---

diff --git a/notes b/notes
index c6cd902..60b17bd 100644
--- a/notes
+++ b/notes
@@ -1,5 +1,3 @@
-- унарный минус имеет не правильный приоритет
-
 - нет символов и строк
 - нужен автокаст int -> real для DIV. Да и вообще каст типов.
 
diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c
index eb0f3dc..215f6d7 100644
--- a/src/backends/jvm/generator-jvm.c
+++ b/src/backends/jvm/generator-jvm.c
@@ -96,6 +96,9 @@ get_descriptor(oberon_context_t * ctx, oberon_type_t * type)
 		case OBERON_TYPE_BOOLEAN:
 			return new_string("Z");
 			break;
+		case OBERON_TYPE_POINTER:
+			return get_descriptor(ctx, type -> base);
+			break;
 		case OBERON_TYPE_PROCEDURE:
 		case OBERON_TYPE_RECORD:
 			desc = get_class_full_name(ctx, type);
@@ -141,7 +144,21 @@ get_prefix(oberon_context_t * ctx, oberon_type_t * type)
 static char *
 get_field_full_name(oberon_context_t * ctx, oberon_object_t * x)
 {
-	return new_string("%s/%s", x -> module -> name, x -> name);
+	switch(x -> class)
+	{
+		case OBERON_CLASS_VAR:
+			return new_string("%s/%s", x -> module -> name, x -> name);
+		case OBERON_CLASS_FIELD:;
+			char * rec_name = get_class_full_name(ctx, x -> parent_type);
+			return new_string("%s/%s", rec_name, x -> name);
+		case OBERON_CLASS_MODULE:
+			return new_string(x -> module -> name);
+		default:
+			oberon_error(ctx, "get_field_full_name: wat");
+			break;
+	}
+
+	return NULL;
 }
 
 static char *
@@ -170,8 +187,6 @@ get_class_full_name(oberon_context_t * ctx, oberon_type_t * type)
 
 			break;
 		case OBERON_TYPE_RECORD:
-			assert(type -> module);
-			assert(type -> module -> gen_mod);
 			rec_id = type -> gen_type -> rec_id;
 			name = new_string("%s$RECORD%i", type -> module -> name, rec_id);
 			break;
@@ -282,7 +297,6 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
 			oberon_generate_procedure_class(ctx, type);
 			break;
 		case OBERON_TYPE_POINTER:
-			assert(type -> base -> class == OBERON_TYPE_VOID);
 			break;
 		default:
 			oberon_error(ctx, "oberon_generator_init_type: unk calss %i", type -> class);
@@ -301,7 +315,10 @@ oberon_generate_object(oberon_context_t * ctx, FILE * fp, oberon_object_t * x)
 	switch(x -> class)
 	{
 		case OBERON_CLASS_VAR:
-			fprintf(fp, ".field public static %s %s\n\n", name, desc);
+			if(x -> local == 0)
+			{
+				fprintf(fp, ".field public static %s %s\n\n", name, desc);
+			}
 			break;
 		case OBERON_CLASS_FIELD:
 			fprintf(fp, ".field public %s %s\n\n", name, desc);
@@ -713,6 +730,44 @@ push_var(oberon_context_t * ctx, FILE * fp, oberon_object_t * var)
 	}
 }
 
+static void
+jvm_generate_new_static(oberon_context_t * ctx, FILE * fp, oberon_type_t * type, int num, oberon_expr_t * arg)
+{
+	//char * desc;
+	char * cname;
+	//desc = get_descriptor(ctx, type);
+	cname = get_class_full_name(ctx, type);
+
+	switch(type -> class)
+	{
+		case OBERON_TYPE_INTEGER:
+		case OBERON_TYPE_BOOLEAN:
+		case OBERON_TYPE_PROCEDURE:
+		case OBERON_TYPE_REAL:
+		case OBERON_TYPE_POINTER:
+			/* ничего не генерируем */
+			break;
+		case OBERON_TYPE_RECORD:
+			fprintf(fp, "new %s\n", cname);
+			fprintf(fp, "dup\n");
+			fprintf(fp, "invokespecial %s/<init>()V\n", cname); 
+			break;
+		case OBERON_TYPE_ARRAY:
+			oberon_error(ctx, "jvm_generate_new_static: TODO array");
+			break;
+		default:
+			oberon_error(ctx, "jvm_generate_new_static: unk type class %i", type -> class);
+			break;
+	}
+}
+
+static void
+jvm_generate_new_pointer(oberon_context_t * ctx, FILE * fp, oberon_type_t * type, int num, oberon_expr_t * arg)
+{
+	assert(type -> class == OBERON_TYPE_POINTER);
+	jvm_generate_new_static(ctx, fp, type -> base, num, arg);
+}
+
 static void
 push_item(oberon_context_t * ctx, FILE * fp, oberon_item_t * item)
 {
@@ -734,16 +789,20 @@ push_item(oberon_context_t * ctx, FILE * fp, oberon_item_t * item)
 			oberon_error(ctx, "push_item: TODO index");
 			break;
 		case MODE_FIELD:
-			oberon_error(ctx, "push_item: TODO field");
+			push_item(ctx, fp, item -> parent);
+			char * field = get_field_full_name(ctx, item -> var);
+			char * desc = get_descriptor(ctx, item -> var -> type);
+			fprintf(fp, "getfield %s %s\n", field, desc);
 			break;
 		case MODE_DEREF:
-			oberon_error(ctx, "push_item: TODO deref");
+			/* Все объекты представляются как увказатели */
+			push_item(ctx, fp, item -> parent);
 			break;
 		case MODE_NIL:
 			fprintf(fp, "aconst_null\n");
 			break;
 		case MODE_NEW:
-			oberon_error(ctx, "push_item: TODO new");
+			jvm_generate_new_pointer(ctx, fp, item -> result, item -> num_args, item -> args);
 			break;
 		case MODE_REAL:
 			push_float(fp, item -> real, item -> result -> size);
@@ -1019,15 +1078,16 @@ push_expr(oberon_context_t * ctx, FILE * fp, oberon_expr_t * expr)
 }
 
 static void
-store_expr(oberon_context_t * ctx, FILE * fp, oberon_expr_t * expr)
+store_expr(oberon_context_t * ctx, FILE * fp, oberon_expr_t * dst, oberon_expr_t * src)
 {
-	assert(expr -> is_item);
-	oberon_item_t * item = (oberon_item_t *) expr;
+	assert(dst -> is_item);
+	oberon_item_t * item = (oberon_item_t *) dst;
 
 	char prefix;
 	switch(item -> mode)
 	{
 		case MODE_VAR:
+			push_expr(ctx, fp, src);
 			if(item -> var -> local)
 			{
 				int reg = item -> var -> gen_var -> reg;
@@ -1041,6 +1101,21 @@ store_expr(oberon_context_t * ctx, FILE * fp, oberon_expr_t * expr)
 				fprintf(fp, "putstatic %s %s\n", fullname, desc);
 			}
 			break;
+		case MODE_INDEX:
+			oberon_error(ctx, "store_expr: TODO index");
+			break;
+		case MODE_FIELD:
+			{
+				char * fullname = get_field_full_name(ctx, item -> var);
+				char * desc = get_descriptor(ctx, item -> result);
+				printf("push parent\n");
+				push_item(ctx, fp, item -> parent);
+				printf("push expr\n");
+				push_expr(ctx, fp, src);
+				printf("store to field %s:%s\n", fullname, desc);
+				fprintf(fp, "putfield %s %s ; store field\n", fullname, desc);
+			}
+			break;
 		default:
 			oberon_error(ctx, "store_expr: unk mode %i", item -> mode);
 			break;
@@ -1053,8 +1128,7 @@ oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_
 	gen_module_t * m;
 	m = ctx -> mod -> gen_mod;
 
-	push_expr(ctx, m -> fp, src);
-	store_expr(ctx, m -> fp, dst);
+	store_expr(ctx, m -> fp, dst, src);
 }
 
 void
diff --git a/src/oberon-internals.h b/src/oberon-internals.h
index a6174c3..d6c3881 100644
--- a/src/oberon-internals.h
+++ b/src/oberon-internals.h
@@ -24,8 +24,9 @@ struct oberon_scope_t
 	oberon_object_t * list;
 	oberon_scope_t * up;
 
-	oberon_object_t * parent;
 	int local;
+	oberon_object_t * parent;
+	oberon_type_t * parent_type;
 };
 
 enum
@@ -83,6 +84,7 @@ struct oberon_object_t
 	int initialized;
 
 	oberon_object_t * parent;
+	oberon_type_t * parent_type;
 
 	oberon_scope_t * scope; // for proc
 	int has_return; // for proc
diff --git a/src/oberon.c b/src/oberon.c
index 382f4f1..09a6b88 100644
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -131,8 +131,9 @@ oberon_open_scope(oberon_context_t * ctx)
 
 	if(scope -> up)
 	{
-		scope -> parent = scope -> up -> parent;
 		scope -> local = scope -> up -> local;
+		scope -> parent = scope -> up -> parent;
+		scope -> parent_type = scope -> up -> parent_type;
 	}
 
 	ctx -> decl = scope;
@@ -168,6 +169,7 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class, int export,
 	newvar -> read_only = read_only;
 	newvar -> local = scope -> local;
 	newvar -> parent = scope -> parent;
+	newvar -> parent_type = scope -> parent_type;
 	newvar -> module = scope -> ctx -> mod;
 
 	x -> next = newvar;
@@ -1527,6 +1529,12 @@ oberon_simple_expr(oberon_context_t * ctx)
 	}
 
 	expr = oberon_term_expr(ctx);
+
+	if(minus)
+	{
+		expr = oberon_make_unary_op(ctx, MINUS, expr);
+	}
+
 	while(ISADDOP(ctx -> token))
 	{
 		int token = ctx -> token;
@@ -1536,11 +1544,6 @@ oberon_simple_expr(oberon_context_t * ctx)
 		expr = oberon_make_bin_op(ctx, token, expr, inter);
 	}
 
-	if(minus)
-	{
-		expr = oberon_make_unary_op(ctx, MINUS, expr);
-	}
-
 	return expr;
 }
 
@@ -2087,9 +2090,9 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
 
 		oberon_scope_t * record_scope;
 		record_scope = oberon_open_scope(ctx);
-		// TODO parent object
-		//record_scope -> parent = NULL;
 		record_scope -> local = 1;
+		record_scope -> parent = NULL;
+		record_scope -> parent_type = rec;
 
 		oberon_assert_token(ctx, RECORD);
 		oberon_field_list(ctx, rec);
diff --git a/src/test.c b/src/test.c
index 6543c47..8d2a44f 100644
--- a/src/test.c
+++ b/src/test.c
@@ -7,22 +7,17 @@
 static char source_test[] =
 	"(* Main module *)"
 	"MODULE Test;"
+	"TYPE"
+	"  Rec = POINTER TO RecDesc;"
+	"  RecDesc = RECORD n, m, h : INTEGER END;"
 	"VAR"
-	"  x : INTEGER;"
-	"  b : BOOLEAN;"
-	""
-	"PROCEDURE Tier(x : INTEGER) : INTEGER;"
-	"VAR"
-	"  y, z, w : INTEGER;"
-	"BEGIN"
-	"  y := 7777;"
-	"  RETURN x * x + y;"
-	"END Tier;"
+	"  r : Rec;"
+	"  i : INTEGER;"
 	""
 	"BEGIN;"
-	"  x := ABS(-666);"
-	"  x := Tier(x);"
-	"  b := TRUE OR FALSE;"
+	"  NEW(r);"
+	"  i := 666;"
+	"  r.n := r.m;"
 	"END Test."
 ;