diff --git a/oberon.c b/oberon.c
index dab60b0bb151dce64579a099f2aa59f5722a2eb6..4b20dad3d30de42797478959dc92d2cd1e8929b9 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
{
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 +1411,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 +1467,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);
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