diff --git a/oberon.c b/oberon.c
index dab60b0bb151dce64579a099f2aa59f5722a2eb6..16043c2f7aa0e4bdcd658130a5765b126b385b11 100644 (file)
--- a/oberon.c
+++ b/oberon.c
#include <ctype.h>
#include <string.h>
#include <assert.h>
+#include <stdbool.h>
#include "oberon.h"
#include "generator.h"
TO,
UPARROW,
NIL,
- IMPORT
+ IMPORT,
+ REAL
};
// =======================================================================
return x;
}
+static oberon_type_t *
+oberon_new_type_real(int size)
+{
+ oberon_type_t * x;
+ x = oberon_new_type_ptr(OBERON_TYPE_REAL);
+ x -> size = size;
+ return x;
+}
+
// =======================================================================
// TABLE
// =======================================================================
}
static void
-oberon_read_integer(oberon_context_t * ctx)
-{
- int len = 0;
- int i = ctx -> code_index;
+oberon_read_number(oberon_context_t * ctx)
+{
+ long integer;
+ double real;
+ char * ident;
+ int start_i;
+ int exp_i;
+ int end_i;
+
+ /*
+ * mode = 0 == DEC
+ * mode = 1 == HEX
+ * mode = 2 == REAL
+ * mode = 3 == LONGREAL
+ */
+ int mode = 0;
+ start_i = ctx -> code_index;
+
+ while(isdigit(ctx -> c))
+ {
+ oberon_get_char(ctx);
+ }
- int c = ctx -> code[i];
- while(isdigit(c))
+ end_i = ctx -> code_index;
+
+ if(isxdigit(ctx -> c))
{
- i += 1;
- len += 1;
- c = ctx -> code[i];
+ mode = 1;
+ while(isxdigit(ctx -> c))
+ {
+ oberon_get_char(ctx);
+ }
+
+ end_i = ctx -> code_index;
+
+ if(ctx -> c != 'H')
+ {
+ oberon_error(ctx, "invalid hex number");
+ }
+ oberon_get_char(ctx);
}
+ else if(ctx -> c == '.')
+ {
+ mode = 2;
+ oberon_get_char(ctx);
- char * ident = malloc(len + 2);
- memcpy(ident, &ctx->code[ctx->code_index], len);
- ident[len + 1] = 0;
+ while(isdigit(ctx -> c))
+ {
+ oberon_get_char(ctx);
+ }
+
+ if(ctx -> c == 'E' || ctx -> c == 'D')
+ {
+ exp_i = ctx -> code_index;
+
+ if(ctx -> c == 'D')
+ {
+ mode = 3;
+ }
+
+ oberon_get_char(ctx);
+
+ if(ctx -> c == '+' || ctx -> c == '-')
+ {
+ oberon_get_char(ctx);
+ }
+
+ while(isdigit(ctx -> c))
+ {
+ oberon_get_char(ctx);
+ }
+
+ }
+
+ end_i = ctx -> code_index;
+ }
+
+ int len = end_i - start_i;
+ ident = malloc(len + 1);
+ memcpy(ident, &ctx -> code[start_i], len);
+ ident[len] = 0;
+
+ if(mode == 3)
+ {
+ int i = exp_i - start_i;
+ ident[i] = 'E';
+ }
+
+ switch(mode)
+ {
+ case 0:
+ integer = atol(ident);
+ real = integer;
+ ctx -> token = INTEGER;
+ break;
+ case 1:
+ sscanf(ident, "%lx", &integer);
+ real = integer;
+ ctx -> token = INTEGER;
+ break;
+ case 2:
+ case 3:
+ sscanf(ident, "%lf", &real);
+ ctx -> token = REAL;
+ break;
+ default:
+ oberon_error(ctx, "oberon_read_number: wat");
+ break;
+ }
- ctx -> code_index = i;
- ctx -> c = ctx -> code[i];
ctx -> string = ident;
- ctx -> integer = atoi(ident);
- ctx -> token = INTEGER;
+ ctx -> integer = integer;
+ ctx -> real = real;
}
static void
}
else if(isdigit(c))
{
- oberon_read_integer(ctx);
+ oberon_read_number(ctx);
}
else
{
@@ -922,15 +1024,18 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon
}
// Статическая проверка границ массива
- if(index -> is_item)
+ if(desig -> result -> size != 0)
{
- if(index -> item.mode == MODE_INTEGER)
+ if(index -> is_item)
{
- int arr_size = desig -> result -> size;
- int index_int = index -> item.integer;
- if(index_int < 0 || index_int > arr_size - 1)
+ if(index -> item.mode == MODE_INTEGER)
{
- oberon_error(ctx, "not in range (dimension size 0..%i)", arr_size - 1);
+ 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);
+ }
}
}
}
expr -> item.integer = ctx -> integer;
oberon_assert_token(ctx, INTEGER);
break;
+ case REAL:
+ expr = oberon_new_item(MODE_REAL, ctx -> real_type, 1);
+ expr -> item.real = ctx -> real;
+ oberon_assert_token(ctx, REAL);
+ break;
case TRUE:
expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, 1);
expr -> item.boolean = 1;
@@ -1304,6 +1414,46 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
oberon_error(ctx, "oberon_make_bin_op: bool wat");
}
}
+ else if(token == SLASH)
+ {
+ if(a -> result -> class != OBERON_TYPE_REAL)
+ {
+ if(a -> result -> class == OBERON_TYPE_INTEGER)
+ {
+ oberon_error(ctx, "TODO cast int -> real");
+ }
+ else
+ {
+ oberon_error(ctx, "operator / requires numeric type");
+ }
+ }
+
+ if(b -> result -> class != OBERON_TYPE_REAL)
+ {
+ if(b -> result -> class == OBERON_TYPE_INTEGER)
+ {
+ oberon_error(ctx, "TODO cast int -> real");
+ }
+ else
+ {
+ oberon_error(ctx, "operator / requires numeric type");
+ }
+ }
+
+ oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);
+ expr = oberon_new_operator(OP_DIV, result, a, b);
+ }
+ else if(token == DIV)
+ {
+ if(a -> result -> class != OBERON_TYPE_INTEGER
+ || b -> result -> class != OBERON_TYPE_INTEGER)
+ {
+ oberon_error(ctx, "operator DIV requires integer type");
+ }
+
+ oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);
+ expr = oberon_new_operator(OP_DIV, result, a, b);
+ }
else
{
oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);
@@ -1320,14 +1470,6 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
{
expr = oberon_new_operator(OP_MUL, result, a, b);
}
- else if(token == SLASH)
- {
- expr = oberon_new_operator(OP_DIV, result, a, b);
- }
- else if(token == DIV)
- {
- expr = oberon_new_operator(OP_DIV, result, a, b);
- }
else if(token == MOD)
{
expr = oberon_new_operator(OP_MOD, result, a, b);
@@ -1892,6 +2034,14 @@ oberon_make_multiarray(oberon_context_t * ctx, oberon_expr_t * sizes, oberon_typ
oberon_make_array_type(ctx, sizes, dim, type);
}
+static void
+oberon_make_open_array(oberon_context_t * ctx, oberon_type_t * base, oberon_type_t * type)
+{
+ type -> class = OBERON_TYPE_ARRAY;
+ type -> size = 0;
+ type -> base = base;
+}
+
static void
oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
{
int num_sizes = 0;
oberon_expr_t * sizes;
- oberon_expr_list(ctx, &num_sizes, &sizes, 1);
+
+ if(ISEXPR(ctx -> token))
+ {
+ 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_multiarray(ctx, sizes, base, type);
+ if(num_sizes == 0)
+ {
+ oberon_make_open_array(ctx, base, *type);
+ }
+ else
+ {
+ oberon_make_multiarray(ctx, sizes, base, type);
+ }
}
else if(ctx -> token == RECORD)
{
}
else if(type -> class == OBERON_TYPE_ARRAY)
{
+ if(type -> size != 0)
+ {
+ if(type -> base -> class == OBERON_TYPE_ARRAY)
+ {
+ if(type -> base -> size == 0)
+ {
+ oberon_error(ctx, "open array not allowed as array element");
+ }
+ }
+ }
+
oberon_initialize_type(ctx, type -> base);
oberon_generator_init_type(ctx, type);
}
oberon_initialize_type(ctx, x -> type);
break;
case OBERON_CLASS_VAR:
+ case OBERON_CLASS_FIELD:
+ if(x -> type -> class == OBERON_TYPE_ARRAY)
+ {
+ if(x -> type -> size == 0)
+ {
+ oberon_error(ctx, "open array not allowed as variable or field");
+ }
+ }
+ oberon_initialize_type(ctx, x -> type);
+ oberon_generator_init_var(ctx, x);
+ break;
case OBERON_CLASS_PARAM:
case OBERON_CLASS_VAR_PARAM:
- case OBERON_CLASS_FIELD:
oberon_initialize_type(ctx, x -> type);
oberon_generator_init_var(ctx, x);
break;
ctx -> int_type = oberon_new_type_integer(sizeof(int));
oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type, 1);
- ctx -> bool_type = oberon_new_type_boolean(sizeof(int));
+ ctx -> bool_type = oberon_new_type_boolean(sizeof(bool));
oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type, 1);
+
+ ctx -> real_type = oberon_new_type_real(sizeof(float));
+ oberon_define_type(ctx -> world_scope, "REAL", ctx -> real_type, 1);
}
static void
@@ -2583,11 +2768,6 @@ oberon_make_new_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
oberon_error(ctx, "too few arguments");
}
- if(num_args > 1)
- {
- oberon_error(ctx, "too mach arguments");
- }
-
oberon_expr_t * dst;
dst = list_args;
@@ -2606,37 +2786,58 @@ oberon_make_new_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
src -> item.num_args = 0;
src -> item.args = NULL;
+ int max_args = 1;
if(type -> class == OBERON_TYPE_ARRAY)
{
- // Пригодится при работе с открытыми массивами
- /*
- int dim = 1;
- oberon_expr_t * sizes = NULL;
- oberon_expr_t * last_size = NULL;
- sizes = last_size = oberon_new_item(MODE_INTEGER, ctx -> int_type, 1);
- sizes -> item.integer = type -> size;
- oberon_type_t * base = type -> base;
- while(base -> class == OBERON_TYPE_ARRAY)
+ if(type -> size == 0)
{
- oberon_expr_t * size;
- size = last_size = oberon_new_item(MODE_INTEGER, ctx -> int_type, 1);
- size -> item.integer = base -> size;
+ oberon_type_t * x = type;
+ while(x -> class == OBERON_TYPE_ARRAY)
+ {
+ if(x -> size == 0)
+ {
+ max_args += 1;
+ }
+ x = x -> base;
+ }
+ }
- last_size -> next = size;
- last_size = size;
- base = base -> base;
- dim += 1;
+ if(num_args < max_args)
+ {
+ oberon_error(ctx, "too few arguments");
}
- */
- src -> item.num_args = 0;
- src -> item.args = NULL;
+ if(num_args > max_args)
+ {
+ oberon_error(ctx, "too mach arguments");
+ }
+
+ int num_sizes = max_args - 1;
+ oberon_expr_t * size_list = list_args -> next;
+
+ oberon_expr_t * arg = size_list;
+ for(int i = 0; i < max_args - 1; i++)
+ {
+ if(arg -> result -> class != OBERON_TYPE_INTEGER)
+ {
+ oberon_error(ctx, "size must be integer");
+ }
+ arg = arg -> next;
+ }
+
+ src -> item.num_args = num_sizes;
+ src -> item.args = size_list;
}
else if(type -> class != OBERON_TYPE_RECORD)
{
oberon_error(ctx, "oberon_make_new_call: wat");
}
+ if(num_args > max_args)
+ {
+ oberon_error(ctx, "too mach arguments");
+ }
+
oberon_assign(ctx, src, dst);
}