X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=oberon.c;h=ac695d384bd17567d76620269a3ad02ac3929d57;hb=2d029d2c2b27639e3a2b6c43e63788b00110818e;hp=b7ffd0ea73ab2b9cd366a04d96a2b1e16a80a94d;hpb=060a955ff58efde6cb51ab18eaed8f479e2550f3;p=dsw-obn.git

diff --git a/oberon.c b/oberon.c
index b7ffd0e..ac695d3 100644
--- a/oberon.c
+++ b/oberon.c
@@ -118,6 +118,12 @@ oberon_open_scope(oberon_context_t * ctx)
 	scope -> list = list;
 	scope -> up = ctx -> decl;
 
+	if(scope -> up)
+	{
+		scope -> parent = scope -> up -> parent;
+		scope -> local = scope -> up -> local;
+	}
+
 	ctx -> decl = scope;
 	return scope;
 }
@@ -147,6 +153,8 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class)
 	memset(newvar, 0, sizeof *newvar);
 	newvar -> name = name;
 	newvar -> class = class;
+	newvar -> local = scope -> local;
+	newvar -> parent = scope -> parent;
 
 	x -> next = newvar;
 
@@ -156,6 +164,8 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class)
 static void
 oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char *  name, oberon_type_t * type)
 {
+	// TODO check base fields
+
 	oberon_object_t * x = rec -> decl;
 	while(x -> next && strcmp(x -> next -> name, name) != 0)
 	{
@@ -172,6 +182,8 @@ oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char *  name, o
 	field -> name = name;
 	field -> class = OBERON_CLASS_FIELD;
 	field -> type = type;
+	field -> local = 1;
+	field -> parent = NULL;
 
 	rec -> num_decl += 1;
 	x -> next = field;
@@ -739,6 +751,24 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
 	oberon_object_t * param = fn -> decl;
 	for(int i = 0; i < num_args; i++)
 	{
+		if(param -> class == OBERON_CLASS_VAR_PARAM)
+		{
+			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);
 		arg = arg -> next;
 		param = param -> next;
@@ -790,14 +820,12 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon
 	oberon_type_t * base;
 	base = desig -> result -> base;
 
-	// TODO check ranges
-
-	printf("oberon_make_array_selector: index class %i\n", index -> result -> class);
 	if(index -> result -> class != OBERON_TYPE_INTEGER)
 	{
 		oberon_error(ctx, "index must be integer");
 	}
 
+	// Статическая проверка границ массива
 	if(index -> is_item)
 	{
 		if(index -> item.mode == MODE_INTEGER)
@@ -1241,7 +1269,9 @@ oberon_const_expr(oberon_context_t * ctx)
 //   PARSER
 // =======================================================================
 
+static void oberon_decl_seq(oberon_context_t * ctx);
 static void oberon_statement_seq(oberon_context_t * ctx);
+static void oberon_initialize_decl(oberon_context_t * ctx);
 
 static void
 oberon_expect_token(oberon_context_t * ctx, int token)
@@ -1350,6 +1380,7 @@ oberon_formal_pars(oberon_context_t * ctx, oberon_type_t * signature)
 	if(ctx -> token == COLON)
 	{
 		oberon_assert_token(ctx, COLON);
+		// TODO get by qualident
 		oberon_type(ctx, &signature -> base);
 	}
 }
@@ -1373,7 +1404,10 @@ oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type)
 static void
 oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
 {
-	if(ctx -> result_type -> class == OBERON_TYPE_VOID)
+	oberon_object_t * proc = ctx -> decl -> parent;
+	oberon_type_t * result_type = proc -> type -> base;
+
+	if(result_type -> class == OBERON_TYPE_VOID)
 	{
 		if(expr != NULL)
 		{
@@ -1387,10 +1421,10 @@ oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
 			oberon_error(ctx, "procedure requires expression on result");
 		}
 
-		oberon_autocast_to(ctx, expr, ctx -> result_type);
+		oberon_autocast_to(ctx, expr, result_type);
 	}
 
-	ctx -> has_return = 1;
+	proc -> has_return = 1;
 
 	oberon_generate_return(ctx, expr);
 }
@@ -1405,6 +1439,7 @@ oberon_proc_decl(oberon_context_t * ctx)
 
 	oberon_scope_t * this_proc_def_scope = ctx -> decl;
 	oberon_open_scope(ctx);
+	ctx -> decl -> local = 1;
 
 	oberon_type_t * signature;
 	signature = oberon_new_type_ptr(OBERON_TYPE_VOID);
@@ -1413,14 +1448,18 @@ oberon_proc_decl(oberon_context_t * ctx)
 	oberon_object_t * proc;
 	proc = oberon_define_proc(this_proc_def_scope, name, signature);
 
-	ctx -> result_type = signature -> base;
-	ctx -> has_return = 0;
+	// процедура как новый родительский объект
+	ctx -> decl -> parent = proc;
+
+	oberon_initialize_decl(ctx);
+	oberon_generator_init_proc(ctx, proc);
 
 	oberon_assert_token(ctx, SEMICOLON);
 
-	oberon_generate_begin_proc(ctx, proc);
+	oberon_decl_seq(ctx);
+	oberon_generator_init_type(ctx, signature);
 
-	// TODO declarations
+	oberon_generate_begin_proc(ctx, proc);
 
 	if(ctx -> token == BEGIN)
 	{
@@ -1440,11 +1479,10 @@ oberon_proc_decl(oberon_context_t * ctx)
 		oberon_make_return(ctx, NULL);
 	}
 
-	if(ctx -> has_return == 0)
+	if(proc -> has_return == 0)
 	{
 		oberon_error(ctx, "procedure requires return");
 	}
-	ctx -> result_type = NULL;
 
 	oberon_generate_end_proc(ctx);
 	oberon_close_scope(ctx -> decl);
@@ -1897,7 +1935,13 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
 static void
 oberon_initialize_object(oberon_context_t * ctx, oberon_object_t * x)
 {
-	printf("oberon_initialize_object: name %s class %i\n", x -> name, x -> class);
+	if(x -> initialized)
+	{
+		return;
+	}
+
+	x -> initialized = 1;
+
 	switch(x -> class)
 	{
 		case OBERON_CLASS_TYPE:
@@ -1984,6 +2028,14 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 static void
 oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig)
 {
+	if(desig -> result -> class != OBERON_TYPE_VOID)
+	{
+		if(desig -> result -> class != OBERON_TYPE_PROCEDURE)
+		{
+			oberon_error(ctx, "procedure with result");
+		}
+	}
+
 	oberon_autocast_call(ctx, desig);
 	oberon_generate_call_proc(ctx, desig);
 }