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

[dsw-obn.git] / src / oberon.c

diff --git a/src/oberon.c b/src/oberon.c
index 0118ff9bfceded3989c464ed1a6f9fb59645a6be..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 <string.h>
 #include <assert.h>
 #include <stdbool.h>

+#include <math.h>

 
 #include "../include/oberon.h"
 
 
 #include "../include/oberon.h"
 


@@ -33,6 +34,8 @@ enum {
        LEQ,
        GREAT,
        GEQ,
        LEQ,
        GREAT,
        GEQ,

+       IN,
+       IS,

        PLUS,
        MINUS,
        OR,
        PLUS,
        MINUS,
        OR,


@@ -57,7 +60,21 @@ enum {
        UPARROW,
        NIL,
        IMPORT,
        UPARROW,
        NIL,
        IMPORT,

-       REAL
+       REAL,
+       CHAR,
+       STRING,
+       IF,
+       THEN,
+       ELSE,
+       ELSIF,
+       WHILE,
+       DO,
+       REPEAT,
+       UNTIL,
+       FOR,
+       BY,
+       LOOP,
+       EXIT

 };
 
 // =======================================================================
 };
 
 // =======================================================================


@@ -114,6 +131,24 @@ oberon_new_type_real(int size)
        return x;
 }
 
        return x;
 }
 

+static oberon_type_t *
+oberon_new_type_char(int size)
+{
+       oberon_type_t * x;
+       x = oberon_new_type_ptr(OBERON_TYPE_CHAR);
+       x -> size = size;
+       return x;
+}
+
+static oberon_type_t *
+oberon_new_type_string(int size)
+{
+       oberon_type_t * x;
+       x = oberon_new_type_ptr(OBERON_TYPE_STRING);
+       x -> size = size;
+       return x;
+}
+

 // =======================================================================
 //   TABLE
 // ======================================================================= 
 // =======================================================================
 //   TABLE
 // ======================================================================= 


@@ -133,6 +168,7 @@ oberon_open_scope(oberon_context_t * ctx)
                scope -> local = scope -> up -> local;
                scope -> parent = scope -> up -> parent;
                scope -> parent_type = scope -> up -> parent_type;
                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 -> decl = scope;


@@ -177,6 +213,22 @@ oberon_find_object(oberon_scope_t * scope, char * name, bool check_it)
        return result;
 }
 
        return result;
 }
 

+static oberon_object_t *
+oberon_create_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only)
+{
+       oberon_object_t * newvar = malloc(sizeof *newvar);
+       memset(newvar, 0, sizeof *newvar);
+       newvar -> name = name;
+       newvar -> class = class;
+       newvar -> export = export;
+       newvar -> read_only = read_only;
+       newvar -> local = scope -> local;
+       newvar -> parent = scope -> parent;
+       newvar -> parent_type = scope -> parent_type;
+       newvar -> module = scope -> ctx -> mod;
+       return newvar;
+}
+

 static oberon_object_t *
 oberon_define_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only, bool check_upscope)
 {
 static oberon_object_t *
 oberon_define_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only, bool check_upscope)
 {


@@ -199,17 +251,8 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class, bool export
                oberon_error(scope -> ctx, "already defined");
        }
 
                oberon_error(scope -> ctx, "already defined");
        }
 

-       oberon_object_t * newvar = malloc(sizeof *newvar);
-       memset(newvar, 0, sizeof *newvar);
-       newvar -> name = name;
-       newvar -> class = class;
-       newvar -> export = export;
-       newvar -> read_only = read_only;
-       newvar -> local = scope -> local;
-       newvar -> parent = scope -> parent;
-       newvar -> parent_type = scope -> parent_type;
-       newvar -> module = scope -> ctx -> mod;
-
+       oberon_object_t * newvar;
+       newvar = oberon_create_object(scope, name, class, export, read_only);

        x -> next = newvar;
 
        return newvar;
        x -> next = newvar;
 
        return newvar;


@@ -350,6 +393,62 @@ oberon_read_ident(oberon_context_t * ctx)
        {
                ctx -> token = IMPORT;
        }
        {
                ctx -> token = IMPORT;
        }

+       else if(strcmp(ident, "IN") == 0)
+       {
+               ctx -> token = IN;
+       }
+       else if(strcmp(ident, "IS") == 0)
+       {
+               ctx -> token = IS;
+       }
+       else if(strcmp(ident, "IF") == 0)
+       {
+               ctx -> token = IF;
+       }
+       else if(strcmp(ident, "THEN") == 0)
+       {
+               ctx -> token = THEN;
+       }
+       else if(strcmp(ident, "ELSE") == 0)
+       {
+               ctx -> token = ELSE;
+       }
+       else if(strcmp(ident, "ELSIF") == 0)
+       {
+               ctx -> token = ELSIF;
+       }
+       else if(strcmp(ident, "WHILE") == 0)
+       {
+               ctx -> token = WHILE;
+       }
+       else if(strcmp(ident, "DO") == 0)
+       {
+               ctx -> token = DO;
+       }
+       else if(strcmp(ident, "REPEAT") == 0)
+       {
+               ctx -> token = REPEAT;
+       }
+       else if(strcmp(ident, "UNTIL") == 0)
+       {
+               ctx -> token = UNTIL;
+       }
+       else if(strcmp(ident, "FOR") == 0)
+       {
+               ctx -> token = FOR;
+       }
+       else if(strcmp(ident, "BY") == 0)
+       {
+               ctx -> token = BY;
+       }
+       else if(strcmp(ident, "LOOP") == 0)
+       {
+               ctx -> token = LOOP;
+       }
+       else if(strcmp(ident, "EXIT") == 0)
+       {
+               ctx -> token = EXIT;
+       }

 }
 
 static void
 }
 
 static void


@@ -367,6 +466,7 @@ oberon_read_number(oberon_context_t * ctx)
         * mode = 1 == HEX
         * mode = 2 == REAL
         * mode = 3 == LONGREAL
         * mode = 1 == HEX
         * mode = 2 == REAL
         * mode = 3 == LONGREAL

+        * mode = 4 == CHAR

         */
        int mode = 0;
        start_i = ctx -> code_index;
         */
        int mode = 0;
        start_i = ctx -> code_index;


@@ -388,11 +488,20 @@ oberon_read_number(oberon_context_t * ctx)
 
                end_i = ctx -> code_index;
 
 
                end_i = ctx -> code_index;
 

-               if(ctx -> c != 'H')
+               if(ctx -> c == 'H')
+               {
+                       mode = 1;
+                       oberon_get_char(ctx);
+               }
+               else if(ctx -> c == 'X')
+               {
+                       mode = 4;
+                       oberon_get_char(ctx);
+               }
+               else

                {
                        oberon_error(ctx, "invalid hex number");
                }
                {
                        oberon_error(ctx, "invalid hex number");
                }

-               oberon_get_char(ctx);

        }
        else if(ctx -> c == '.')
        {
        }
        else if(ctx -> c == '.')
        {


@@ -430,6 +539,20 @@ oberon_read_number(oberon_context_t * ctx)
                end_i = ctx -> code_index;
        }
 
                end_i = ctx -> code_index;
        }
 

+       if(mode == 0)
+       {
+               if(ctx -> c == 'H')
+               {
+                       mode = 1;
+                       oberon_get_char(ctx);
+               }
+               else if(ctx -> c == 'X')
+               {
+                       mode = 4;
+                       oberon_get_char(ctx);
+               }
+       }
+

        int len = end_i - start_i;
        ident = malloc(len + 1);
        memcpy(ident, &ctx -> code[start_i], len);
        int len = end_i - start_i;
        ident = malloc(len + 1);
        memcpy(ident, &ctx -> code[start_i], len);


@@ -460,6 +583,11 @@ oberon_read_number(oberon_context_t * ctx)
                        sscanf(ident, "%lf", &real);
                        ctx -> token = REAL;
                        break;
                        sscanf(ident, "%lf", &real);
                        ctx -> token = REAL;
                        break;

+               case 4:
+                       sscanf(ident, "%lx", &integer);
+                       real = integer;
+                       ctx -> token = CHAR;
+                       break;

                default:
                        oberon_error(ctx, "oberon_read_number: wat");
                        break;
                default:
                        oberon_error(ctx, "oberon_read_number: wat");
                        break;


@@ -514,6 +642,36 @@ oberon_read_comment(oberon_context_t * ctx)
        }
 }
 
        }
 }
 

+static void oberon_read_string(oberon_context_t * ctx)
+{
+       int c = ctx -> c;
+       oberon_get_char(ctx);
+
+       int start = ctx -> code_index;
+
+       while(ctx -> c != 0 && ctx -> c != c)
+       {
+               oberon_get_char(ctx);
+       }
+
+       if(ctx -> c == 0)
+       {
+               oberon_error(ctx, "unterminated string");
+       }
+
+       int end = ctx -> code_index;
+
+       oberon_get_char(ctx);
+
+       char * string = calloc(1, end - start + 1);
+       strncpy(string, &ctx -> code[start], end - start);
+
+       ctx -> token = STRING;
+       ctx -> string = string;
+
+       printf("oberon_read_string: string ((%s))\n", string);
+}
+

 static void oberon_read_token(oberon_context_t * ctx);
 
 static void
 static void oberon_read_token(oberon_context_t * ctx);
 
 static void


@@ -627,6 +785,12 @@ oberon_read_symbol(oberon_context_t * ctx)
                        ctx -> token = UPARROW;
                        oberon_get_char(ctx);
                        break;
                        ctx -> token = UPARROW;
                        oberon_get_char(ctx);
                        break;

+               case '"':
+                       oberon_read_string(ctx);
+                       break;
+               case '\'':
+                       oberon_read_string(ctx);
+                       break;                  

                default:
                        oberon_error(ctx, "invalid char %c", ctx -> c);
                        break;
                default:
                        oberon_error(ctx, "invalid char %c", ctx -> c);
                        break;


@@ -663,6 +827,7 @@ static void oberon_assert_token(oberon_context_t * ctx, int token);
 static char * oberon_assert_ident(oberon_context_t * ctx);
 static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type);
 static oberon_item_t * oberon_const_expr(oberon_context_t * ctx);
 static char * oberon_assert_ident(oberon_context_t * ctx);
 static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type);
 static oberon_item_t * oberon_const_expr(oberon_context_t * ctx);

+static oberon_expr_t * oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr);

 
 static oberon_expr_t *
 oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right)
 
 static oberon_expr_t *
 oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right)


@@ -736,7 +901,14 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first,
        oberon_expr_t * last;
 
        *num_expr = 1;
        oberon_expr_t * last;
 
        *num_expr = 1;

-       *first = last = oberon_expr(ctx);
+       if(const_expr)
+       {
+               *first = last = (oberon_expr_t *) oberon_const_expr(ctx);
+       }
+       else
+       {
+               *first = last = oberon_expr(ctx);
+       }

        while(ctx -> token == COMMA)
        {
                oberon_assert_token(ctx, COMMA);
        while(ctx -> token == COMMA)
        {
                oberon_assert_token(ctx, COMMA);


@@ -760,11 +932,30 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first,
 static oberon_expr_t *
 oberon_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
 {
 static oberon_expr_t *
 oberon_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
 {

-       oberon_expr_t * cast;
-       cast = oberon_new_item(MODE_CAST, pref, expr -> read_only);
-       cast -> item.parent = expr;
-       cast -> next = expr -> next;
-       return cast;
+       return oberon_new_operator(OP_CAST, pref, expr, NULL);
+}
+
+static oberon_expr_t *
+oberno_make_record_cast(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * rec)
+{
+       oberon_type_t * from = expr -> result;
+       oberon_type_t * to = rec;
+
+       printf("oberno_make_record_cast: from class %i to class %i\n", from -> class, to -> class);
+
+       if(from -> class == OBERON_TYPE_POINTER && to -> class == OBERON_TYPE_POINTER)
+       {
+               printf("oberno_make_record_cast: pointers\n");
+               from = from -> base;
+               to = to -> base;
+       }
+
+       if(from -> class != OBERON_TYPE_RECORD || to -> class != OBERON_TYPE_RECORD)
+       {
+               oberon_error(ctx, "must be record type");
+       }
+
+       return oberon_cast_expr(ctx, expr, rec);

 }
 
 static oberon_type_t *
 }
 
 static oberon_type_t *


@@ -795,39 +986,116 @@ oberon_get_equal_expr_type(oberon_context_t * ctx, oberon_type_t * a, oberon_typ
        return result;
 }
 
        return result;
 }
 

+static void
+oberon_check_record_compatibility(oberon_context_t * ctx, oberon_type_t * from, oberon_type_t * to)
+{
+       if(from -> class == OBERON_TYPE_POINTER && to -> class == OBERON_TYPE_POINTER)
+       {
+               from = from -> base;
+               to = to -> base;
+       }
+
+       if(from -> class != OBERON_TYPE_RECORD || to -> class != OBERON_TYPE_RECORD)
+       {
+               oberon_error(ctx, "not a record");
+       }
+
+       oberon_type_t * t = from;
+       while(t != NULL && t != to)
+       {
+               t = t -> base;
+       }
+
+       if(t == NULL)
+       {
+               oberon_error(ctx, "incompatible record types");
+       }
+}
+
+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)
 {
 static oberon_expr_t *
 oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
 {

+       // Допускается:
+       //  Если классы типов равны
+       //  Если INTEGER переводится в REAL
+       //  Есди STRING переводится в ARRAY OF CHAR
+
+       oberon_check_src(ctx, expr);
+
+       bool error = false;

        if(pref -> class != expr -> result -> class)
        {
        if(pref -> class != expr -> result -> class)
        {

-               if(pref -> class == OBERON_TYPE_POINTER)
+               printf("expr class %i\n", expr -> result -> class);
+               printf("pref class %i\n", pref -> class);
+
+               if(expr -> result -> class == OBERON_TYPE_STRING)

                {
                {

-                       if(expr -> result -> class == OBERON_TYPE_POINTER)
+                       if(pref -> class == OBERON_TYPE_ARRAY)

                        {
                        {

-                               // accept
+                               if(pref -> base -> class != OBERON_TYPE_CHAR)
+                               {
+                                       error = true;
+                               }

                        }
                        else
                        {
                        }
                        else
                        {

-                               oberon_error(ctx, "incompatible types");
+                               error = true;

                        }
                }
                        }
                }

-               else if(pref -> class == OBERON_TYPE_REAL)
+               else if(expr -> result -> class == OBERON_TYPE_INTEGER)

                {
                {

-                       if(expr -> result -> class == OBERON_TYPE_INTEGER)
-                       {
-                               // accept
-                       }
-                       else
+                       if(pref -> class != OBERON_TYPE_REAL)

                        {
                        {

-                               oberon_error(ctx, "incompatible types");
+                               error = true;

                        }
                }
                else
                {
                        }
                }
                else
                {

-                       oberon_error(ctx, "incompatible types");
+                       error = true;

                }
        }
 
                }
        }
 

+       if(error)
+       {
+               oberon_error(ctx, "oberon_autocast_to: incompatible types");
+       }
+

        if(pref -> class == OBERON_TYPE_INTEGER || pref -> class == OBERON_TYPE_REAL)
        {
                if(expr -> result -> size > pref -> size)
        if(pref -> class == OBERON_TYPE_INTEGER || pref -> class == OBERON_TYPE_REAL)
        {
                if(expr -> result -> size > pref -> size)


@@ -841,15 +1109,18 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
        }
        else if(pref -> class == OBERON_TYPE_RECORD)
        {
        }
        else if(pref -> class == OBERON_TYPE_RECORD)
        {

-               if(expr -> result != pref)
-               {
-                       printf("oberon_autocast_to: rec %p != %p\n", expr -> result, pref);
-                       oberon_error(ctx, "incompatible record types");
-               }
+               oberon_check_record_compatibility(ctx, expr -> result, pref);
+               expr = oberno_make_record_cast(ctx, expr, pref);

        }
        else if(pref -> class == OBERON_TYPE_POINTER)
        {
        }
        else if(pref -> class == OBERON_TYPE_POINTER)
        {

-               if(expr -> result -> base != pref -> base)
+               assert(pref -> base);
+               if(expr -> result -> base -> class == OBERON_TYPE_RECORD)
+               {
+                       oberon_check_record_compatibility(ctx, expr -> result, pref);
+                       expr = oberno_make_record_cast(ctx, expr, pref);
+               }
+               else if(expr -> result -> base != pref -> base)

                {
                        if(expr -> result -> base -> class != OBERON_TYPE_VOID)
                        {
                {
                        if(expr -> result -> base -> class != OBERON_TYPE_VOID)
                        {


@@ -872,25 +1143,15 @@ oberon_autocast_binary_op(oberon_context_t * ctx, oberon_expr_t ** ea, oberon_ex
 }
 
 static void
 }
 
 static void

-oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
+oberon_autocast_call(oberon_context_t * ctx, oberon_item_t * desig)

 {
 {

-       if(desig -> is_item == 0)
-       {
-               oberon_error(ctx, "expected item");
-       }
-
-       if(desig -> item.mode != MODE_CALL)
+       if(desig -> mode != MODE_CALL)

        {
                oberon_error(ctx, "expected mode CALL");
        }
 
        {
                oberon_error(ctx, "expected mode CALL");
        }
 

-       if(desig -> item.var -> type -> class != OBERON_TYPE_PROCEDURE)
-       {
-               oberon_error(ctx, "only procedures can be called");
-       }
-
-       oberon_type_t * fn = desig -> item.var -> type;
-       int num_args = desig -> item.num_args;
+       oberon_type_t * fn = desig -> parent -> result;
+       int num_args = desig -> num_args;

        int num_decl = fn -> num_decl;
 
        if(num_args < num_decl)
        int num_decl = fn -> num_decl;
 
        if(num_args < num_decl)


@@ -904,7 +1165,7 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
 
        /* Делаем проверку на запись и делаем автокаст */
        oberon_expr_t * casted[num_args];
 
        /* Делаем проверку на запись и делаем автокаст */
        oberon_expr_t * casted[num_args];

-       oberon_expr_t * arg = desig -> item.args;
+       oberon_expr_t * arg = desig -> args;

        oberon_object_t * param = fn -> decl;
        for(int i = 0; i < num_args; i++)
        {
        oberon_object_t * param = fn -> decl;
        for(int i = 0; i < num_args; i++)
        {


@@ -929,108 +1190,79 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
                {
                        casted[i] -> next = casted[i + 1];
                }
                {
                        casted[i] -> next = casted[i + 1];
                }

-               desig -> item.args = arg;
+               desig -> args = arg;

        }
 }
 
 static oberon_expr_t *
        }
 }
 
 static oberon_expr_t *

-oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
+oberon_make_call_func(oberon_context_t * ctx, oberon_item_t * item, int num_args, oberon_expr_t * list_args)

 {
 {

-       switch(proc -> class)
+       oberon_type_t * signature = item -> result;
+       if(signature -> class != OBERON_TYPE_PROCEDURE)

        {
        {

-               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;
+               oberon_error(ctx, "not a procedure");

        }
 
        oberon_expr_t * call;
 
        }
 
        oberon_expr_t * call;
 

-       if(proc -> sysproc)
+       if(signature -> sysproc)

        {
        {

-               if(proc -> genfunc == NULL)
+               if(signature -> genfunc == NULL)

                {
                        oberon_error(ctx, "not a function-procedure");
                }
 
                {
                        oberon_error(ctx, "not a function-procedure");
                }
 

-               call = proc -> genfunc(ctx, num_args, list_args);
+               call = signature -> genfunc(ctx, num_args, list_args);

        }
        else
        {
        }
        else
        {

-               if(proc -> type -> base -> class == OBERON_TYPE_VOID)
+               if(signature -> base -> class == OBERON_TYPE_VOID)

                {
                        oberon_error(ctx, "attempt to call procedure in expression");
                }
 
                {
                        oberon_error(ctx, "attempt to call procedure in expression");
                }
 

-               call = oberon_new_item(MODE_CALL, proc -> type -> base, 1);
-               call -> item.var = proc;
+               call = oberon_new_item(MODE_CALL, signature -> base, true);
+               call -> item.parent = item;

                call -> item.num_args = num_args;
                call -> item.args = list_args;
                call -> item.num_args = num_args;
                call -> item.args = list_args;

-               oberon_autocast_call(ctx, call);
+               oberon_autocast_call(ctx, (oberon_item_t *) call);

        }
 
        return call;
 }
 
 static void
        }
 
        return call;
 }
 
 static void

-oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
+oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args, oberon_expr_t * list_args)

 {
 {

-       switch(proc -> class)
+       oberon_type_t * signature = item -> result;
+       if(signature -> class != OBERON_TYPE_PROCEDURE)

        {
        {

-               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;
+               oberon_error(ctx, "not a procedure");

        }
 
        }
 

-       if(proc -> sysproc)
+       oberon_expr_t * call;
+
+       if(signature -> sysproc)

        {
        {

-               if(proc -> genproc == NULL)
+               if(signature -> genproc == NULL)

                {
                {

-                       oberon_error(ctx, "requres non-typed procedure");
+                       oberon_error(ctx, "not a procedure");

                }
 
                }
 

-               proc -> genproc(ctx, num_args, list_args);
+               signature -> genproc(ctx, num_args, list_args);

        }
        else
        {
        }
        else
        {

-               if(proc -> type -> base -> class != OBERON_TYPE_VOID)
+               if(signature -> base -> class != OBERON_TYPE_VOID)

                {
                        oberon_error(ctx, "attempt to call function as non-typed procedure");
                }
 
                {
                        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 = oberon_new_item(MODE_CALL, signature -> base, true);
+               call -> item.parent = item;

                call -> item.num_args = num_args;
                call -> item.args = list_args;
                call -> item.num_args = num_args;
                call -> item.args = list_args;

-               oberon_autocast_call(ctx, call);
+               oberon_autocast_call(ctx, (oberon_item_t *) call);

                oberon_generate_call_proc(ctx, call);
        }
 }
                oberon_generate_call_proc(ctx, call);
        }
 }


@@ -1040,14 +1272,19 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_ar
        || ((x) == MINUS) \
        || ((x) == IDENT) \
        || ((x) == INTEGER) \
        || ((x) == MINUS) \
        || ((x) == IDENT) \
        || ((x) == INTEGER) \

+       || ((x) == REAL) \
+       || ((x) == CHAR) \
+       || ((x) == STRING) \
+       || ((x) == NIL) \

        || ((x) == LPAREN) \
        || ((x) == NOT) \
        || ((x) == TRUE) \
        || ((x) == LPAREN) \
        || ((x) == NOT) \
        || ((x) == TRUE) \

-       || ((x) == FALSE))
+       || ((x) == FALSE)) 

 
 static oberon_expr_t *
 oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
 {
 
 static oberon_expr_t *
 oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
 {

+       printf("oberno_make_dereferencing\n");

        if(expr -> result -> class != OBERON_TYPE_POINTER)
        {
                oberon_error(ctx, "not a pointer");
        if(expr -> result -> class != OBERON_TYPE_POINTER)
        {
                oberon_error(ctx, "not a pointer");


@@ -1057,7 +1294,7 @@ oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
 
        oberon_expr_t * selector;
        selector = oberon_new_item(MODE_DEREF, expr -> result -> base, expr -> read_only);
 
        oberon_expr_t * selector;
        selector = oberon_new_item(MODE_DEREF, expr -> result -> base, expr -> read_only);

-       selector -> item.parent = expr;
+       selector -> item.parent = (oberon_item_t *) expr;

 
        return selector;
 }
 
        return selector;
 }


@@ -1104,7 +1341,7 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon
 
        oberon_expr_t * selector;
        selector = oberon_new_item(MODE_INDEX, base, desig -> read_only);
 
        oberon_expr_t * selector;
        selector = oberon_new_item(MODE_INDEX, base, desig -> read_only);

-       selector -> item.parent = desig;
+       selector -> item.parent = (oberon_item_t *) desig;

        selector -> item.num_args = 1;
        selector -> item.args = index;
 
        selector -> item.num_args = 1;
        selector -> item.args = index;
 


@@ -1119,7 +1356,7 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
                expr = oberno_make_dereferencing(ctx, expr);
        }
 
                expr = oberno_make_dereferencing(ctx, expr);
        }
 

-       assert(expr -> is_item == 1);
+       assert(expr -> is_item);

 
        if(expr -> result -> class != OBERON_TYPE_RECORD)
        {
 
        if(expr -> result -> class != OBERON_TYPE_RECORD)
        {


@@ -1151,7 +1388,7 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
        oberon_expr_t * selector;
        selector = oberon_new_item(MODE_FIELD, field -> type, read_only);
        selector -> item.var = field;
        oberon_expr_t * selector;
        selector = oberon_new_item(MODE_FIELD, field -> type, read_only);
        selector -> item.var = field;

-       selector -> item.parent = expr;
+       selector -> item.parent = (oberon_item_t *) expr;

 
        return selector;
 }
 
        return selector;
 }


@@ -1159,7 +1396,8 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
 #define ISSELECTOR(x) \
        (((x) == LBRACE) \
        || ((x) == DOT) \
 #define ISSELECTOR(x) \
        (((x) == LBRACE) \
        || ((x) == DOT) \

-       || ((x) == UPARROW))
+       || ((x) == UPARROW) \
+       || ((x) == LPAREN))

 
 static oberon_object_t *
 oberon_qualident(oberon_context_t * ctx, char ** xname, int check)
 
 static oberon_object_t *
 oberon_qualident(oberon_context_t * ctx, char ** xname, int check)


@@ -1194,6 +1432,26 @@ oberon_qualident(oberon_context_t * ctx, char ** xname, int check)
        return x;
 }
 
        return x;
 }
 

+static oberon_expr_t *
+oberon_ident_item(oberon_context_t * ctx, char * name)
+{
+       bool read_only;
+       oberon_object_t * x;
+       oberon_expr_t * expr;
+
+       x = oberon_find_object(ctx -> decl, name, true);
+
+       read_only = false;
+       if(x -> class == OBERON_CLASS_CONST || x -> class == OBERON_CLASS_PROC)
+       {
+               read_only = true;
+       }
+
+       expr = oberon_new_item(MODE_VAR, x -> type, read_only);
+       expr -> item.var = x;
+       return expr;
+}
+

 static oberon_expr_t *
 oberon_designator(oberon_context_t * ctx)
 {
 static oberon_expr_t *
 oberon_designator(oberon_context_t * ctx)
 {


@@ -1218,13 +1476,16 @@ oberon_designator(oberon_context_t * ctx)
                        // TODO copy value
                        expr = (oberon_expr_t *) var -> value;
                        break;
                        // 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:
                        expr = oberon_new_item(MODE_VAR, var -> type, read_only);
                        break;
                case OBERON_CLASS_PROC:
                case OBERON_CLASS_VAR:
                case OBERON_CLASS_VAR_PARAM:
                case OBERON_CLASS_PARAM:
                        expr = oberon_new_item(MODE_VAR, var -> type, read_only);
                        break;
                case OBERON_CLASS_PROC:

-                       expr = oberon_new_item(MODE_VAR, var -> type, 1);
+                       expr = oberon_new_item(MODE_VAR, var -> type, true);

                        break;
                default:
                        oberon_error(ctx, "invalid designator");
                        break;
                default:
                        oberon_error(ctx, "invalid designator");


@@ -1232,7 +1493,7 @@ oberon_designator(oberon_context_t * ctx)
        }
        expr -> item.var = var;
 
        }
        expr -> item.var = var;
 

-       while(ISSELECTOR(ctx -> token))
+       while(expr -> result -> class != OBERON_TYPE_PROCEDURE && ISSELECTOR(ctx -> token))

        {
                switch(ctx -> token)
                {
        {
                switch(ctx -> token)
                {


@@ -1258,19 +1519,28 @@ oberon_designator(oberon_context_t * ctx)
                                oberon_assert_token(ctx, UPARROW);
                                expr = oberno_make_dereferencing(ctx, expr);
                                break;
                                oberon_assert_token(ctx, UPARROW);
                                expr = oberno_make_dereferencing(ctx, expr);
                                break;

+                       case LPAREN:
+                               oberon_assert_token(ctx, LPAREN);
+                               oberon_object_t * objtype = oberon_qualident(ctx, NULL, 1);
+                               if(objtype -> class != OBERON_CLASS_TYPE)
+                               {
+                                       oberon_error(ctx, "must be type");
+                               }
+                               oberon_assert_token(ctx, RPAREN);
+                               expr = oberno_make_record_cast(ctx, expr, objtype -> type);
+                               break;

                        default:
                                oberon_error(ctx, "oberon_designator: wat");
                                break;
                }
        }
                        default:
                                oberon_error(ctx, "oberon_designator: wat");
                                break;
                }
        }

+

        return expr;
 }
 
 static oberon_expr_t *
 oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 {
        return expr;
 }
 
 static oberon_expr_t *
 oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 {

-       assert(expr -> is_item == 1);
-

        /* Если есть скобки - значит вызов. Если нет, то передаём указатель. */
        if(ctx -> token == LPAREN)
        {
        /* Если есть скобки - значит вызов. Если нет, то передаём указатель. */
        if(ctx -> token == LPAREN)
        {


@@ -1284,7 +1554,8 @@ oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr)
                        oberon_expr_list(ctx, &num_args, &arguments, 0);
                }
 
                        oberon_expr_list(ctx, &num_args, &arguments, 0);
                }
 

-               expr = oberon_make_call_func(ctx, expr -> item.var, num_args, arguments);
+               assert(expr -> is_item == 1);
+               expr = oberon_make_call_func(ctx, (oberon_item_t *) expr, num_args, arguments);

 
                oberon_assert_token(ctx, RPAREN);
        }
 
                oberon_assert_token(ctx, RPAREN);
        }


@@ -1295,7 +1566,7 @@ oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 static void
 oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 {
 static void
 oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 {

-       assert(expr -> is_item == 1);
+       assert(expr -> is_item);

 
        int num_args = 0;
        oberon_expr_t * arguments = NULL;
 
        int num_args = 0;
        oberon_expr_t * arguments = NULL;


@@ -1313,7 +1584,7 @@ oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
        }
 
        /* Вызов происходит даже без скобок */
        }
 
        /* Вызов происходит даже без скобок */

-       oberon_make_call_proc(ctx, expr -> item.var, num_args, arguments);
+       oberon_make_call_proc(ctx, (oberon_item_t *) expr, num_args, arguments);

 }
 
 static oberon_type_t *
 }
 
 static oberon_type_t *


@@ -1337,6 +1608,17 @@ oberon_get_type_of_int_value(oberon_context_t * ctx, int64_t i)
        }
 }
 
        }
 }
 

+static oberon_expr_t *
+oberon_integer_item(oberon_context_t * ctx, int64_t i)
+{
+       oberon_expr_t * expr;
+       oberon_type_t * result;
+       result = oberon_get_type_of_int_value(ctx, i);
+       expr = oberon_new_item(MODE_INTEGER, result, true);
+       expr -> item.integer = i;
+       return expr;
+}
+

 static oberon_expr_t *
 oberon_factor(oberon_context_t * ctx)
 {
 static oberon_expr_t *
 oberon_factor(oberon_context_t * ctx)
 {


@@ -1350,11 +1632,21 @@ oberon_factor(oberon_context_t * ctx)
                        expr = oberon_opt_func_parens(ctx, expr);
                        break;
                case INTEGER:
                        expr = oberon_opt_func_parens(ctx, expr);
                        break;
                case INTEGER:

-                       result = oberon_get_type_of_int_value(ctx, ctx -> integer);
-                       expr = oberon_new_item(MODE_INTEGER, result, 1);
-                       expr -> item.integer = ctx -> integer;
+                       expr = oberon_integer_item(ctx, ctx -> integer);

                        oberon_assert_token(ctx, INTEGER);
                        break;
                        oberon_assert_token(ctx, INTEGER);
                        break;

+               case CHAR:
+                       result = ctx -> char_type;
+                       expr = oberon_new_item(MODE_CHAR, result, true);
+                       expr -> item.integer = ctx -> integer;
+                       oberon_assert_token(ctx, CHAR);
+                       break;
+               case STRING:
+                       result = ctx -> string_type;
+                       expr = oberon_new_item(MODE_STRING, result, true);
+                       expr -> item.string = ctx -> string;
+                       oberon_assert_token(ctx, STRING);
+                       break;

                case REAL:
                        result = (ctx -> longmode) ? (ctx -> longreal_type) : (ctx -> real_type);
                        expr = oberon_new_item(MODE_REAL, result, 1);
                case REAL:
                        result = (ctx -> longmode) ? (ctx -> longreal_type) : (ctx -> real_type);
                        expr = oberon_new_item(MODE_REAL, result, 1);


@@ -1362,12 +1654,12 @@ oberon_factor(oberon_context_t * ctx)
                        oberon_assert_token(ctx, REAL);
                        break;
                case TRUE:
                        oberon_assert_token(ctx, REAL);
                        break;
                case TRUE:

-                       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, 1);
+                       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true);

                        expr -> item.boolean = true;
                        oberon_assert_token(ctx, TRUE);
                        break;
                case FALSE:
                        expr -> item.boolean = true;
                        oberon_assert_token(ctx, TRUE);
                        break;
                case FALSE:

-                       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, 1);
+                       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true);

                        expr -> item.boolean = false;
                        oberon_assert_token(ctx, FALSE);
                        break;
                        expr -> item.boolean = false;
                        oberon_assert_token(ctx, FALSE);
                        break;


@@ -1383,7 +1675,7 @@ oberon_factor(oberon_context_t * ctx)
                        break;
                case NIL:
                        oberon_assert_token(ctx, NIL);
                        break;
                case NIL:
                        oberon_assert_token(ctx, NIL);

-                       expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type, 1);
+                       expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type, true);

                        break;
                default:
                        oberon_error(ctx, "invalid expression");
                        break;
                default:
                        oberon_error(ctx, "invalid expression");


@@ -1436,6 +1728,10 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
                                || b -> result -> class == OBERON_TYPE_INTEGER
                                || a -> result -> class == OBERON_TYPE_REAL
                                || b -> result -> class == OBERON_TYPE_REAL)
                                || b -> result -> class == OBERON_TYPE_INTEGER
                                || a -> result -> class == OBERON_TYPE_REAL
                                || b -> result -> class == OBERON_TYPE_REAL)

+                       {
+                               // accept
+                       }
+                       else

                        {
                                oberon_error(ctx, "used only with numeric types");
                        }
                        {
                                oberon_error(ctx, "used only with numeric types");
                        }


@@ -1597,7 +1893,7 @@ oberon_simple_expr(oberon_context_t * ctx)
 }
 
 #define ISRELATION(x) \
 }
 
 #define ISRELATION(x) \

-       ((x) >= EQUAL && (x) <= GEQ)
+       ((x) >= EQUAL && (x) <= IS)

 
 static oberon_expr_t *
 oberon_expr(oberon_context_t * ctx)
 
 static oberon_expr_t *
 oberon_expr(oberon_context_t * ctx)


@@ -1628,6 +1924,22 @@ oberon_const_expr(oberon_context_t * ctx)
                oberon_error(ctx, "const expression are required");
        }
 
                oberon_error(ctx, "const expression are required");
        }
 

+       switch(expr -> item.mode)
+       {
+               case MODE_INTEGER:
+               case MODE_BOOLEAN:
+               case MODE_NIL:
+               case MODE_REAL:
+               case MODE_CHAR:
+               case MODE_STRING:
+               case MODE_TYPE:
+                       /* accept */
+                       break;
+               default:
+                       oberon_error(ctx, "const expression are required");
+                       break;
+       }
+

        return (oberon_item_t *) expr;
 }
 
        return (oberon_item_t *) expr;
 }
 


@@ -2119,13 +2431,19 @@ oberon_type_record_body(oberon_context_t * ctx, oberon_type_t * rec)
                        oberon_error(ctx, "base must be type");
                }
 
                        oberon_error(ctx, "base must be type");
                }
 

-               if(typeobj -> type -> class != OBERON_TYPE_RECORD)
+               oberon_type_t * base = typeobj -> type;
+               if(base -> class == OBERON_TYPE_POINTER)
+               {
+                       base = base -> base;
+               }
+
+               if(base -> class != OBERON_TYPE_RECORD)

                {
                        oberon_error(ctx, "base must be record type");
                }
 
                {
                        oberon_error(ctx, "base must be record type");
                }
 

-               rec -> base = typeobj -> type;
-               ctx -> decl = rec -> base -> scope;
+               rec -> base = base;
+               ctx -> decl = base -> scope;

 
                oberon_assert_token(ctx, RPAREN);
        }
 
                oberon_assert_token(ctx, RPAREN);
        }


@@ -2634,6 +2952,25 @@ oberon_decl_seq(oberon_context_t * ctx)
        oberon_prevent_undeclarated_procedures(ctx);
 }
 
        oberon_prevent_undeclarated_procedures(ctx);
 }
 

+static oberon_expr_t *
+oberon_make_temp_var_item(oberon_context_t * ctx, oberon_type_t * type)
+{
+       oberon_object_t * x;
+       oberon_expr_t * expr;
+
+       x = oberon_create_object(ctx -> decl, "TEMP", OBERON_CLASS_VAR, false, false);
+       x -> local = true;
+       x -> type = type;
+       oberon_generator_init_temp_var(ctx, x);
+
+       expr = oberon_new_item(MODE_VAR, type, false);
+       expr -> item.var = x;
+       return expr;
+}
+
+static void
+oberon_statement_seq(oberon_context_t * ctx);
+

 static void
 oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 {
 static void
 oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 {


@@ -2642,6 +2979,7 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
                oberon_error(ctx, "read-only destination");
        }
 
                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);
 }
        src = oberon_autocast_to(ctx, src, dst -> result);
        oberon_generate_assign(ctx, src, dst);
 }


@@ -2666,6 +3004,192 @@ oberon_statement(oberon_context_t * ctx)
                        oberon_opt_proc_parens(ctx, item1);
                }
        }
                        oberon_opt_proc_parens(ctx, item1);
                }
        }

+       else if(ctx -> token == IF)
+       {
+               gen_label_t * end;
+               gen_label_t * els;
+               oberon_expr_t * cond;
+
+               els = oberon_generator_reserve_label(ctx);
+               end = oberon_generator_reserve_label(ctx);
+
+               oberon_assert_token(ctx, IF);
+               cond = oberon_expr(ctx);
+               if(cond -> result -> class != OBERON_TYPE_BOOLEAN)
+               {
+                       oberon_error(ctx, "condition must be boolean");
+               }
+               oberon_assert_token(ctx, THEN);
+               oberon_generate_branch(ctx, cond, false, els);
+               oberon_statement_seq(ctx);
+               oberon_generate_goto(ctx, end);
+               oberon_generate_label(ctx, els);
+
+               while(ctx -> token == ELSIF)
+               {
+                       els = oberon_generator_reserve_label(ctx);
+
+                       oberon_assert_token(ctx, ELSIF);
+                       cond = oberon_expr(ctx);
+                       if(cond -> result -> class != OBERON_TYPE_BOOLEAN)
+                       {
+                               oberon_error(ctx, "condition must be boolean");
+                       }
+                       oberon_assert_token(ctx, THEN);
+                       oberon_generate_branch(ctx, cond, false, els);
+                       oberon_statement_seq(ctx);
+                       oberon_generate_goto(ctx, end);
+                       oberon_generate_label(ctx, els);
+               }
+
+               if(ctx -> token == ELSE)
+               {
+                       oberon_assert_token(ctx, ELSE);
+                       oberon_statement_seq(ctx);
+               }
+
+               oberon_generate_label(ctx, end);
+               oberon_assert_token(ctx, END);          
+       }
+       else if(ctx -> token == WHILE)
+       {
+               gen_label_t * begin;
+               gen_label_t * end;
+               oberon_expr_t * cond;
+
+               begin = oberon_generator_reserve_label(ctx);
+               end = oberon_generator_reserve_label(ctx);
+
+               oberon_assert_token(ctx, WHILE);
+               oberon_generate_label(ctx, begin);
+               cond = oberon_expr(ctx);
+               if(cond -> result -> class != OBERON_TYPE_BOOLEAN)
+               {
+                       oberon_error(ctx, "condition must be boolean");
+               }
+               oberon_generate_branch(ctx, cond, false, end);
+
+               oberon_assert_token(ctx, DO);
+               oberon_statement_seq(ctx);
+               oberon_generate_goto(ctx, begin);
+
+               oberon_assert_token(ctx, END);
+               oberon_generate_label(ctx, end);
+       }
+       else if(ctx -> token == REPEAT)
+       {
+               gen_label_t * begin;
+               oberon_expr_t * cond;
+
+               begin = oberon_generator_reserve_label(ctx);
+               oberon_generate_label(ctx, begin);
+               oberon_assert_token(ctx, REPEAT);
+
+               oberon_statement_seq(ctx);
+
+               oberon_assert_token(ctx, UNTIL);
+
+               cond = oberon_expr(ctx);
+               if(cond -> result -> class != OBERON_TYPE_BOOLEAN)
+               {
+                       oberon_error(ctx, "condition must be boolean");
+               }
+
+               oberon_generate_branch(ctx, cond, true, begin);
+       }
+       else if(ctx -> token == FOR)
+       {
+               oberon_expr_t * from;
+               oberon_expr_t * index;
+               oberon_expr_t * to;
+               oberon_expr_t * bound;
+               oberon_expr_t * by;
+               oberon_expr_t * cond;
+               oberon_expr_t * count;
+               gen_label_t * begin;
+               gen_label_t * end;
+               char * iname;
+               int op;
+
+               begin = oberon_generator_reserve_label(ctx);
+               end = oberon_generator_reserve_label(ctx);
+
+               oberon_assert_token(ctx, FOR);
+               iname = oberon_assert_ident(ctx);
+               index = oberon_ident_item(ctx, iname);
+               oberon_assert_token(ctx, ASSIGN);
+               from = oberon_expr(ctx);
+               oberon_assign(ctx, from, index);
+               oberon_assert_token(ctx, TO);
+               bound = oberon_make_temp_var_item(ctx, index -> result);
+               to = oberon_expr(ctx);
+               oberon_assign(ctx, to, bound);
+               if(ctx -> token == BY)
+               {
+                       oberon_assert_token(ctx, BY);
+                       by = (oberon_expr_t *) oberon_const_expr(ctx);
+               }
+               else
+               {
+                       by = oberon_integer_item(ctx, 1);
+               }
+
+               if(by -> result -> class != OBERON_TYPE_INTEGER)
+               {
+                       oberon_error(ctx, "must be integer");
+               }
+
+               if(by -> item.integer > 0)
+               {
+                       op = LEQ;
+               }
+               else if(by -> item.integer < 0)
+               {
+                       op = GEQ;
+               }
+               else
+               {
+                       oberon_error(ctx, "zero step not allowed");
+               }
+
+               oberon_assert_token(ctx, DO);
+               oberon_generate_label(ctx, begin);
+               cond = oberon_make_bin_op(ctx, op, index, bound);
+               oberon_generate_branch(ctx, cond, false, end);
+               oberon_statement_seq(ctx);
+               count = oberon_make_bin_op(ctx, PLUS, index, by);
+               oberon_assign(ctx, count, index);
+               oberon_generate_goto(ctx, begin);
+               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);
        else if(ctx -> token == RETURN)
        {
                oberon_assert_token(ctx, RETURN);


@@ -2811,6 +3335,9 @@ register_default_types(oberon_context_t * ctx)
        ctx -> void_ptr_type -> base = ctx -> void_type;
        oberon_generator_init_type(ctx, ctx -> void_ptr_type);
 
        ctx -> void_ptr_type -> base = ctx -> void_type;
        oberon_generator_init_type(ctx, ctx -> void_ptr_type);
 

+       ctx -> string_type = oberon_new_type_string(1);
+       oberon_generator_init_type(ctx, ctx -> string_type);
+

        ctx -> bool_type = oberon_new_type_boolean();
        oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type, 1);
 
        ctx -> bool_type = oberon_new_type_boolean();
        oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type, 1);
 


@@ -2831,6 +3358,9 @@ register_default_types(oberon_context_t * ctx)
 
        ctx -> longreal_type = oberon_new_type_real(8);
        oberon_define_type(ctx -> world_scope, "LONGREAL", ctx -> longreal_type, 1);
 
        ctx -> longreal_type = oberon_new_type_real(8);
        oberon_define_type(ctx -> world_scope, "LONGREAL", ctx -> longreal_type, 1);

+
+       ctx -> char_type = oberon_new_type_char(1);
+       oberon_define_type(ctx -> world_scope, "CHAR", ctx -> char_type, 1);

 }
 
 static void
 }
 
 static void


@@ -2838,10 +3368,122 @@ oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f
 {
        oberon_object_t * proc;
        proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, true, false, false);
 {
        oberon_object_t * proc;
        proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, true, false, false);

-       proc -> sysproc = 1;
-       proc -> genfunc = f;
-       proc -> genproc = p;

        proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
        proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);

+       proc -> type -> sysproc = true;
+       proc -> type -> genfunc = 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 *
 }
 
 static oberon_expr_t *


@@ -2868,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_error(ctx, "ABS accepts only integers");
        }
 

-

        oberon_expr_t * expr;
        expr = oberon_new_operator(OP_ABS, result_type, arg, NULL);
        return expr;
        oberon_expr_t * expr;
        expr = oberon_new_operator(OP_ABS, result_type, arg, NULL);
        return expr;


@@ -2969,7 +3610,14 @@ oberon_create_context(ModuleImportCallback import_module)
        oberon_generator_init_context(ctx);
 
        register_default_types(ctx);
        oberon_generator_init_context(ctx);
 
        register_default_types(ctx);

+
+       /* Functions */

        oberon_new_intrinsic(ctx, "ABS", oberon_make_abs_call, NULL);
        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;
        oberon_new_intrinsic(ctx, "NEW", NULL, oberon_make_new_call);
 
        return ctx;