Исправлена проверка VAR-параметров-записей

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

diff --git a/src/oberon.c b/src/oberon.c
index 9080fb144eadec7fad4d923d0c328491bb5f7334..4a740d8130db2be573d6c197eadc2ee767244d3c 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -10,8 +10,6 @@
 
 #include <gc.h>
 
 
 #include <gc.h>
 

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

 #include "oberon-internals.h"
 #include "oberon-type-compat.h"
 #include "oberon-common.h"
 #include "oberon-internals.h"
 #include "oberon-type-compat.h"
 #include "oberon-common.h"


@@ -171,6 +169,17 @@ oberon_make_char(oberon_context_t * ctx, int64_t i)
        return expr;
 }
 
        return expr;
 }
 

+static oberon_expr_t *
+oberon_make_string(oberon_context_t * ctx, char * str)
+{
+       oberon_expr_t * expr;
+       expr = oberon_new_item(MODE_STRING, ctx -> string_type, true);
+       expr -> item.integer = str[0];
+       expr -> item.real = str[0];
+       expr -> item.string = str;
+       return expr;
+}
+

 static oberon_expr_t *
 oberon_make_real_typed(oberon_context_t * ctx, double r, oberon_type_t * result)
 {
 static oberon_expr_t *
 oberon_make_real_typed(oberon_context_t * ctx, double r, oberon_type_t * result)
 {


@@ -351,15 +360,20 @@ oberon_get_char(oberon_context_t * ctx)
        if(ctx -> code[ctx -> code_index])
        {
                ctx -> code_index += 1;
        if(ctx -> code[ctx -> code_index])
        {
                ctx -> code_index += 1;

+               ctx -> xloc.col += 1;

                ctx -> c = ctx -> code[ctx -> code_index];
        }
 }
 
 static void
                ctx -> c = ctx -> code[ctx -> code_index];
        }
 }
 
 static void

-oberon_init_scaner(oberon_context_t * ctx, const char * code)
+oberon_init_scaner(oberon_context_t * ctx, oberon_scanner_t * s)

 {
 {

-       ctx -> code = code;
+       ctx -> code = s -> code;

        ctx -> code_index = 0;
        ctx -> code_index = 0;

+       ctx -> xloc.source = s -> source;
+       ctx -> xloc.line = 1;
+       ctx -> xloc.col = 1;
+       ctx -> loc = ctx -> xloc;

        ctx -> c = ctx -> code[ctx -> code_index];
 }
 
        ctx -> c = ctx -> code[ctx -> code_index];
 }
 


@@ -678,12 +692,40 @@ oberon_read_number(oberon_context_t * ctx)
        ctx -> real = real;
 }
 
        ctx -> real = real;
 }
 

+static void
+oberon_get_lined_char(oberon_context_t * ctx)
+{
+       do
+       {
+               if(ctx -> c == 0xD)
+               {
+                       oberon_get_char(ctx);
+                       if(ctx -> c == 0xA)
+                       {
+                               oberon_get_char(ctx);
+                       }
+                       ctx -> xloc.line += 1;
+                       ctx -> xloc.col = 1;
+               }
+               else if(ctx -> c == 0xA)
+               {
+                       oberon_get_char(ctx);
+                       ctx -> xloc.line += 1;
+                       ctx -> xloc.col = 1;
+               }
+               else
+               {
+                       oberon_get_char(ctx);
+               }
+       } while(ctx -> c == 0xD || ctx -> c == 0xA);
+}
+

 static void
 oberon_skip_space(oberon_context_t * ctx)
 {
        while(isspace(ctx -> c))
        {
 static void
 oberon_skip_space(oberon_context_t * ctx)
 {
        while(isspace(ctx -> c))
        {

-               oberon_get_char(ctx);
+               oberon_get_lined_char(ctx);

        }
 }
 
        }
 }
 


@@ -695,19 +737,19 @@ oberon_read_comment(oberon_context_t * ctx)
        {
                if(ctx -> c == '(')
                {
        {
                if(ctx -> c == '(')
                {

-                       oberon_get_char(ctx);
+                       oberon_get_lined_char(ctx);

                        if(ctx -> c == '*')
                        {
                        if(ctx -> c == '*')
                        {

-                               oberon_get_char(ctx);
+                               oberon_get_lined_char(ctx);

                                nesting += 1;
                        }
                }
                else if(ctx -> c == '*')
                {
                                nesting += 1;
                        }
                }
                else if(ctx -> c == '*')
                {

-                       oberon_get_char(ctx);
+                       oberon_get_lined_char(ctx);

                        if(ctx -> c == ')')
                        {
                        if(ctx -> c == ')')
                        {

-                               oberon_get_char(ctx);
+                               oberon_get_lined_char(ctx);

                                nesting -= 1;
                        }
                }
                                nesting -= 1;
                        }
                }


@@ -717,7 +759,7 @@ oberon_read_comment(oberon_context_t * ctx)
                }
                else
                {
                }
                else
                {

-                       oberon_get_char(ctx);
+                       oberon_get_lined_char(ctx);

                }
        }
 }
                }
        }
 }


@@ -899,6 +941,8 @@ oberon_read_token(oberon_context_t * ctx)
 {
        oberon_skip_space(ctx);
 
 {
        oberon_skip_space(ctx);
 

+       ctx -> loc = ctx -> xloc;
+

        int c = ctx -> c;
        if(isalpha(c) || c == '_')
        {
        int c = ctx -> c;
        if(isalpha(c) || c == '_')
        {


@@ -1056,6 +1100,12 @@ oberon_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * p
        return cast;
 }
 
        return cast;
 }
 

+static oberon_expr_t *
+oberon_hard_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
+{
+       return oberon_new_operator(OP_HARDCAST, pref, expr, NULL);
+}
+

 static void
 oberon_check_dst(oberon_context_t * ctx, oberon_expr_t * dst)
 {
 static void
 oberon_check_dst(oberon_context_t * ctx, oberon_expr_t * dst)
 {


@@ -1242,6 +1292,7 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args
        || ((x) == CHAR) \
        || ((x) == STRING) \
        || ((x) == NIL) \
        || ((x) == CHAR) \
        || ((x) == STRING) \
        || ((x) == NIL) \

+       || ((x) == LBRACE) \

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


@@ -1660,9 +1711,7 @@ oberon_factor(oberon_context_t * ctx)
                        oberon_assert_token(ctx, CHAR);
                        break;
                case STRING:
                        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;
+                       expr = oberon_make_string(ctx, ctx -> string);

                        oberon_assert_token(ctx, STRING);
                        break;
                case REAL:
                        oberon_assert_token(ctx, STRING);
                        break;
                case REAL:


@@ -1699,7 +1748,7 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
        oberon_expr_t * expr;
        oberon_type_t * result;
 
        oberon_expr_t * expr;
        oberon_type_t * result;
 

-       oberon_check_compatible_bin_expr_types(ctx, token, a -> result, b -> result);
+       oberon_check_compatible_bin_expr(ctx, token, a, b);

        oberon_check_src(ctx, a);
        if(token != IS)
        {
        oberon_check_src(ctx, a);
        if(token != IS)
        {


@@ -1724,7 +1773,22 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
        }
        else if((token >= EQUAL && token <= GEQ) || token == OR || token == AND)
        {
        }
        else if((token >= EQUAL && token <= GEQ) || token == OR || token == AND)
        {

-               result = oberon_get_longer_type(ctx, a -> result, b -> result);
+               if(oberon_is_string_of_one(a) && oberon_is_char_type(b -> result))
+               {
+                       result = b -> result;
+               }
+               else if(oberon_is_string_of_one(b) && oberon_is_char_type(a -> result))
+               {
+                       result = a -> result;
+               }
+               else if(oberon_is_string_of_one(a) && oberon_is_string_of_one(b))
+               {
+                       result = ctx -> char_type;
+               }
+               else
+               {
+                       result = oberon_get_longer_type(ctx, a -> result, b -> result);
+               }

 
                if(oberon_is_const(a) && oberon_is_const(b)
                        && (oberon_is_real_type(result) || oberon_is_integer_type(result)))
 
                if(oberon_is_const(a) && oberon_is_const(b)
                        && (oberon_is_real_type(result) || oberon_is_integer_type(result)))


@@ -1895,7 +1959,7 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
                                                break;
                                }
                        }
                                                break;
                                }
                        }

-                       else if(oberon_is_number_type(result))
+                       else if(oberon_is_real_type(result))

                        {
                                switch(token)
                                {
                        {
                                switch(token)
                                {


@@ -1909,6 +1973,32 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
                                                expr = oberon_new_operator(OP_MUL, result, a, b);
                                                break;
                                        default:
                                                expr = oberon_new_operator(OP_MUL, result, a, b);
                                                break;
                                        default:

+                                               printf("token %i line %i\n", token, ctx -> loc.line);
+                                               assert(0);
+                                               break;
+                               }
+                       }
+                       else if(oberon_is_integer_type(result))
+                       {
+                               switch(token)
+                               {
+                                       case PLUS:
+                                               expr = oberon_new_operator(OP_ADD, result, a, b);
+                                               break;
+                                       case MINUS:
+                                               expr = oberon_new_operator(OP_SUB, result, a, b);
+                                               break;
+                                       case STAR:
+                                               expr = oberon_new_operator(OP_MUL, result, a, b);
+                                               break;
+                                       case DIV:
+                                               expr = oberon_new_operator(OP_DIV, result, a, b);
+                                               break;
+                                       case MOD:
+                                               expr = oberon_new_operator(OP_DIV, result, a, b);
+                                               break;
+                                       default:
+                                               printf("token %i line %i\n", token, ctx -> loc.line);

                                                assert(0);
                                                break;
                                }
                                                assert(0);
                                                break;
                                }


@@ -2322,8 +2412,7 @@ oberon_proc_decl_body(oberon_context_t * ctx, oberon_object_t * proc)
                oberon_error(ctx, "procedure name not matched");
        }
 
                oberon_error(ctx, "procedure name not matched");
        }
 

-       if(proc -> type -> base -> class == OBERON_TYPE_NOTYPE
-               && proc -> has_return == 0)
+       if(proc -> type -> base -> class == OBERON_TYPE_NOTYPE)

        {
                oberon_make_return(ctx, NULL);
        }
        {
                oberon_make_return(ctx, NULL);
        }


@@ -2728,7 +2817,14 @@ oberon_prevent_recursive_pointer(oberon_context_t * ctx, oberon_type_t * type)
 
        if(type -> recursive)
        {
 
        if(type -> recursive)
        {

-               oberon_error(ctx, "recursive pointer declaration");
+               if(type -> class == OBERON_TYPE_POINTER)
+               {
+                       oberon_error(ctx, "recursive pointer declaration");
+               }
+               else
+               {
+                       oberon_error(ctx, "recursive array declaration (pointer)");
+               }

        }
 
        if(type -> class == OBERON_TYPE_POINTER
        }
 
        if(type -> class == OBERON_TYPE_POINTER


@@ -2881,20 +2977,12 @@ static void oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
 static void
 oberon_initialize_record_fields(oberon_context_t * ctx, oberon_type_t * type)
 {
 static void
 oberon_initialize_record_fields(oberon_context_t * ctx, oberon_type_t * type)
 {

-       if(type -> class != OBERON_TYPE_RECORD)
-       {
-               return;
-       }
+       assert(type -> class == OBERON_TYPE_RECORD);

 
        int num_fields = type -> num_decl;
        oberon_object_t * field = type -> decl;
        for(int i = 0; i < num_fields; i++)
        {
 
        int num_fields = type -> num_decl;
        oberon_object_t * field = type -> decl;
        for(int i = 0; i < num_fields; i++)
        {

-               if(field -> type -> class == OBERON_TYPE_POINTER)
-               {
-                       oberon_initialize_type(ctx, field -> type);
-               }
-

                oberon_initialize_object(ctx, field);
                field = field -> next;
        }
                oberon_initialize_object(ctx, field);
                field = field -> next;
        }


@@ -2917,39 +3005,50 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
 
        type -> initialized = 1;
 
 
        type -> initialized = 1;
 

-       if(type -> class == OBERON_TYPE_POINTER)
-       {
-               oberon_initialize_type(ctx, type -> base);
-               oberon_generator_init_type(ctx, type);
-       }
-       else if(type -> class == OBERON_TYPE_ARRAY)
+       if(type -> class == OBERON_TYPE_POINTER || type -> class == OBERON_TYPE_ARRAY)

        {
        {

-               if(type -> size != 0)
+               if(type -> class == OBERON_TYPE_ARRAY
+                       && type -> size != 0
+                       && type -> base -> class == OBERON_TYPE_ARRAY
+                       && type -> base -> size == 0)

                {
                {

-                       if(type -> base -> class == OBERON_TYPE_ARRAY)
-                       {
-                               if(type -> base -> size == 0)
-                               {
-                                       oberon_error(ctx, "open array not allowed as array element");
-                               }
-                       }
+                       oberon_error(ctx, "open array not allowed as array element");

                }
 
                }
 

-               oberon_initialize_type(ctx, type -> base);              
-               oberon_generator_init_type(ctx, type);
+               oberon_type_t * rec = type -> base;
+               while(rec -> class == OBERON_TYPE_ARRAY || rec -> class == OBERON_TYPE_POINTER)
+               {
+                       rec = rec -> base;
+               }
+
+               if(rec -> class == OBERON_TYPE_RECORD
+                       && rec -> initialized == 0)
+               {
+                       rec -> initialized = 1;
+                       oberon_generator_init_type(ctx, rec);
+                       oberon_initialize_type(ctx, type -> base);
+                       oberon_generator_init_type(ctx, type);
+                       oberon_initialize_record_fields(ctx, rec);
+               }
+               else
+               {
+                       oberon_initialize_type(ctx, type -> base);
+                       oberon_generator_init_type(ctx, type);
+               }

        }
        else if(type -> class == OBERON_TYPE_RECORD)
        {
        }
        else if(type -> class == OBERON_TYPE_RECORD)
        {

+               printf("Init type: RECORD\n");

                oberon_generator_init_type(ctx, type);
                oberon_initialize_record_fields(ctx, type);
        }
        else if(type -> class == OBERON_TYPE_PROCEDURE)
        {
                oberon_generator_init_type(ctx, type);
                oberon_initialize_record_fields(ctx, type);
        }
        else if(type -> class == OBERON_TYPE_PROCEDURE)
        {

+               printf("Init type: PROCEDURE\n");

                int num_fields = type -> num_decl;
                oberon_object_t * field = type -> decl;
                for(int i = 0; i < num_fields; i++)
                {
                int num_fields = type -> num_decl;
                oberon_object_t * field = type -> decl;
                for(int i = 0; i < num_fields; i++)
                {

-                       //oberon_initialize_object(ctx, field);

                        oberon_initialize_type(ctx, field -> type);
                        field = field -> next;
                }
                        oberon_initialize_type(ctx, field -> type);
                        field = field -> next;
                }


@@ -3126,7 +3225,7 @@ oberon_case_labels(oberon_context_t * ctx, oberon_expr_t * val)
        oberon_expr_t * cond2;
 
        e1 = (oberon_expr_t *) oberon_const_expr(ctx);
        oberon_expr_t * cond2;
 
        e1 = (oberon_expr_t *) oberon_const_expr(ctx);

-       
+

        e2 = NULL;
        if(ctx -> token == DOTDOT)
        {
        e2 = NULL;
        if(ctx -> token == DOTDOT)
        {


@@ -3537,14 +3636,14 @@ oberon_import_module(oberon_context_t * ctx, char * alias, char * name)
 
        if(m == NULL)
        {
 
        if(m == NULL)
        {

-               const char * code;
-               code = ctx -> import_module(name);
-               if(code == NULL)
+               oberon_scanner_t * s;
+               s = ctx -> import_module(name);
+               if(s == NULL)

                {
                {

-                       oberon_error(ctx, "no such module");
+                       oberon_error(ctx, "no such module %s", name);

                }
 
                }
 

-               m = oberon_compile_module(ctx, code);
+               m = oberon_compile_module(ctx, s);

                assert(m);
        }
 
                assert(m);
        }
 


@@ -3788,7 +3887,7 @@ oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
        arg = list_args;
        oberon_check_src(ctx, arg);
 
        arg = list_args;
        oberon_check_src(ctx, arg);
 

-       if(oberon_is_number_type(arg -> result))
+       if(!oberon_is_number_type(arg -> result))

        {
                oberon_error(ctx, "ABS accepts only numbers");
        }
        {
                oberon_error(ctx, "ABS accepts only numbers");
        }


@@ -3822,7 +3921,7 @@ oberon_make_inc_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
                oberon_error(ctx, "too few arguments");
        }
 
                oberon_error(ctx, "too few arguments");
        }
 

-       if(num_args > 1)
+       if(num_args > 2)

        {
                oberon_error(ctx, "too mach arguments");
        }
        {
                oberon_error(ctx, "too mach arguments");
        }


@@ -3836,8 +3935,24 @@ oberon_make_inc_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
                oberon_error(ctx, "expect integer");
        }
 
                oberon_error(ctx, "expect integer");
        }
 

+       oberon_expr_t * step;
+       if(num_args == 2)
+       {
+               step = list_args -> next;
+               oberon_check_src(ctx, step);
+               oberon_check_const(ctx, step);
+               if(!oberon_is_integer_type(step -> result))
+               {
+                       oberon_error(ctx, "expect integer");
+               }
+       }
+       else
+       {
+               step = oberon_make_integer(ctx, 1);
+       }
+

        oberon_expr_t * expr;
        oberon_expr_t * expr;

-       expr = oberon_make_bin_op(ctx, PLUS, dst, oberon_make_integer(ctx, 1));
+       expr = oberon_make_bin_op(ctx, PLUS, dst, step);

        oberon_assign(ctx, expr, dst);
 }
 
        oberon_assign(ctx, expr, dst);
 }
 


@@ -3921,7 +4036,7 @@ oberon_make_dec_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
                oberon_error(ctx, "too few arguments");
        }
 
                oberon_error(ctx, "too few arguments");
        }
 

-       if(num_args > 1)
+       if(num_args > 2)

        {
                oberon_error(ctx, "too mach arguments");
        }
        {
                oberon_error(ctx, "too mach arguments");
        }


@@ -3935,8 +4050,24 @@ oberon_make_dec_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
                oberon_error(ctx, "expect integer");
        }
 
                oberon_error(ctx, "expect integer");
        }
 

+       oberon_expr_t * step;
+       if(num_args == 2)
+       {
+               step = list_args -> next;
+               oberon_check_src(ctx, step);
+               oberon_check_const(ctx, step);
+               if(!oberon_is_integer_type(step -> result))
+               {
+                       oberon_error(ctx, "expect integer");
+               }
+       }
+       else
+       {
+               step = oberon_make_integer(ctx, 1);
+       }
+

        oberon_expr_t * expr;
        oberon_expr_t * expr;

-       expr = oberon_make_bin_op(ctx, MINUS, dst, oberon_make_integer(ctx, 1));
+       expr = oberon_make_bin_op(ctx, MINUS, dst, step);

        oberon_assign(ctx, expr, dst);
 }
 
        oberon_assign(ctx, expr, dst);
 }
 


@@ -4392,7 +4523,7 @@ oberon_make_ord_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
        arg = list_args;
        oberon_check_src(ctx, arg);
 
        arg = list_args;
        oberon_check_src(ctx, arg);
 

-       if(!oberon_is_char_type(arg -> result))
+       if(!oberon_is_char_type(arg -> result) && !oberon_is_string_of_one(arg))

        {
                oberon_error(ctx, "expected char");
        }
        {
                oberon_error(ctx, "expected char");
        }


@@ -4404,7 +4535,7 @@ oberon_make_ord_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
        }
        else
        {
        }
        else
        {

-               expr = oberon_cast_expr(ctx, arg, ctx -> int_type);
+               expr = oberon_cast_expr(ctx, arg, ctx -> shortint_type);

        }
        return expr;
 }
        }
        return expr;
 }


@@ -4471,6 +4602,38 @@ oberon_make_odd_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
        return expr;
 }
 
        return expr;
 }
 

+static oberon_expr_t *
+oberon_make_cc_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;
+       oberon_check_src(ctx, arg);
+       oberon_check_const(ctx, arg);
+
+       if(!oberon_is_integer_type(arg -> result))
+       {
+               oberon_error(ctx, "expected integer");
+       }
+
+       /* n >= 0 && n <= 15 */
+
+       oberon_expr_t * cond1;
+       oberon_expr_t * cond2;
+       cond1 = oberon_make_bin_op(ctx, GEQ, arg, oberon_make_integer(ctx, 0));
+       cond2 = oberon_make_bin_op(ctx, LEQ, arg, oberon_make_integer(ctx, 15));
+       return oberon_make_bin_op(ctx, AND, cond1, cond2);
+}
+

 static oberon_expr_t *
 oberon_make_short_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
 {
 static oberon_expr_t *
 oberon_make_short_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
 {


@@ -4525,6 +4688,35 @@ oberon_make_long_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list
        return expr;
 }
 
        return expr;
 }
 

+static oberon_expr_t *
+oberon_make_val_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
+{
+       if(num_args < 2)
+       {
+               oberon_error(ctx, "too few arguments");
+       }
+
+       if(num_args > 2)
+       {
+               oberon_error(ctx, "too mach arguments");
+       }
+
+       oberon_expr_t * typ;
+       typ = list_args;
+       if(!oberon_is_type_expr(typ))
+       {
+               oberon_error(ctx, "requires type");
+       }
+
+       oberon_expr_t * arg;
+       arg = list_args -> next;
+       oberon_check_src(ctx, arg);
+
+       oberon_expr_t * expr;
+       expr = oberon_hard_cast_expr(ctx, arg, typ -> result);
+       return expr;
+}
+

 static oberon_expr_t *
 oberon_make_len_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
 {
 static oberon_expr_t *
 oberon_make_len_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
 {


@@ -4768,10 +4960,14 @@ oberon_create_context(ModuleImportCallback import_module)
                /* Types */
                oberon_new_intrinsic_type(ctx, "BYTE", ctx -> system_byte_type);
                oberon_new_intrinsic_type(ctx, "PTR", ctx -> system_ptr_type);
                /* Types */
                oberon_new_intrinsic_type(ctx, "BYTE", ctx -> system_byte_type);
                oberon_new_intrinsic_type(ctx, "PTR", ctx -> system_ptr_type);

+               oberon_new_intrinsic_type(ctx, "INT32", ctx -> int_type);
+               oberon_new_intrinsic_type(ctx, "SET32", ctx -> set_type);

 
                /* Functions */
 
                /* Functions */

+               oberon_new_intrinsic(ctx, "CC", oberon_make_cc_call, NULL);

                oberon_new_intrinsic(ctx, "LSH", oberon_make_lsh_call, NULL);
                oberon_new_intrinsic(ctx, "ROT", oberon_make_rot_call, NULL);
                oberon_new_intrinsic(ctx, "LSH", oberon_make_lsh_call, NULL);
                oberon_new_intrinsic(ctx, "ROT", oberon_make_rot_call, NULL);

+               oberon_new_intrinsic(ctx, "VAL", oberon_make_val_call, NULL);

 
        oberon_end_intrinsic_module(ctx, ctx -> system_module);
 
 
        oberon_end_intrinsic_module(ctx, ctx -> system_module);
 


@@ -4785,10 +4981,12 @@ oberon_destroy_context(oberon_context_t * ctx)
 }
 
 oberon_module_t *
 }
 
 oberon_module_t *

-oberon_compile_module(oberon_context_t * ctx, const char * newcode)
+oberon_compile_module(oberon_context_t * ctx, oberon_scanner_t * s)

 {
        const char * code = ctx -> code;
        int code_index = ctx -> code_index;
 {
        const char * code = ctx -> code;
        int code_index = ctx -> code_index;

+       oberon_location_t loc = ctx -> loc;
+       oberon_location_t xloc = ctx -> xloc;

        char c = ctx -> c;
        int token = ctx -> token;
        char * string = ctx -> string;
        char c = ctx -> c;
        int token = ctx -> token;
        char * string = ctx -> string;


@@ -4810,13 +5008,15 @@ oberon_compile_module(oberon_context_t * ctx, const char * newcode)
        ctx -> mod = module;
        ctx -> module_list = module;
 
        ctx -> mod = module;
        ctx -> module_list = module;
 

-       oberon_init_scaner(ctx, newcode);
+       oberon_init_scaner(ctx, s);

        oberon_parse_module(ctx);
 
        module -> ready = 1;
 
        ctx -> code = code;
        ctx -> code_index = code_index;
        oberon_parse_module(ctx);
 
        module -> ready = 1;
 
        ctx -> code = code;
        ctx -> code_index = code_index;

+       ctx -> loc = loc;
+       ctx -> xloc = xloc;

        ctx -> c = c;
        ctx -> token = token;
        ctx -> string = string;
        ctx -> c = c;
        ctx -> token = token;
        ctx -> string = string;