Добавлены функции MIN, MAX и SIZE

diff --git a/make.sh b/make.sh
index 64ae77f1716f1efecbd865152c6f4f83fd448fa5..69ffaeee0d35eda542db9c1198480c31c6988241 100755 (executable)
--- a/make.sh
+++ b/make.sh
@@ -3,7 +3,7 @@
 set -e
 
 CC="gcc"
-CFLAGS="-g -Wall -Werror -std=c11 -lgc"
+CFLAGS="-g -Wall -Werror -std=c11 -lm -lgc"
 
 case "$1" in
   jvm)

diff --git a/notes b/notes
index 15aa1da6de3a10d2105fea29184e0af25f7174bf..416ccefe02bdce71148f6bef1e5eb98030c15c18 100644 (file)
--- a/notes
+++ b/notes
@@ -6,7 +6,7 @@
 - Нет конструкции CASE
 - Нет конструкции WITH
 - Нет модуля SYSTEM
-- Нет функций ASH CAP CHR ENTIER LEN LONG MAX MIN ODD ORD SHORT SIZE
+- Нет функций ASH CAP CHR ENTIER LEN LONG ODD ORD SHORT
 - Нет процедур ASSERT COPY DEC EXCL HALT INC INCL
 - Не реализована свёртка констант
 - Не счёта строк / столбцов

diff --git a/src/oberon-internals.h b/src/oberon-internals.h
index 7a776d695502bec8b53225c031e31f808d207841..07d8d032a85b8460ffa9a6f1617fb19863306cab 100644 (file)
--- a/src/oberon-internals.h
+++ b/src/oberon-internals.h
@@ -175,7 +175,8 @@ enum oberon_mode_kind
        MODE_NEW,
        MODE_REAL,
        MODE_CHAR,
-       MODE_STRING
+       MODE_STRING,
+       MODE_TYPE
 };
 
 enum oberon_operator_kind

diff --git a/src/oberon.c b/src/oberon.c
index e95a9bef396271f68b2dff5a6af06147cc530c09..a2a567036598a90f005bcc1780531e18e6d54701 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -5,6 +5,7 @@
 #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) \
@@ -1489,6 +1476,9 @@ oberon_designator(oberon_context_t * ctx)
                        // 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:
@@ -1942,6 +1932,7 @@ oberon_const_expr(oberon_context_t * ctx)
                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;
@@ -3507,7 +3610,14 @@ oberon_create_context(ModuleImportCallback import_module)
        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;

diff --git a/src/test.c b/src/test.c
index ebb807bc518fa1211589cb47f32e2ae7f733bd38..33f1aeba29afe63852163207b4e4baef9900f715 100644 (file)
--- a/src/test.c
+++ b/src/test.c
@@ -13,13 +13,19 @@ static char source_test[] =
        "  i, len : INTEGER;"
        ""
        "BEGIN"
-       "  Out.Open();"
-       "  LOOP"
-       "    Out.String('Count '); Out.Int(i, 0); Out.Ln;"
-       "    i := i + 1;"
-       "    IF i > 4 THEN EXIT END;"
-       "  END;"
-       "  Out.String('end'); Out.Ln;"
+       "  Out.Open;"
+       "  Out.Int(MIN(BYTE), 0); Out.Ln;"
+       "  Out.Int(MIN(SHORTINT), 0); Out.Ln;"
+       "  Out.Int(MIN(INTEGER), 0); Out.Ln;"
+       "  Out.Int(MIN(LONGINT), 0); Out.Ln;"
+       "  Out.Int(MAX(BYTE), 0); Out.Ln;"
+       "  Out.Int(MAX(SHORTINT), 0); Out.Ln;"
+       "  Out.Int(MAX(INTEGER), 0); Out.Ln;"
+       "  Out.Int(MAX(LONGINT), 0); Out.Ln;"
+       "  Out.Int(SIZE(BYTE), 0); Out.Ln;"
+       "  Out.Int(SIZE(SHORTINT), 0); Out.Ln;"
+       "  Out.Int(SIZE(INTEGER), 0); Out.Ln;"
+       "  Out.Int(SIZE(LONGINT), 0); Out.Ln;"
        "END Test."
 ;