diff --git a/src/oberon.c b/src/oberon.c
index f50f4d300246b4beed4fd6e58afaf21cb307cf3a..a2a567036598a90f005bcc1780531e18e6d54701 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
#include <string.h>
#include <assert.h>
#include <stdbool.h>
+#include <math.h>
#include "../include/oberon.h"
REPEAT,
UNTIL,
FOR,
- BY
+ BY,
+ LOOP,
+ EXIT
};
// =======================================================================
scope -> local = scope -> up -> local;
scope -> parent = scope -> up -> parent;
scope -> parent_type = scope -> up -> parent_type;
+ scope -> exit_label = scope -> up -> exit_label;
}
ctx -> decl = scope;
{
ctx -> token = BY;
}
+ else if(strcmp(ident, "LOOP") == 0)
+ {
+ ctx -> token = LOOP;
+ }
+ else if(strcmp(ident, "EXIT") == 0)
+ {
+ ctx -> token = EXIT;
+ }
}
static void
@@ -1000,6 +1012,42 @@ oberon_check_record_compatibility(oberon_context_t * ctx, oberon_type_t * from,
}
}
+static void
+oberon_check_dst(oberon_context_t * ctx, oberon_expr_t * dst)
+{
+ if(dst -> is_item == false)
+ {
+ oberon_error(ctx, "not variable");
+ }
+
+ switch(dst -> item.mode)
+ {
+ case MODE_VAR:
+ case MODE_CALL:
+ case MODE_INDEX:
+ case MODE_FIELD:
+ case MODE_DEREF:
+ case MODE_NEW:
+ /* accept */
+ break;
+ default:
+ oberon_error(ctx, "not variable");
+ break;
+ }
+}
+
+static void
+oberon_check_src(oberon_context_t * ctx, oberon_expr_t * src)
+{
+ if(src -> is_item)
+ {
+ if(src -> item.mode == MODE_TYPE)
+ {
+ oberon_error(ctx, "not variable");
+ }
+ }
+}
+
static oberon_expr_t *
oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
{
@@ -1008,6 +1056,8 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
// Если INTEGER переводится в REAL
// Есди STRING переводится в ARRAY OF CHAR
+ oberon_check_src(ctx, expr);
+
bool error = false;
if(pref -> class != expr -> result -> class)
{
@@ -1217,58 +1267,6 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args
}
}
-/*
-static void
-oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
-{
- switch(proc -> class)
- {
- case OBERON_CLASS_PROC:
- if(proc -> class != OBERON_CLASS_PROC)
- {
- oberon_error(ctx, "not a procedure");
- }
- break;
- case OBERON_CLASS_VAR:
- case OBERON_CLASS_VAR_PARAM:
- case OBERON_CLASS_PARAM:
- if(proc -> type -> class != OBERON_TYPE_PROCEDURE)
- {
- oberon_error(ctx, "not a procedure");
- }
- break;
- default:
- oberon_error(ctx, "not a procedure");
- break;
- }
-
- 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, 1);
- 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) \
// TODO copy value
expr = (oberon_expr_t *) var -> value;
break;
+ case OBERON_CLASS_TYPE:
+ expr = oberon_new_item(MODE_TYPE, var -> type, read_only);
+ break;
case OBERON_CLASS_VAR:
case OBERON_CLASS_VAR_PARAM:
case OBERON_CLASS_PARAM:
case MODE_REAL:
case MODE_CHAR:
case MODE_STRING:
+ case MODE_TYPE:
/* accept */
break;
default:
@@ -2977,6 +2979,7 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
oberon_error(ctx, "read-only destination");
}
+ oberon_check_dst(ctx, dst);
src = oberon_autocast_to(ctx, src, dst -> result);
oberon_generate_assign(ctx, src, dst);
}
oberon_generate_label(ctx, end);
oberon_assert_token(ctx, END);
}
+ else if(ctx -> token == LOOP)
+ {
+ gen_label_t * begin;
+ gen_label_t * end;
+
+ begin = oberon_generator_reserve_label(ctx);
+ end = oberon_generator_reserve_label(ctx);
+
+ oberon_open_scope(ctx);
+ oberon_assert_token(ctx, LOOP);
+ oberon_generate_label(ctx, begin);
+ ctx -> decl -> exit_label = end;
+ oberon_statement_seq(ctx);
+ oberon_generate_goto(ctx, begin);
+ oberon_generate_label(ctx, end);
+ oberon_assert_token(ctx, END);
+ oberon_close_scope(ctx -> decl);
+ }
+ else if(ctx -> token == EXIT)
+ {
+ oberon_assert_token(ctx, EXIT);
+ if(ctx -> decl -> exit_label == NULL)
+ {
+ oberon_error(ctx, "not in LOOP-END");
+ }
+ oberon_generate_goto(ctx, ctx -> decl -> exit_label);
+ }
else if(ctx -> token == RETURN)
{
oberon_assert_token(ctx, RETURN);
@@ -3344,6 +3374,118 @@ oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f
proc -> type -> genproc = p;
}
+static oberon_expr_t *
+oberon_make_min_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;
+
+ if(!arg -> is_item || arg -> item.mode != MODE_TYPE)
+ {
+ oberon_error(ctx, "MIN accept only type");
+ }
+
+ oberon_expr_t * expr;
+ int bits = arg -> result -> size * 8;
+ switch(arg -> result -> class)
+ {
+ case OBERON_TYPE_INTEGER:
+ expr = oberon_integer_item(ctx, -powl(2, bits - 1));
+ break;
+ default:
+ oberon_error(ctx, "allowed only basic types");
+ break;
+ }
+
+ return expr;
+}
+
+static oberon_expr_t *
+oberon_make_max_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;
+
+ if(!arg -> is_item || arg -> item.mode != MODE_TYPE)
+ {
+ oberon_error(ctx, "MAX accept only type");
+ }
+
+ oberon_expr_t * expr;
+ int bits = arg -> result -> size * 8;
+ switch(arg -> result -> class)
+ {
+ case OBERON_TYPE_INTEGER:
+ expr = oberon_integer_item(ctx, powl(2, bits - 1) - 1);
+ break;
+ default:
+ oberon_error(ctx, "allowed only basic types");
+ break;
+ }
+
+ return expr;
+}
+
+static oberon_expr_t *
+oberon_make_size_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;
+
+ if(!arg -> is_item || arg -> item.mode != MODE_TYPE)
+ {
+ oberon_error(ctx, "SIZE accept only type");
+ }
+
+ int size;
+ oberon_expr_t * expr;
+ oberon_type_t * type = arg -> result;
+ switch(type -> class)
+ {
+ case OBERON_TYPE_INTEGER:
+ case OBERON_TYPE_BOOLEAN:
+ case OBERON_TYPE_REAL:
+ size = type -> size;
+ break;
+ default:
+ oberon_error(ctx, "TODO SIZE");
+ break;
+ }
+
+ expr = oberon_integer_item(ctx, size);
+ return expr;
+}
+
static oberon_expr_t *
oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
{
@@ -3368,7 +3510,6 @@ oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
oberon_error(ctx, "ABS accepts only integers");
}
-
oberon_expr_t * expr;
expr = oberon_new_operator(OP_ABS, result_type, arg, NULL);
return expr;
oberon_generator_init_context(ctx);
register_default_types(ctx);
+
+ /* Functions */
oberon_new_intrinsic(ctx, "ABS", oberon_make_abs_call, NULL);
+ oberon_new_intrinsic(ctx, "MIN", oberon_make_min_call, NULL);
+ oberon_new_intrinsic(ctx, "MAX", oberon_make_max_call, NULL);
+ oberon_new_intrinsic(ctx, "SIZE", oberon_make_size_call, NULL);
+
+ /* Procedures */
oberon_new_intrinsic(ctx, "NEW", NULL, oberon_make_new_call);
return ctx;