diff --git a/oberon.c b/oberon.c
index f4a711f5da3156912e43afb4bc8887dd076936a3..3837bf5b92702c744bcf7b883ff73395826063a8 100644 (file)
--- a/oberon.c
+++ b/oberon.c
RBRACE,
RECORD,
POINTER,
- TO
+ TO,
+ UPARROW,
+ NIL
};
// =======================================================================
{
ctx -> token = TO;
}
+ else if(strcmp(ident, "NIL") == 0)
+ {
+ ctx -> token = NIL;
+ }
}
static void
ctx -> token = RBRACE;
oberon_get_char(ctx);
break;
+ case '^':
+ ctx -> token = UPARROW;
+ oberon_get_char(ctx);
+ break;
default:
oberon_error(ctx, "invalid char");
break;
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)
}
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 +649,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 +673,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 +688,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
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;
|| ((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_error(ctx, "dimesions not matched");
-// }
+ oberon_type_t * base;
+ base = desig -> result -> base;
- oberon_type_t * base = desig -> item.var -> type -> base;
+ if(index -> result -> class != OBERON_TYPE_INTEGER)
+ {
+ oberon_error(ctx, "index must be integer");
+ }
+
+ // Статическая проверка границ массива
+ 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 +839,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 +864,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)
{
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");
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 = 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");
}
// PARSER
// =======================================================================
+static void oberon_decl_seq(oberon_context_t * ctx);
static void oberon_statement_seq(oberon_context_t * ctx);
static void
if(ctx -> token == COLON)
{
oberon_assert_token(ctx, COLON);
+ // TODO get by qualident
oberon_type(ctx, &signature -> base);
}
}
oberon_assert_token(ctx, SEMICOLON);
- oberon_generate_begin_proc(ctx, proc);
+ oberon_decl_seq(ctx);
+ oberon_generator_init_type(ctx, signature);
+ oberon_generator_init_proc(ctx, proc);
- // TODO declarations
+ oberon_generate_begin_proc(ctx, proc);
if(ctx -> token == BEGIN)
{
}
static void
-oberon_make_array_type(oberon_context_t * ctx, 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)
{
- 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");
}
@@ -1409,7 +1501,7 @@ oberon_make_array_type(oberon_context_t * ctx, oberon_item_t * size, oberon_type
oberon_type_t * arr;
arr = *type;
arr -> class = OBERON_TYPE_ARRAY;
- arr -> size = size -> integer;
+ arr -> size = size -> item.integer;
arr -> base = base;
}
@@ -1460,6 +1552,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)
{
{
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);
base = oberon_new_type_ptr(OBERON_TYPE_VOID);
oberon_type(ctx, &base);
- oberon_make_array_type(ctx, size, base, type);
+ oberon_make_multiarray(ctx, sizes, base, type);
}
else if(ctx -> token == RECORD)
{
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)
{
@@ -1902,6 +2004,11 @@ 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)
+ {
+ oberon_error(ctx, "procedure with result");
+ }
+
oberon_autocast_call(ctx, desig);
oberon_generate_call_proc(ctx, desig);
}
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);