From: DeaDDooMER <deaddoomer@deadsoftware.ru>
Date: Mon, 24 Jul 2017 19:17:03 +0000 (+0300)
Subject: Добавлены процедуры-функции, объявления именованных констант, объявления типов алиасо... 
X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=063ba732ee8778c34a3781270b18d52481dbf0cd;p=dsw-obn.git

Добавлены процедуры-функции, объявления именованных констант, объявления типов алиасов и типов массивов, добавлен селектор индекса массива
---

diff --git a/generator.c b/generator.c
index 07e7bc4..685786f 100644
--- a/generator.c
+++ b/generator.c
@@ -10,19 +10,6 @@
 
 #include <libgccjit.h>
 
-/*
- * oberon_object_t -> gen_var == gcc_jit_lvalue;
- * oberon_type_t -> gen_type == gcc_jit_type;
- * oberon_context_t -> gen_context == gen_context_t;
- */ 
-
-typedef struct
-{
-	gcc_jit_context * gcc_context;
-	gcc_jit_block * gcc_block;
-	gcc_jit_result * gcc_result;
-} gen_context_t;
-
 static void printcontext(oberon_context_t * ctx, char * s)
 {
 /*
@@ -71,43 +58,80 @@ oberon_generator_destroy_context(oberon_context_t * ctx)
 void
 oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
 {
-	printcontext(ctx, "oberon_generator_init_type");
+	gen_type_t * gen_type = malloc(sizeof *gen_type);
+	memset(gen_type, 0, sizeof *gen_type);
+	type -> gen_type = gen_type;
 
 	gen_context_t * gen_context = ctx -> gen_context;
 	gcc_jit_context * gcc_context = gen_context -> gcc_context;
 
-	gcc_jit_type * gen_type;
-	if(type -> class == OBERON_TYPE_INTEGER)
+	gcc_jit_type * gcc_type;
+	if(type -> class == OBERON_TYPE_VOID)
 	{
-		gen_type = gcc_jit_context_get_int_type(gcc_context, type -> size, 1);
+		gcc_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_VOID);
+	}
+	else if(type -> class == OBERON_TYPE_INTEGER)
+	{
+		gcc_type = gcc_jit_context_get_int_type(gcc_context, type -> size, 1);
 	}
 	else if(type -> class == OBERON_TYPE_BOOLEAN)
 	{
-		gen_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_BOOL);
+		gcc_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_BOOL);
+	}
+	else if(type -> class == OBERON_TYPE_PROCEDURE)
+	{
+		gcc_type = NULL; // not used
+	}
+	else if(type -> class == OBERON_TYPE_ARRAY)
+	{
+		if(type -> dim != 1)
+		{
+			oberon_error(ctx, "multidimension and open arrays not supported");
+		}
+		
+		gen_type_t * gen_base = type -> base -> gen_type;
+		gcc_jit_type * gcc_base = gen_base -> gcc_type;
+
+		gcc_type = gcc_jit_context_new_array_type(gcc_context, NULL, gcc_base, type -> size);
 	}
 	else
 	{
 		oberon_error(ctx, "oberon_generator_init_type: invalid type class %i", type -> class);
 	}
 
-	type -> gen_type = gen_type;
+	gen_type -> gcc_type = gcc_type;
 }
 
 void
 oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
 {
-	printcontext(ctx, "oberon_generator_init_var");
-	assert(var -> class == OBERON_CLASS_VAR);
-
 	gen_context_t * gen_context = ctx -> gen_context;
+	gen_type_t * gen_type = var -> type -> gen_type;
+
+	gen_var_t * gen_var = malloc(sizeof *gen_var);
+	memset(gen_var, 0, sizeof *gen_var);
+	var -> gen_var = gen_var;
+
 	gcc_jit_context * gcc_context = gen_context -> gcc_context;
-	gcc_jit_type * gen_type = var -> type -> gen_type;
+	gcc_jit_type * gcc_type = gen_type -> gcc_type;
 	const char * name = var -> name;
 
-	gcc_jit_lvalue * gen_var;
-	gen_var = gcc_jit_context_new_global(gcc_context, NULL, GCC_JIT_GLOBAL_INTERNAL, gen_type, name);
-
-	var -> gen_var = gen_var;
+	// TODO var param
+	if(var -> class == OBERON_CLASS_VAR)
+	{
+		gen_var -> gcc_lvalue = gcc_jit_context_new_global(
+			gcc_context, NULL, GCC_JIT_GLOBAL_INTERNAL, gcc_type, name
+		);
+	}
+	else if(var -> class == OBERON_CLASS_PARAM)
+	{
+		gen_var -> gcc_param = gcc_jit_context_new_param(gcc_context, NULL, gcc_type, name);
+		gen_var -> gcc_lvalue = gcc_jit_param_as_lvalue(gen_var -> gcc_param);
+	}
+	else
+	{
+		oberon_error(ctx, "oberon_generator_init_var: invalid class %i", var -> class);
+	}
 }
 
 void
@@ -117,18 +141,32 @@ oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc)
 
 	gen_context_t * gen_context = ctx -> gen_context;
 	gcc_jit_context * gcc_context = gen_context -> gcc_context;
-	//gcc_jit_type * gen_type = proc -> type -> gen_type;
-	const char * name = proc -> name;
 
-	gcc_jit_function * gen_proc;
+	gen_proc_t * gen_proc = malloc(sizeof *gen_proc);
+	memset(gen_proc, 0, sizeof *gen_proc);
+	proc -> gen_proc = gen_proc;
 
-	// TODO make real signature
-	gcc_jit_type * void_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_VOID);
-	gen_proc = gcc_jit_context_new_function(
-		gcc_context, NULL, GCC_JIT_FUNCTION_EXPORTED, void_type, name, 0, NULL, 0
+	const char * name = proc -> name;
+	gen_type_t * gen_result_type = proc -> type -> base -> gen_type;
+	gcc_jit_type * result_type = gen_result_type -> gcc_type;
+
+	/* Строим список параметров */
+	int num_param = proc -> type -> num_decl;
+	oberon_object_t * o = proc -> type -> decl;
+	gcc_jit_param * params[num_param];
+	for(int i = 0; i < num_param; i++)
+	{
+		gen_var_t * param_var = o -> gen_var;
+		params[i] = param_var -> gcc_param;
+		o = o -> next;
+	}
+
+	gcc_jit_function * gcc_func;
+	gcc_func = gcc_jit_context_new_function(
+		gcc_context, NULL, GCC_JIT_FUNCTION_EXPORTED, result_type, name, num_param, params, 0
 	);
 
-	proc -> gen_proc = gen_proc;
+	gen_proc -> gcc_func = gcc_func;
 }
 
 // =======================================================================
@@ -171,8 +209,9 @@ void
 oberon_generate_begin_proc(oberon_context_t * ctx, oberon_object_t * proc)
 {
 	gen_context_t * gen_context = ctx -> gen_context;
+	gen_proc_t * gen_proc = proc -> gen_proc;
 
-	gcc_jit_function * func = proc -> gen_proc;
+	gcc_jit_function * func = gen_proc -> gcc_func;
 	gcc_jit_block * gcc_block = gcc_jit_function_new_block(func, NULL);
 
 	// TODO make stack for block
@@ -194,11 +233,24 @@ void
 oberon_generate_end_proc(oberon_context_t * ctx)
 {
 	gen_context_t * gen_context = ctx -> gen_context;
-	gcc_jit_block * gcc_block = gen_context -> gcc_block;
+	gen_context -> gcc_block = NULL;
+}
 
-	gcc_jit_block_end_with_void_return(gcc_block, NULL);
+void
+oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr)
+{
+	gen_context_t * gen_context = ctx -> gen_context;
+	gcc_jit_block * gcc_block = gen_context -> gcc_block;
 
-	gen_context -> gcc_block = NULL;
+	if(expr == NULL)
+	{
+		gcc_jit_block_end_with_void_return(gcc_block, NULL);
+	}
+	else
+	{
+		gcc_jit_rvalue * r = rvalue_from_expr(ctx, expr);
+		gcc_jit_block_end_with_return(gcc_block, NULL, r);
+	}
 }
 
 static gcc_jit_lvalue *
@@ -214,7 +266,8 @@ lvalue_from_expr(oberon_context_t *ctx, oberon_expr_t * expr)
 		{
 			oberon_error(ctx, "invalid lvalue expression");
 		}
-		left = item -> var -> gen_var;
+		gen_var_t * gen_var = item -> var -> gen_var;
+		left = gen_var -> gcc_lvalue;
 	}
 	else
 	{
@@ -233,9 +286,10 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
 	gcc_jit_rvalue * right;
 	if(item -> mode == MODE_VAR)
 	{
-		assert(item -> var -> class == OBERON_CLASS_VAR);
-		gcc_jit_lvalue * gen_var = item -> var -> gen_var;
-		right = gcc_jit_lvalue_as_rvalue(gen_var);
+		assert(item -> var -> class == OBERON_CLASS_VAR
+			|| item -> var -> class == OBERON_CLASS_PARAM);
+		gen_var_t * gen_var = item -> var -> gen_var;
+		right = gcc_jit_lvalue_as_rvalue(gen_var -> gcc_lvalue);
 	}
 	else if(item -> mode == MODE_INTEGER)
 	{
@@ -257,10 +311,22 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
 	else if(item -> mode == MODE_CALL)
 	{
 		assert(item -> var -> class == OBERON_CLASS_PROC);
-		/* TODO args */
-		gcc_jit_function * func = item -> var -> gen_proc;
+
+		gen_proc_t * gen_proc = item -> var -> gen_proc;
+
+		int num_args = item -> num_args;
+		gcc_jit_rvalue *args[num_args];
+
+		oberon_expr_t * expr = item -> args;
+		for(int i = 0; i < num_args; i++)
+		{
+			args[i] = rvalue_from_expr(ctx, expr);
+			expr = expr -> next;
+		}
+
+		gcc_jit_function * func = gen_proc -> gcc_func;
 		right = gcc_jit_context_new_call(
-	                gcc_context, NULL, func, 0, NULL
+	                gcc_context, NULL, func, num_args, args
 		);
 	}
 	else
@@ -303,8 +369,9 @@ rvalue_from_operator(oberon_context_t * ctx, oberon_oper_t * operator)
 	gcc_jit_rvalue * right;
 
 	gen_context_t * gen_context = ctx -> gen_context;
+	gen_type_t * gen_type = operator -> result -> gen_type;
 	gcc_jit_context * gcc_context = gen_context -> gcc_context;
-	gcc_jit_type * result_type = operator -> result -> gen_type;
+	gcc_jit_type * result_type = gen_type -> gcc_type;
 
 	int expr_type = op_table[operator -> op].type;
 	if(expr_type == 0)
diff --git a/generator.h b/generator.h
index 6b97e0d..6a7321b 100644
--- a/generator.h
+++ b/generator.h
@@ -28,6 +28,7 @@ void oberon_generate_call_proc(oberon_context_t * ctx, oberon_expr_t * desig);
  */
 
 void oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst);
+void oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr);
 
 /*
  * Функции генерации кода
diff --git a/notes b/notes
new file mode 100644
index 0000000..b82a34f
--- /dev/null
+++ b/notes
@@ -0,0 +1,6 @@
+- нету автокаста в присвоении и передачи параметров
+- нету секции type
+- нету локальных объявлений в процедурах
+- нету свёртки констант
+- нету полного контроля return
+- нету селекторов
diff --git a/oberon.c b/oberon.c
index 98928fb..65803c0 100644
--- a/oberon.c
+++ b/oberon.c
@@ -3,6 +3,7 @@
 #include <stdarg.h>
 #include <ctype.h>
 #include <string.h>
+#include <assert.h>
 
 #include "oberon.h"
 #include "generator.h"
@@ -38,7 +39,15 @@ enum {
 	MOD,
 	AND,
 	NOT,
-	PROCEDURE
+	PROCEDURE,
+	COMMA,
+	RETURN,
+	CONST,
+	TYPE,
+	ARRAY,
+	OF,
+	LBRACE,
+	RBRACE,
 };
 
 // =======================================================================
@@ -60,6 +69,33 @@ oberon_error(oberon_context_t * ctx, const char * fmt, ...)
 	exit(1);
 }
 
+static oberon_type_t *
+oberon_new_type_ptr(int class)
+{
+	oberon_type_t * x = malloc(sizeof *x);
+	memset(x, 0, sizeof *x);
+	x -> class = class;
+	return x;
+}
+
+static oberon_type_t *
+oberon_new_type_integer(int size)
+{
+	oberon_type_t * x;
+	x = oberon_new_type_ptr(OBERON_TYPE_INTEGER);
+	x -> size = size;
+	return x;
+}
+
+static oberon_type_t *
+oberon_new_type_boolean(int size)
+{
+	oberon_type_t * x;
+	x = oberon_new_type_ptr(OBERON_TYPE_BOOLEAN);
+	x -> size = size;
+	return x;
+}
+
 // =======================================================================
 //   TABLE
 // ======================================================================= 
@@ -143,13 +179,14 @@ oberon_find_object(oberon_scope_t * scope, char * name)
 	return result;
 }
 
-static void
+static oberon_object_t *
 oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type)
 {
 	oberon_object_t * id;
 	id = oberon_define_object(scope, name, OBERON_CLASS_TYPE);
 	id -> type = type;
 	oberon_generator_init_type(scope -> ctx, type);
+	return id;
 }
 
 static oberon_type_t *
@@ -164,13 +201,14 @@ oberon_find_type(oberon_scope_t * scope, char * name)
 	return x -> type;
 }
 
-static void
-oberon_define_var(oberon_scope_t * scope, char * name, oberon_type_t * type)
+static oberon_object_t *
+oberon_define_var(oberon_scope_t * scope, int class, char * name, oberon_type_t * type)
 {
 	oberon_object_t * var;
-	var = oberon_define_object(scope, name, OBERON_CLASS_VAR);
+	var = oberon_define_object(scope, name, class);
 	var -> type = type;
 	oberon_generator_init_var(scope -> ctx, var);
+	return var;
 }
 
 /*
@@ -189,10 +227,11 @@ oberon_find_var(oberon_scope_t * scope, char * name)
 */
 
 static oberon_object_t *
-oberon_define_proc(oberon_scope_t * scope, char * name)
+oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signature)
 {
 	oberon_object_t * proc;
 	proc = oberon_define_object(scope, name, OBERON_CLASS_PROC);
+	proc -> type = signature;
 	oberon_generator_init_proc(scope -> ctx, proc);
 	return proc;
 }
@@ -279,6 +318,26 @@ oberon_read_ident(oberon_context_t * ctx)
 	{
 		ctx -> token = PROCEDURE;
 	}
+	else if(strcmp(ident, "RETURN") == 0)
+	{
+		ctx -> token = RETURN;
+	}
+	else if(strcmp(ident, "CONST") == 0)
+	{
+		ctx -> token = CONST;
+	}
+	else if(strcmp(ident, "TYPE") == 0)
+	{
+		ctx -> token = TYPE;
+	}
+	else if(strcmp(ident, "ARRAY") == 0)
+	{
+		ctx -> token = ARRAY;
+	}
+	else if(strcmp(ident, "OF") == 0)
+	{
+		ctx -> token = OF;
+	}
 }
 
 static void
@@ -399,6 +458,18 @@ oberon_read_symbol(oberon_context_t * ctx)
 			ctx -> token = NOT;
 			oberon_get_char(ctx);
 			break;
+		case ',':
+			ctx -> token = COMMA;
+			oberon_get_char(ctx);
+			break;
+		case '[':
+			ctx -> token = LBRACE;
+			oberon_get_char(ctx);
+			break;
+		case ']':
+			ctx -> token = RBRACE;
+			oberon_get_char(ctx);
+			break;
 		default:
 			oberon_error(ctx, "invalid char");
 			break;
@@ -433,6 +504,7 @@ static void oberon_expect_token(oberon_context_t * ctx, int token);
 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 oberon_type_t * oberon_type(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)
@@ -498,38 +570,167 @@ oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a)
 	return expr;
 }
 
+static void
+oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first)
+{
+	oberon_expr_t * last;
+
+	*num_expr = 1;
+	*first = last = oberon_expr(ctx);
+	while(ctx -> token == COMMA)
+	{
+		oberon_assert_token(ctx, COMMA);
+		oberon_expr_t * current;
+		current = oberon_expr(ctx);
+		last -> next = current;
+		last = current;
+		*num_expr += 1;
+	}
+}
+
 static oberon_expr_t *
-oberon_factor(oberon_context_t * ctx)
+oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
+{
+	if(expr -> result -> class != pref -> class)
+	{
+		oberon_error(ctx, "incompatible types");
+	}
+
+	if(pref -> class == OBERON_TYPE_INTEGER)
+	{
+		if(expr -> result -> class > pref -> class)
+		{
+			oberon_error(ctx, "incompatible size");
+		}
+	}
+
+	// TODO cast
+
+	return expr;
+}
+
+static void
+oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
+{
+	if(desig -> is_item == 0)
+	{
+		oberon_error(ctx, "expected item");
+	}
+
+	if(desig -> item.mode != MODE_CALL)
+	{
+		oberon_error(ctx, "expected mode CALL");
+	}
+
+	if(desig -> item.var -> class != OBERON_CLASS_PROC)
+	{
+		oberon_error(ctx, "only procedures can be called");
+	}
+
+	oberon_type_t * fn = desig -> item.var -> type;
+	int num_args = desig -> item.num_args;
+	int num_decl = fn -> num_decl;
+
+	if(num_args < num_decl)
+	{
+		oberon_error(ctx, "too few arguments");
+	}
+	else if(num_args > num_decl)
+	{
+		oberon_error(ctx, "too many arguments");
+	}
+
+	oberon_expr_t * arg = desig -> item.args;
+	oberon_object_t * param = fn -> decl;
+	for(int i = 0; i < num_args; i++)
+	{
+		oberon_autocast_to(ctx, arg, param -> type);
+		arg = arg -> next;
+		param = param -> next;
+	}
+}
+
+#define ISEXPR(x) \
+	(((x) == PLUS) \
+	|| ((x) == MINUS) \
+	|| ((x) == IDENT) \
+	|| ((x) == INTEGER) \
+	|| ((x) == LPAREN) \
+	|| ((x) == NOT) \
+	|| ((x) == TRUE) \
+	|| ((x) == FALSE))
+
+static oberon_expr_t *
+oberon_designator(oberon_context_t * ctx)
 {
 	char * name;
 	oberon_object_t * var;
 	oberon_expr_t * expr;
 
+	name = oberon_assert_ident(ctx);
+	var = oberon_find_object(ctx -> decl, name);
+
+	switch(var -> class)
+	{
+		case OBERON_CLASS_CONST:
+			// TODO copy value
+			expr = (oberon_expr_t *) var -> value;
+			break;
+		case OBERON_CLASS_VAR:
+		case OBERON_CLASS_VAR_PARAM:
+		case OBERON_CLASS_PARAM:
+			expr = oberon_new_item(MODE_VAR, var -> type);
+			break;
+		case OBERON_CLASS_PROC:
+			expr = oberon_new_item(MODE_CALL, var -> type);
+			break;
+		default:
+			oberon_error(ctx, "invalid designator");
+			break;
+	}
+
+	expr -> item.var = var;
+	return expr;
+}
+
+static oberon_expr_t *
+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;
+		oberon_expr_t * arguments = NULL;
+
+		if(ISEXPR(ctx -> token))
+		{
+			oberon_expr_list(ctx, &num_args, &arguments);
+		}
+
+		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_autocast_call(ctx, expr);
+	}
+
+	return expr;
+}
+
+static oberon_expr_t *
+oberon_factor(oberon_context_t * ctx)
+{
+	oberon_expr_t * expr;
+
 	switch(ctx -> token)
 	{
 		case IDENT:
-			name = oberon_assert_ident(ctx);
-			var = oberon_find_object(ctx -> decl, name);
-			if(var -> class == OBERON_CLASS_VAR)
-			{
-				expr = oberon_new_item(MODE_VAR, var -> type);
-			}
-			else if(var -> class == OBERON_CLASS_PROC)
-			{
-				expr = oberon_new_item(MODE_CALL, var -> type);
-			}
-			else
-			{
-				oberon_error(ctx, "invalid designator");
-			}
-
-			expr -> item.var = var;
-			if(ctx -> token == LPAREN)
-			{
-				oberon_assert_token(ctx, LPAREN);
-				expr -> item.mode = MODE_CALL;
-				oberon_assert_token(ctx, RPAREN);
-			}
+			expr = oberon_designator(ctx);
+			expr = oberon_opt_proc_parens(ctx, expr);
 			break;
 		case INTEGER:
 			expr = oberon_new_item(MODE_INTEGER, ctx -> int_type);
@@ -613,14 +814,12 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
 	oberon_expr_t * expr;
 	oberon_type_t * result;
 
-	oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);
-
 	if(ITMAKESBOOLEAN(token))
 	{
 		if(ITUSEONLYINTEGER(token))
 		{
 			if(a -> result -> class != OBERON_TYPE_INTEGER
-				&& b -> result -> class != OBERON_TYPE_INTEGER)
+				|| b -> result -> class != OBERON_TYPE_INTEGER)
 			{
 				oberon_error(ctx, "used only with integer types");
 			}
@@ -628,12 +827,14 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
 		else if(ITUSEONLYBOOLEAN(token))
 		{
 			if(a -> result -> class != OBERON_TYPE_BOOLEAN
-				&& b -> result -> class != OBERON_TYPE_BOOLEAN)
+				|| b -> result -> class != OBERON_TYPE_BOOLEAN)
 			{
 				oberon_error(ctx, "used only with boolean type");
 			}
 		}
 
+		result = ctx -> bool_type;
+
 		if(token == EQUAL)
 		{
 			expr = oberon_new_operator(OP_EQ, result, a, b);
@@ -673,6 +874,8 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
 	}
 	else
 	{
+		oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);
+
 		if(token == PLUS)
 		{
 			expr = oberon_new_operator(OP_ADD, result, a, b);
@@ -786,6 +989,20 @@ oberon_expr(oberon_context_t * ctx)
 	return expr;
 }
 
+static oberon_item_t *
+oberon_const_expr(oberon_context_t * ctx)
+{
+	oberon_expr_t * expr;
+	expr = oberon_expr(ctx);
+
+	if(expr -> is_item == 0)
+	{
+		oberon_error(ctx, "const expression are required");
+	}
+
+	return (oberon_item_t *) expr;
+}
+
 // =======================================================================
 //   PARSER
 // =======================================================================
@@ -817,11 +1034,49 @@ oberon_assert_ident(oberon_context_t * ctx)
 	return ident;
 }
 
+static oberon_type_t *
+oberon_make_array_type(oberon_context_t * ctx, int dim, oberon_item_t * size, oberon_type_t * base)
+{
+	assert(dim == 1);
+	oberon_type_t * newtype;
+
+	if(size -> mode != MODE_INTEGER)
+	{
+		oberon_error(ctx, "requires integer constant");
+	}
+
+	newtype = oberon_new_type_ptr(OBERON_TYPE_ARRAY);
+	newtype -> dim = dim;
+	newtype -> size = size -> integer;
+	newtype -> base = base;
+	oberon_generator_init_type(ctx, newtype);
+
+	return newtype;
+}
+
 static oberon_type_t *
 oberon_type(oberon_context_t * ctx)
 {
-	char * name = oberon_assert_ident(ctx);
-	oberon_type_t * type = oberon_find_type(ctx -> decl, name);
+	oberon_type_t * type;
+
+	if(ctx -> token == IDENT)
+	{
+		char * name = oberon_assert_ident(ctx);
+		type = oberon_find_type(ctx -> decl, name);
+	}
+	else if(ctx -> token == ARRAY)
+	{
+		oberon_assert_token(ctx, ARRAY);
+		oberon_item_t * size = oberon_const_expr(ctx);
+		oberon_assert_token(ctx, OF);
+		oberon_type_t * base = oberon_type(ctx);
+		type = oberon_make_array_type(ctx, 1, size, base);
+	}
+	else
+	{
+		oberon_error(ctx, "invalid type declaration");
+	}
+
 	return type;
 }
 
@@ -831,26 +1086,113 @@ oberon_var_decl(oberon_context_t * ctx)
 	char * name = oberon_assert_ident(ctx);
 	oberon_assert_token(ctx, COLON);
 	oberon_type_t * type = oberon_type(ctx);
-	oberon_define_var(ctx -> decl, name, type);
+	oberon_define_var(ctx -> decl, OBERON_CLASS_VAR, name, type);
 }
 
-static void
-oberon_make_procedure_begin(oberon_context_t * ctx, char * name)
+static oberon_object_t *
+oberon_make_param(oberon_context_t * ctx, int token, char * name, oberon_type_t * type)
 {
-	oberon_object_t * proc;
-	proc = oberon_define_proc(ctx -> decl, name);
+	oberon_object_t * param;
 
-	oberon_open_scope(ctx);
+	if(token == VAR)
+	{
+		param = oberon_define_var(ctx -> decl, OBERON_CLASS_VAR_PARAM, name, type);
+	}
+	else if(token == IDENT)
+	{
+		param = oberon_define_var(ctx -> decl, OBERON_CLASS_PARAM, name, type);
+	}
+	else
+	{
+		oberon_error(ctx, "oberon_make_param: wat");
+	}
 
-	oberon_generate_begin_proc(ctx, proc);
+	return param;
+}
+
+static oberon_object_t *
+oberon_fp_section(oberon_context_t * ctx, int * num_decl)
+{
+	int modifer_token = ctx -> token;
+	if(ctx -> token == VAR)
+	{
+		oberon_read_token(ctx);
+	}
+
+	char * name;
+	name = oberon_assert_ident(ctx);
+
+	oberon_assert_token(ctx, COLON);
+
+	oberon_type_t * type;
+	type = oberon_type(ctx);
+
+	oberon_object_t * first;
+	first = oberon_make_param(ctx, modifer_token, name, type);
+
+	*num_decl += 1;
+	return first;
+}
+
+#define ISFPSECTION \
+	((ctx -> token == VAR) || (ctx -> token == IDENT))
+
+static oberon_type_t *
+oberon_formal_pars(oberon_context_t * ctx)
+{
+	oberon_type_t * tp;
+	tp = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
+	tp -> num_decl = 0;
+	tp -> base = ctx -> void_type;
+	tp -> decl = NULL;
+
+	oberon_assert_token(ctx, LPAREN);
+
+	if(ISFPSECTION)
+	{
+		tp -> decl = oberon_fp_section(ctx, &tp -> num_decl);
+		while(ctx -> token == SEMICOLON)
+		{
+			oberon_assert_token(ctx, SEMICOLON);
+			oberon_fp_section(ctx, &tp -> num_decl);
+		}
+	}
+
+	oberon_assert_token(ctx, RPAREN);
+
+	if(ctx -> token == COLON)
+	{
+		oberon_assert_token(ctx, COLON);
+		tp -> base = oberon_type(ctx);
+	}
+
+	oberon_generator_init_type(ctx, tp);
+	return tp;
 }
 
 static void
-oberon_make_procedure_end(oberon_context_t * ctx)
+oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
 {
-	oberon_generate_end_proc(ctx);
+	if(ctx -> result_type -> class == OBERON_TYPE_VOID)
+	{
+		if(expr != NULL)
+		{
+			oberon_error(ctx, "procedure has no result type");
+		}
+	}
+	else
+	{
+		if(expr == NULL)
+		{
+			oberon_error(ctx, "procedure requires expression on result");
+		}
 
-	oberon_close_scope(ctx -> decl);
+		oberon_autocast_to(ctx, expr, ctx -> result_type);
+	}
+
+	ctx -> has_return = 1;
+
+	oberon_generate_return(ctx, expr);
 }
 
 static void
@@ -861,28 +1203,116 @@ oberon_proc_decl(oberon_context_t * ctx)
 	char * name;
 	name = oberon_assert_ident(ctx);
 
+	oberon_scope_t * this_proc_def_scope = ctx -> decl;
+	oberon_open_scope(ctx);
+
+	oberon_type_t * signature;
+	if(ctx -> token == LPAREN)
+	{
+		signature = oberon_formal_pars(ctx);
+	}
+	else
+	{
+		signature = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
+		signature -> num_decl = 0;
+		signature -> base = ctx -> void_type;
+		signature -> decl = NULL;
+		oberon_generator_init_type(ctx, signature);
+	}
+
+	oberon_object_t * proc;
+	proc = oberon_define_proc(this_proc_def_scope, name, signature);
+
+	ctx -> result_type = signature -> base;
+	ctx -> has_return = 0;
+
 	oberon_assert_token(ctx, SEMICOLON);
 
-	oberon_make_procedure_begin(ctx, name);
+	oberon_generate_begin_proc(ctx, proc);
+
+	// TODO declarations
+
 	if(ctx -> token == BEGIN)
 	{
 		oberon_assert_token(ctx, BEGIN);
 		oberon_statement_seq(ctx);
 	}
-	oberon_make_procedure_end(ctx);
 
 	oberon_assert_token(ctx, END);
 	char * name2 = oberon_assert_ident(ctx);
-
 	if(strcmp(name2, name) != 0)
 	{
 		oberon_error(ctx, "procedure name not matched");
 	}
+
+	if(signature -> base -> class == OBERON_TYPE_VOID)
+	{
+		oberon_make_return(ctx, NULL);
+	}
+
+	if(ctx -> 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_const_decl(oberon_context_t * ctx)
+{
+	char * name;
+	oberon_item_t * value;
+	oberon_object_t * constant;
+
+	name = oberon_assert_ident(ctx);
+	oberon_assert_token(ctx, EQUAL);
+	value = oberon_const_expr(ctx);
+
+	constant = oberon_define_object(ctx -> decl, name, OBERON_CLASS_CONST);
+	constant -> value = value;
+}
+
+static void
+oberon_type_decl(oberon_context_t * ctx)
+{
+	char * name;
+	oberon_object_t * newtype;
+	oberon_type_t * type;
+
+	name = oberon_assert_ident(ctx);
+	oberon_assert_token(ctx, EQUAL);
+	type = oberon_type(ctx);
+
+	newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE);
+	newtype -> type = type;
 }
 
 static void
 oberon_decl_seq(oberon_context_t * ctx)
 {
+	if(ctx -> token == CONST)
+	{
+		oberon_assert_token(ctx, CONST);
+		while(ctx -> token == IDENT)
+		{
+			oberon_const_decl(ctx);
+			oberon_assert_token(ctx, SEMICOLON);
+		}
+	}
+
+	if(ctx -> token == TYPE)
+	{
+		oberon_assert_token(ctx, TYPE);
+		while(ctx -> token == IDENT)
+		{
+			oberon_type_decl(ctx);
+			oberon_assert_token(ctx, SEMICOLON);
+		}
+	}
+
 	if(ctx -> token == VAR)
 	{
 		oberon_assert_token(ctx, VAR);
@@ -893,7 +1323,7 @@ oberon_decl_seq(oberon_context_t * ctx)
 		}
 	}
 
-	if(ctx -> token == PROCEDURE)
+	while(ctx -> token == PROCEDURE)
 	{
 		oberon_proc_decl(ctx);
 		oberon_assert_token(ctx, SEMICOLON);
@@ -903,42 +1333,14 @@ oberon_decl_seq(oberon_context_t * ctx)
 static void
 oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 {
-	if(src -> result -> class != dst -> result -> class)
-	{
-		oberon_error(ctx, "incompatible assignment types");
-	}
-
-	if(dst -> result -> class == OBERON_TYPE_INTEGER)
-	{
-		if((dst -> result -> size) < (src -> result -> size))
-		{
-			oberon_error(ctx, "incompatible assignment type size");
-		}
-	}
-
+	oberon_autocast_to(ctx, src, dst -> result);
 	oberon_generate_assign(ctx, src, dst);
 }
 
 static void
 oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig)
 {
-	if(desig -> is_item == 0)
-	{
-		oberon_error(ctx, "expected item");
-	}
-
-	if(desig -> item.mode != MODE_CALL)
-	{
-		oberon_error(ctx, "expected mode CALL");
-	}
-
-	if(desig -> item.var -> class != OBERON_CLASS_PROC)
-	{
-		oberon_error(ctx, "only procedures can be called");
-	}
-
-	// TODO check arguments
-
+	oberon_autocast_call(ctx, desig);
 	oberon_generate_call_proc(ctx, desig);
 }
 
@@ -950,7 +1352,7 @@ oberon_statement(oberon_context_t * ctx)
 
 	if(ctx -> token == IDENT)
 	{
-		item1 = oberon_expr(ctx);
+		item1 = oberon_designator(ctx);
 		if(ctx -> token == ASSIGN)
 		{
 			oberon_assert_token(ctx, ASSIGN);
@@ -959,9 +1361,24 @@ oberon_statement(oberon_context_t * ctx)
 		}
 		else
 		{
+			item1 = oberon_opt_proc_parens(ctx, item1);
 			oberon_make_call(ctx, item1);
 		}
 	}
+	else if(ctx -> token == RETURN)
+	{
+		oberon_assert_token(ctx, RETURN);
+		if(ISEXPR(ctx -> token))
+		{
+			oberon_expr_t * expr;
+			expr = oberon_expr(ctx);
+			oberon_make_return(ctx, expr);
+		}
+		else
+		{
+			oberon_make_return(ctx, NULL);
+		}
+	}
 }
 
 static void
@@ -1010,40 +1427,16 @@ oberon_parse_module(oberon_context_t * ctx)
 //   LIBRARY
 // =======================================================================
 
-static oberon_type_t *
-oberon_new_type_ptr(int class)
-{
-	oberon_type_t * x = malloc(sizeof *x);
-	memset(x, 0, sizeof *x);
-	x -> class = class;
-	return x;
-}
-
-static oberon_type_t *
-oberon_new_type_integer(int size)
-{
-	oberon_type_t * x;
-	x = oberon_new_type_ptr(OBERON_TYPE_INTEGER);
-	x -> size = size;
-	return x;
-}
-
-static oberon_type_t *
-oberon_new_type_boolean(int size)
-{
-	oberon_type_t * x;
-	x = oberon_new_type_ptr(OBERON_TYPE_BOOLEAN);
-	x -> size = size;
-	return x;
-}
-
 static void
 register_default_types(oberon_context_t * ctx)
 {
-	ctx -> int_type = oberon_new_type_integer(sizeof(int));
-	ctx -> bool_type = oberon_new_type_boolean(sizeof(int));
+	ctx -> void_type = oberon_new_type_ptr(OBERON_TYPE_VOID);
+	oberon_generator_init_type(ctx, ctx -> void_type);
 
+	ctx -> int_type = oberon_new_type_integer(sizeof(int));
 	oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type);
+
+	ctx -> bool_type = oberon_new_type_boolean(sizeof(int));
 	oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type);
 }
 
diff --git a/oberon.h b/oberon.h
index f29aa4d..becdd78 100644
--- a/oberon.h
+++ b/oberon.h
@@ -1,12 +1,56 @@
 #ifndef EMBEDED_OBERON_SCRIPT_H
 #define EMBEDED_OBERON_SCRIPT_H
 
+#include <libgccjit.h>
+
+/*
+ * Стуктуры данных генератора
+ */
+
+typedef struct
+{
+	gcc_jit_function * gcc_func;
+} gen_proc_t;
+
+typedef struct
+{
+	gcc_jit_type * gcc_type;
+} gen_type_t;
+
+typedef struct
+{
+        char stub[16];
+        gcc_jit_lvalue * gcc_lvalue;
+        gcc_jit_param * gcc_param;
+} gen_var_t;
+
+typedef struct
+{
+        gcc_jit_context * gcc_context;
+        gcc_jit_block * gcc_block;
+        gcc_jit_result * gcc_result;
+} gen_context_t;
+
 typedef struct oberon_type_s oberon_type_t;
 typedef struct oberon_object_s oberon_object_t;
 typedef struct oberon_module_s oberon_module_t;
 typedef struct oberon_context_s oberon_context_t;
 typedef struct oberon_scope_s oberon_scope_t;
 
+typedef struct oberon_item_s oberon_item_t;
+typedef struct oberon_oper_s oberon_oper_t;
+typedef union oberon_expr_u oberon_expr_t;
+
+/*
+ * Структура oberon_scope_s (oberon_type_t) реализует стекообразную
+ * область видимости объектов.
+ * Поля:
+ *   ctx  -- контекст в котором область видимости была создана;
+ *   list -- список объявлений. Первый элемент всегда существует,
+ *           но не используется и должен быть пропущен.
+ *   up   -- ссылка на облась видимости уровнем выше.
+ */
+
 struct oberon_scope_s
 {
 	oberon_context_t * ctx;
@@ -14,40 +58,102 @@ struct oberon_scope_s
 	oberon_scope_t * up;
 };
 
+/*
+ * Формы типов данных.
+ * Тип VOID используется как заглушка возврата типа в обычных процедурах
+ */
+
 enum
 {
+	OBERON_TYPE_VOID,
 	OBERON_TYPE_INTEGER,
 	OBERON_TYPE_BOOLEAN,
+	OBERON_TYPE_PROCEDURE,
+	OBERON_TYPE_ARRAY
 };
 
+/*
+ * Структура oberon_type_s (oberon_type_t) описывает типы данных.
+ * Поля:
+ *   class -- Форма типа данных (OBERON_TYPE_*).
+ *   size  -- Размер примитива в байтах или количество ячеек массива.
+ *            Ноль для открытых массивов.
+ *   num_decl -- Количество объявленых полей в структуре или сигнатуре процедуры.
+ *   base  -- Базовый тип структуры или тип возврата процедуры.
+ *   decl -- Список объявлений. Перебор начинается с первого элемента.
+ *
+ * Таблица использования полей:
+ *   class size num_decl base decl
+ *   VOID  -    -        -    -
+ *   INT   +    -        -    -
+ *   BOOL  +    -        -    -
+ *   PROC  -    +        +    +
+ */
+
 struct oberon_type_s
 {
 	int class;
 	int size;
 
-	void * gen_type;
+	int dim;
+
+	int num_decl;
+	oberon_type_t * base;
+	oberon_object_t * decl;
+
+	gen_type_t * gen_type;
 };
 
+/*
+ * Классы объектов.
+ *   VAR -- переменная.
+ *   TYPE -- тип данных.
+ *   PROC -- процедура.
+ *   PARAM -- параметр процедуры.
+ *   VAR_PARAM -- VAR-параметр процедуры.
+ */
+
 enum
 {
 	OBERON_CLASS_VAR,
 	OBERON_CLASS_TYPE,
-	OBERON_CLASS_PROC
+	OBERON_CLASS_PROC,
+	OBERON_CLASS_PARAM,
+	OBERON_CLASS_VAR_PARAM,
+	OBERON_CLASS_CONST
 };
 
+/*
+ * Структура oberon_object_s (oberon_object_t) описывает все
+ * объявления которые могут иметь имя. От констант, до процедур.
+ * Поля:
+ *   name -- имя объекта.
+ *   class -- класс объекта (OBERON_CLASS_*).
+ *   type -- ссылка на тип переменной, дескриптор типа или сигнатуру процедуры.
+ *   next -- ссылка на следующий объект в списке.
+ */
+
 struct oberon_object_s
 {
 	char * name;
 	int class;
 
 	oberon_type_t * type;
-
-	void * gen_var;
-	void * gen_proc;
-
+	oberon_item_t * value;
 	oberon_object_t * next;
+
+	gen_var_t * gen_var;
+	gen_proc_t * gen_proc;
 };
 
+/*
+ * Структура oberon_module_s (oberon_module_t) описывает объявление модуля.
+ * Поля:
+ *   name -- настоящее имя модуля.
+ *   decl -- все глобальные объявления в модуле.
+ *   begin -- Указатель на сгенерированный код тела модуля (секция BEGIN).
+ */
+
 struct oberon_module_s
 {
 	char * name;
@@ -57,6 +163,23 @@ struct oberon_module_s
 	void (* begin)();
 };
 
+/*
+ * Структура oberon_context_s (oberon_context_t) учитывает текущее состояние интерпретатора.
+ * Один экземпляр не может использоваться в нескольких потоках одновременно.
+ * Поля:
+ *   code    -- входной буффер для сканера.
+ *   code_index -- Текущая позия в буффере.
+ *   с       -- последний прочитанный символ.
+ *   token   -- последний прочитанный токен.
+ *   string  -- буфер с прочитанной строкой / идентификатором.
+ *              всегда имеет уникальный адрес и может изменяться.
+ *   integer -- прочитанное целое число.
+ *   decl    -- текущая область видимости.
+ *   mod     -- текущий модуль.
+ *   int_type, bool_type, void_type -- стандартные типы.
+ *   world_scope -- область видимости "мир" - выше модуля.
+ */
+
 struct oberon_context_s
 {
 	const char * code;
@@ -67,24 +190,30 @@ struct oberon_context_s
 	char * string;
 	int integer;
 
+	int has_return;
+	oberon_type_t * result_type;
+
 	oberon_scope_t * decl;
 	oberon_module_t * mod;
 
 	oberon_type_t * int_type;
 	oberon_type_t * bool_type;
+	oberon_type_t * void_type;
 	oberon_scope_t * world_scope;
 
-	void * gen_context;
+	gen_context_t * gen_context;
 };
 
-enum {
+enum
+{
 	MODE_VAR,
 	MODE_INTEGER,
 	MODE_BOOLEAN,
 	MODE_CALL
 };
 
-enum {
+enum
+{
 	OP_LOGIC_NOT,
 	OP_UNARY_MINUS,
 	OP_ADD,
@@ -102,25 +231,26 @@ enum {
 	OP_GEQ
 };
 
-typedef struct oberon_item_s oberon_item_t;
-typedef struct oberon_oper_s oberon_oper_t;
-typedef union oberon_expr_u oberon_expr_t;
-
 struct oberon_item_s
 {
-	int is_item;
+	int is_item; // == 1
 	oberon_type_t * result;
+	oberon_expr_t * next;
 
 	int mode;
 	int integer;
 	int boolean;
 	oberon_object_t * var;
+
+	int num_args;
+	oberon_expr_t * args;
 };
 
 struct oberon_oper_s
 {
-	int is_item;
+	int is_item; // == 0
 	oberon_type_t * result;
+	oberon_expr_t * next;
 
 	int op;
 	oberon_expr_t * left;
@@ -132,6 +262,7 @@ union oberon_expr_u
 	struct {
 		int is_item;
 		oberon_type_t * result;
+		oberon_expr_t * next;
 	};
 
 	oberon_item_t item;
diff --git a/test.c b/test.c
index da6a804..7c8e672 100644
--- a/test.c
+++ b/test.c
@@ -3,21 +3,42 @@
 
 static const char source[] =
 	"MODULE Test;"
+	"CONST"
+	"	con = 3;"
+	""
+	"TYPE"
+	"	MyInt = INTEGER;"
+	"	MyArr = ARRAY con OF MyInt;"
+	""
 	"VAR"
 	"	k : INTEGER;"
 	"	i : INTEGER;"
 	"	b : BOOLEAN;"
+	"	arr : MyArr;"
 	""
 	"PROCEDURE Tier;"
 	"BEGIN"
-	"	k := 314;"
+	"	k := 314 + con;"
 	"END Tier;"
 	""
+	"PROCEDURE Tier2(x : INTEGER; y : INTEGER);"
+	"BEGIN"
+	"	k := x + y;"
+	"END Tier2;"
+	""
+	"PROCEDURE Tier3(x : INTEGER) : INTEGER;"
+	"BEGIN"
+	"	RETURN x * x * x;"
+	"END Tier3;"
+	""
 	"BEGIN"
 	"	k := 1;"
 	"	i := k;"
-	"	b := TRUE;"
-	"	Tier;"
+	"	b := (TRUE # FALSE);"
+	"	Tier();"
+	"	Tier2(21, 13);"
+	"	k := Tier3(2);"
+//	"	arr[0] := 1;"
 	"END Test."
 ;