X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=oberon.c;h=6dd84f16b6b9c3108973c087636865c661735bc3;hb=1bf625553dc35ac4a5c1afceb6950fd44776a424;hp=847e9c77e65a4352cadb204f4948076f8b19ba82;hpb=3376c57aa304940b405940c6463df71c7c1c7f01;p=dsw-obn.git

diff --git a/oberon.c b/oberon.c
index 847e9c7..6dd84f1 100644
--- a/oberon.c
+++ b/oberon.c
@@ -50,7 +50,9 @@ enum {
 	RBRACE,
 	RECORD,
 	POINTER,
-	TO
+	TO,
+	UPARROW,
+	NIL
 };
 
 // =======================================================================
@@ -116,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;
 }
@@ -145,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;
 
@@ -154,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)
 	{
@@ -170,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;
@@ -272,6 +286,7 @@ oberon_find_var(oberon_scope_t * scope, char * name)
 }
 */
 
+/*
 static oberon_object_t *
 oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signature)
 {
@@ -280,6 +295,7 @@ oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signatur
 	proc -> type = signature;
 	return proc;
 }
+*/
 
 // =======================================================================
 //   SCANER
@@ -395,6 +411,10 @@ oberon_read_ident(oberon_context_t * ctx)
 	{
 		ctx -> token = TO;
 	}
+	else if(strcmp(ident, "NIL") == 0)
+	{
+		ctx -> token = NIL;
+	}
 }
 
 static void
@@ -527,6 +547,10 @@ oberon_read_symbol(oberon_context_t * ctx)
 			ctx -> token = RBRACE;
 			oberon_get_char(ctx);
 			break;
+		case '^':
+			ctx -> token = UPARROW;
+			oberon_get_char(ctx);
+			break;
 		default:
 			oberon_error(ctx, "invalid char");
 			break;
@@ -562,6 +586,7 @@ static oberon_expr_t * oberon_expr(oberon_context_t * ctx);
 static void oberon_assert_token(oberon_context_t * ctx, int token);
 static char * oberon_assert_ident(oberon_context_t * ctx);
 static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type);
+static oberon_item_t * oberon_const_expr(oberon_context_t * ctx);
 
 static oberon_expr_t *
 oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right)
@@ -628,7 +653,7 @@ oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a)
 }
 
 static void
-oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first)
+oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first, int const_expr)
 {
 	oberon_expr_t * last;
 
@@ -638,7 +663,16 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first)
 	{
 		oberon_assert_token(ctx, COMMA);
 		oberon_expr_t * current;
-		current = oberon_expr(ctx);
+
+		if(const_expr)
+		{
+			current = (oberon_expr_t *) oberon_const_expr(ctx);
+		}
+		else
+		{
+			current = oberon_expr(ctx);
+		}
+
 		last -> next = current;
 		last = current;
 		*num_expr += 1;
@@ -653,7 +687,6 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
 		oberon_error(ctx, "incompatible types");
 	}
 
-
 	if(pref -> class == OBERON_TYPE_INTEGER)
 	{
 		if(expr -> result -> class > pref -> class)
@@ -669,6 +702,16 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
 			oberon_error(ctx, "incompatible record types");
 		}
 	}
+	else if(pref -> class == OBERON_TYPE_POINTER)
+	{
+		if(expr -> result -> base != pref -> base)
+		{
+			if(expr -> result -> base -> class != OBERON_TYPE_VOID)
+			{
+				oberon_error(ctx, "incompatible pointer types");
+			}
+		}
+	}
 
 	// TODO cast
 
@@ -710,12 +753,100 @@ 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;
 	}
 }
 
+static oberon_expr_t *
+oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
+{
+	if(proc -> class != OBERON_CLASS_PROC)
+	{
+		oberon_error(ctx, "not a procedure");
+	}
+
+	oberon_expr_t * call;
+
+	if(proc -> sysproc)
+	{
+		if(proc -> genfunc == NULL)
+		{
+			oberon_error(ctx, "not a function-procedure");
+		}
+
+		call = proc -> genfunc(ctx, num_args, list_args);
+	}
+	else
+	{
+		if(proc -> type -> base -> class == OBERON_TYPE_VOID)
+		{
+			oberon_error(ctx, "attempt to call procedure in expression");
+		}
+
+		call = oberon_new_item(MODE_CALL, proc -> type -> base);
+		call -> item.var = proc;
+		call -> item.num_args = num_args;
+		call -> item.args = list_args;
+		oberon_autocast_call(ctx, call);
+	}
+
+	return call;
+}
+
+static void
+oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
+{
+	if(proc -> class != OBERON_CLASS_PROC)
+	{
+		oberon_error(ctx, "not a procedure");
+	}
+
+	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);
+		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) \
@@ -726,51 +857,65 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
 	|| ((x) == TRUE) \
 	|| ((x) == FALSE))
 
-#define ISSELECTOR(x) \
-	(((x) == LBRACE) \
-	|| ((x) == DOT))
-
 static oberon_expr_t *
-oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int num_indexes, oberon_expr_t * indexes)
+oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
 {
-	assert(desig -> is_item == 1);
-
-	if(desig -> item.mode != MODE_VAR)
+	if(expr -> result -> class != OBERON_TYPE_POINTER)
 	{
-		oberon_error(ctx, "not MODE_VAR");
+		oberon_error(ctx, "not a pointer");
 	}
 
-	int class = desig -> item.var -> class;
-	switch(class)
+	assert(expr -> is_item);
+
+	oberon_expr_t * selector;
+	selector = oberon_new_item(MODE_DEREF, expr -> result -> base);
+	selector -> item.parent = (oberon_item_t *) expr;
+
+	return selector;
+}
+
+static oberon_expr_t *
+oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon_expr_t * index)
+{
+	if(desig -> result -> class == OBERON_TYPE_POINTER)
 	{
-		case OBERON_CLASS_VAR:
-		case OBERON_CLASS_VAR_PARAM:
-		case OBERON_CLASS_PARAM:
-			break;
-		default:
-			oberon_error(ctx, "not variable");
-			break;
+		desig = oberno_make_dereferencing(ctx, desig);
 	}
 
-	oberon_type_t * type = desig -> item.var -> type;
-	if(type -> class != OBERON_TYPE_ARRAY)
+	assert(desig -> is_item);
+
+	if(desig -> result -> class != OBERON_TYPE_ARRAY)
 	{
 		oberon_error(ctx, "not array");
 	}
 
-	int dim = desig -> item.var -> type -> dim;
-	if(num_indexes != dim)
+	oberon_type_t * base;
+	base = desig -> result -> base;
+
+	if(index -> result -> class != OBERON_TYPE_INTEGER)
 	{
-		oberon_error(ctx, "dimesions not matched");
+		oberon_error(ctx, "index must be integer");
 	}
 
-	oberon_type_t * base = desig -> item.var -> type -> base;
+	// Статическая проверка границ массива
+	if(index -> is_item)
+	{
+		if(index -> item.mode == MODE_INTEGER)
+		{
+			int arr_size = desig -> result -> size;
+			int index_int = index -> item.integer;
+			if(index_int < 0 || index_int > arr_size - 1)
+			{
+				oberon_error(ctx, "not in range (dimension size 0..%i)", arr_size - 1);
+			}
+		}
+	}
 
 	oberon_expr_t * selector;
 	selector = oberon_new_item(MODE_INDEX, base);
 	selector -> item.parent = (oberon_item_t *) desig;
-	selector -> item.num_args = num_indexes;
-	selector -> item.args = indexes;
+	selector -> item.num_args = 1;
+	selector -> item.args = index;
 
 	return selector;
 }
@@ -778,10 +923,14 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int nu
 static oberon_expr_t *
 oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * name)
 {
+	if(expr -> result -> class == OBERON_TYPE_POINTER)
+	{
+		expr = oberno_make_dereferencing(ctx, expr);
+	}
+
 	assert(expr -> is_item == 1);
 
-	int class = expr -> result -> class;
-	if(class != OBERON_TYPE_RECORD)
+	if(expr -> result -> class != OBERON_TYPE_RECORD)
 	{
 		oberon_error(ctx, "not record");
 	}
@@ -799,6 +948,11 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
 	return selector;
 }
 
+#define ISSELECTOR(x) \
+	(((x) == LBRACE) \
+	|| ((x) == DOT) \
+	|| ((x) == UPARROW))
+
 static oberon_expr_t *
 oberon_designator(oberon_context_t * ctx)
 {
@@ -821,6 +975,7 @@ oberon_designator(oberon_context_t * ctx)
 			expr = oberon_new_item(MODE_VAR, var -> type);
 			break;
 		case OBERON_CLASS_PROC:
+			//expr = oberon_make_call_expr(var, 0, NULL);
 			expr = oberon_new_item(MODE_CALL, var -> type);
 			break;
 		default:
@@ -842,9 +997,18 @@ oberon_designator(oberon_context_t * ctx)
 				oberon_assert_token(ctx, LBRACE);
 				int num_indexes = 0;
 				oberon_expr_t * indexes = NULL;
-				oberon_expr_list(ctx, &num_indexes, &indexes);
+				oberon_expr_list(ctx, &num_indexes, &indexes, 0);
 				oberon_assert_token(ctx, RBRACE);
-				expr = oberon_make_array_selector(ctx, expr, num_indexes, indexes);
+
+				for(int i = 0; i < num_indexes; i++)
+				{
+					expr = oberon_make_array_selector(ctx, expr, indexes);
+					indexes = indexes -> next;
+				}
+				break;
+			case UPARROW:
+				oberon_assert_token(ctx, UPARROW);
+				expr = oberno_make_dereferencing(ctx, expr);
 				break;
 			default:
 				oberon_error(ctx, "oberon_designator: wat");
@@ -855,17 +1019,37 @@ oberon_designator(oberon_context_t * ctx)
 }
 
 static oberon_expr_t *
-oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
+oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 {
 	assert(expr -> is_item == 1);
 
 	if(ctx -> token == LPAREN)
 	{
-		if(expr -> result -> class != OBERON_TYPE_PROCEDURE)
+		oberon_assert_token(ctx, LPAREN);
+
+		int num_args = 0;
+		oberon_expr_t * arguments = NULL;
+
+		if(ISEXPR(ctx -> token))
 		{
-			oberon_error(ctx, "not a procedure");
+			oberon_expr_list(ctx, &num_args, &arguments, 0);
 		}
 
+		expr = oberon_make_call_func(ctx, expr -> item.var, num_args, arguments);
+
+		oberon_assert_token(ctx, RPAREN);
+	}
+
+	return expr;
+}
+
+static void
+oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
+{
+	assert(expr -> is_item == 1);
+
+	if(ctx -> token == LPAREN)
+	{
 		oberon_assert_token(ctx, LPAREN);
 
 		int num_args = 0;
@@ -873,19 +1057,13 @@ oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 
 		if(ISEXPR(ctx -> token))
 		{
-			oberon_expr_list(ctx, &num_args, &arguments);
+			oberon_expr_list(ctx, &num_args, &arguments, 0);
 		}
 
-		expr -> result = expr -> item.var -> type -> base;
-		expr -> item.mode = MODE_CALL;
-		expr -> item.num_args = num_args;
-		expr -> item.args = arguments;
-		oberon_assert_token(ctx, RPAREN);
+		oberon_make_call_proc(ctx, expr -> item.var, num_args, arguments);
 
-		oberon_autocast_call(ctx, expr);
+		oberon_assert_token(ctx, RPAREN);
 	}
-
-	return expr;
 }
 
 static oberon_expr_t *
@@ -897,7 +1075,7 @@ oberon_factor(oberon_context_t * ctx)
 	{
 		case IDENT:
 			expr = oberon_designator(ctx);
-			expr = oberon_opt_proc_parens(ctx, expr);
+			expr = oberon_opt_func_parens(ctx, expr);
 			break;
 		case INTEGER:
 			expr = oberon_new_item(MODE_INTEGER, ctx -> int_type);
@@ -924,6 +1102,10 @@ oberon_factor(oberon_context_t * ctx)
 			expr = oberon_factor(ctx);
 			expr = oberon_make_unary_op(ctx, NOT, expr);
 			break;
+		case NIL:
+			oberon_assert_token(ctx, NIL);
+			expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type);
+			break;
 		default:
 			oberon_error(ctx, "invalid expression");
 	}
@@ -1174,7 +1356,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)
@@ -1283,6 +1467,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);
 	}
 }
@@ -1303,10 +1488,41 @@ oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type)
 	}
 }
 
+static void
+oberon_compare_signatures(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b)
+{
+	if(a -> num_decl != b -> num_decl)
+	{
+		oberon_error(ctx, "number parameters not matched");
+	}
+
+	int num_param = a -> num_decl;
+	oberon_object_t * param_a = a -> decl;
+	oberon_object_t * param_b = b -> decl;
+	for(int i = 0; i < num_param; i++)
+	{
+		if(strcmp(param_a -> name, param_b -> name) != 0)
+		{
+			oberon_error(ctx, "param %i name not matched", i + 1);
+		}
+
+		if(param_a -> type != param_b -> type)
+		{
+			oberon_error(ctx, "param %i type not matched", i + 1);
+		}
+
+		param_a = param_a -> next;
+		param_b = param_b -> next;
+	}
+}
+
 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)
 		{
@@ -1320,41 +1536,25 @@ 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);
 }
 
 static void
-oberon_proc_decl(oberon_context_t * ctx)
+oberon_proc_decl_body(oberon_context_t * ctx, oberon_object_t * proc)
 {
-	oberon_assert_token(ctx, PROCEDURE);
-
-	char * name;
-	name = oberon_assert_ident(ctx);
-
-	oberon_scope_t * this_proc_def_scope = ctx -> decl;
-	oberon_open_scope(ctx);
-
-	oberon_type_t * signature;
-	signature = oberon_new_type_ptr(OBERON_TYPE_VOID);
-	oberon_opt_formal_pars(ctx, &signature);
-
-	oberon_object_t * proc;
-	proc = oberon_define_proc(this_proc_def_scope, name, signature);
+	oberon_assert_token(ctx, SEMICOLON);
 
-	ctx -> result_type = signature -> base;
-	ctx -> has_return = 0;
+	ctx -> decl = proc -> scope;
 
-	oberon_assert_token(ctx, SEMICOLON);
+	oberon_decl_seq(ctx);
 
 	oberon_generate_begin_proc(ctx, proc);
 
-	// TODO declarations
-
 	if(ctx -> token == BEGIN)
 	{
 		oberon_assert_token(ctx, BEGIN);
@@ -1362,27 +1562,90 @@ oberon_proc_decl(oberon_context_t * ctx)
 	}
 
 	oberon_assert_token(ctx, END);
-	char * name2 = oberon_assert_ident(ctx);
-	if(strcmp(name2, name) != 0)
+	char * name = oberon_assert_ident(ctx);
+	if(strcmp(name, proc -> name) != 0)
 	{
 		oberon_error(ctx, "procedure name not matched");
 	}
 
-	if(signature -> base -> class == OBERON_TYPE_VOID)
+	if(proc -> type -> base -> class == OBERON_TYPE_VOID
+		&& proc -> has_return == 0)
 	{
 		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);
 }
 
+static void
+oberon_proc_decl(oberon_context_t * ctx)
+{
+	oberon_assert_token(ctx, PROCEDURE);
+
+	int forward = 0;
+	if(ctx -> token == UPARROW)
+	{
+		oberon_assert_token(ctx, UPARROW);
+		forward = 1;
+	}
+
+	char * name;
+	name = oberon_assert_ident(ctx);
+
+	oberon_scope_t * proc_scope;
+	proc_scope = oberon_open_scope(ctx);
+	ctx -> decl -> local = 1;
+
+	oberon_type_t * signature;
+	signature = oberon_new_type_ptr(OBERON_TYPE_VOID);
+	oberon_opt_formal_pars(ctx, &signature);	
+
+	oberon_initialize_decl(ctx);
+	oberon_generator_init_type(ctx, signature);
+	oberon_close_scope(ctx -> decl);
+
+	oberon_object_t * proc;
+	proc = oberon_find_object(ctx -> decl, name, 0);
+	if(proc != NULL)
+	{
+		if(proc -> class != OBERON_CLASS_PROC)
+		{
+			oberon_error(ctx, "mult definition");
+		}
+
+		if(forward == 0)
+		{
+			if(proc -> linked)
+			{
+				oberon_error(ctx, "mult procedure definition");
+			}
+		}
+
+		oberon_compare_signatures(ctx, proc -> type, signature);
+	}
+	else
+	{
+		proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC);
+		proc -> type = signature;
+		proc -> scope = proc_scope;
+		oberon_generator_init_proc(ctx, proc);
+	}
+
+	proc -> scope -> parent = proc;
+
+	if(forward == 0)
+	{
+		proc -> linked = 1;
+		oberon_proc_decl_body(ctx, proc);
+	}
+}
+
 static void
 oberon_const_decl(oberon_context_t * ctx)
 {
@@ -1399,10 +1662,14 @@ oberon_const_decl(oberon_context_t * ctx)
 }
 
 static void
-oberon_make_array_type(oberon_context_t * ctx, int dim, oberon_item_t * size, oberon_type_t * base, oberon_type_t ** type)
+oberon_make_array_type(oberon_context_t * ctx, oberon_expr_t * size, oberon_type_t * base, oberon_type_t ** type)
 {
-	assert(dim == 1);
-	if(size -> mode != MODE_INTEGER)
+	if(size -> is_item == 0)
+	{
+		oberon_error(ctx, "requires constant");
+	}
+
+	if(size -> item.mode != MODE_INTEGER)
 	{
 		oberon_error(ctx, "requires integer constant");
 	}
@@ -1410,8 +1677,7 @@ oberon_make_array_type(oberon_context_t * ctx, int dim, oberon_item_t * size, ob
 	oberon_type_t * arr;
 	arr = *type;
 	arr -> class = OBERON_TYPE_ARRAY;
-	arr -> dim = dim;
-	arr -> size = size -> integer;
+	arr -> size = size -> item.integer;
 	arr -> base = base;
 }
 
@@ -1462,6 +1728,23 @@ static void oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type
  * Правило граматики "type". Указатель type должен указывать на существующий объект!
  */
 
+static void
+oberon_make_multiarray(oberon_context_t * ctx, oberon_expr_t * sizes, oberon_type_t * base, oberon_type_t ** type)
+{
+	if(sizes == NULL)
+	{
+		*type = base;
+		return;
+	}
+
+	oberon_type_t * dim;
+	dim = oberon_new_type_ptr(OBERON_TYPE_VOID);
+
+	oberon_make_multiarray(ctx, sizes -> next, base, &dim);
+
+	oberon_make_array_type(ctx, sizes, dim, type);
+}
+
 static void
 oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
 {
@@ -1473,8 +1756,9 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
 	{
 		oberon_assert_token(ctx, ARRAY);
 
-		oberon_item_t * size;
-		size = oberon_const_expr(ctx);
+		int num_sizes = 0;
+		oberon_expr_t * sizes;
+		oberon_expr_list(ctx, &num_sizes, &sizes, 1);
 
 		oberon_assert_token(ctx, OF);
 
@@ -1482,7 +1766,7 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
 		base = oberon_new_type_ptr(OBERON_TYPE_VOID);
 		oberon_type(ctx, &base);
 
-		oberon_make_array_type(ctx, 1, size, base, type);
+		oberon_make_multiarray(ctx, sizes, base, type);
 	}
 	else if(ctx -> token == RECORD)
 	{
@@ -1523,8 +1807,10 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
 	}
 	else if(ctx -> token == PROCEDURE)
 	{
+		oberon_open_scope(ctx);
 		oberon_assert_token(ctx, PROCEDURE);
 		oberon_opt_formal_pars(ctx, type);
+		oberon_close_scope(ctx -> decl);
 	}
 	else
 	{
@@ -1773,21 +2059,13 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
 
 	if(type -> class == OBERON_TYPE_POINTER)
 	{
-		if(type -> base -> class == OBERON_TYPE_RECORD)
-		{
-			oberon_generator_init_type(ctx, type -> base);
-			oberon_generator_init_type(ctx, type);
-		}
-		else
-		{
-			oberon_initialize_type(ctx, type -> base);
-			oberon_generator_init_type(ctx, type);
-		}
+		oberon_initialize_type(ctx, type -> base);
+		oberon_generator_init_type(ctx, type);
 	}
 	else if(type -> class == OBERON_TYPE_ARRAY)
 	{
-		oberon_generator_init_type(ctx, type);
 		oberon_initialize_type(ctx, type -> base);		
+		oberon_generator_init_type(ctx, type);
 	}
 	else if(type -> class == OBERON_TYPE_RECORD)
 	{
@@ -1815,7 +2093,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:
@@ -1849,6 +2133,24 @@ oberon_initialize_decl(oberon_context_t * ctx)
 	}	
 }
 
+static void
+oberon_prevent_undeclarated_procedures(oberon_context_t * ctx)
+{
+	oberon_object_t * x = ctx -> decl -> list;
+
+	while(x -> next)
+	{
+		if(x -> next -> class == OBERON_CLASS_PROC)
+		{
+			if(x -> next -> linked == 0)
+			{
+				oberon_error(ctx, "unresolved forward declaration");
+			}
+		}
+		x = x -> next;
+	}	
+}
+
 static void
 oberon_decl_seq(oberon_context_t * ctx)
 {
@@ -1890,6 +2192,8 @@ oberon_decl_seq(oberon_context_t * ctx)
 		oberon_proc_decl(ctx);
 		oberon_assert_token(ctx, SEMICOLON);
 	}
+
+	oberon_prevent_undeclarated_procedures(ctx);
 }
 
 static void
@@ -1899,13 +2203,6 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 	oberon_generate_assign(ctx, src, dst);
 }
 
-static void
-oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig)
-{
-	oberon_autocast_call(ctx, desig);
-	oberon_generate_call_proc(ctx, desig);
-}
-
 static void
 oberon_statement(oberon_context_t * ctx)
 {
@@ -1923,8 +2220,7 @@ oberon_statement(oberon_context_t * ctx)
 		}
 		else
 		{
-			item1 = oberon_opt_proc_parens(ctx, item1);
-			oberon_make_call(ctx, item1);
+			oberon_opt_proc_parens(ctx, item1);
 		}
 	}
 	else if(ctx -> token == RETURN)
@@ -1995,6 +2291,10 @@ register_default_types(oberon_context_t * ctx)
 	ctx -> void_type = oberon_new_type_ptr(OBERON_TYPE_VOID);
 	oberon_generator_init_type(ctx, ctx -> void_type);
 
+	ctx -> void_ptr_type = oberon_new_type_ptr(OBERON_TYPE_POINTER);
+	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));
 	oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type);
 
@@ -2002,6 +2302,58 @@ register_default_types(oberon_context_t * ctx)
 	oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type);
 }
 
+static void
+oberon_new_intrinsic_function(oberon_context_t * ctx, char * name, GenerateFuncCallback generate)
+{
+	oberon_object_t * proc;
+	proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC);
+	proc -> sysproc = 1;
+	proc -> genfunc = generate;
+	proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
+}
+
+/*
+static void
+oberon_new_intrinsic_procedure(oberon_context_t * ctx, char * name, GenerateProcCallback generate)
+{
+	oberon_object_t * proc;
+	proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC);
+	proc -> sysproc = 1;
+	proc -> genproc = generate;
+	proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
+}
+*/
+
+static oberon_expr_t *
+oberon_make_abs_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;
+
+	oberon_type_t * result_type;
+	result_type = arg -> result;
+	
+	if(result_type -> class != OBERON_TYPE_INTEGER)
+	{
+		oberon_error(ctx, "ABS accepts only integers");
+	}
+
+
+	oberon_expr_t * expr;
+	expr = oberon_new_operator(OP_ABS, result_type, arg, NULL);
+	return expr;
+}
+
 oberon_context_t *
 oberon_create_context()
 {
@@ -2014,7 +2366,8 @@ oberon_create_context()
 
 	oberon_generator_init_context(ctx);
 
-	register_default_types(ctx);	
+	register_default_types(ctx);
+	oberon_new_intrinsic_function(ctx, "ABS", oberon_make_abs_call);
 
 	return ctx;
 }