diff --git a/src/oberon.c b/src/oberon.c
index e95a9bef396271f68b2dff5a6af06147cc530c09..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"
@@ -1011,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)
{
@@ -1019,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)
{
@@ -1228,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:
@@ -2988,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);
}
@@ -3382,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)
{
@@ -3406,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;