Исправлено создание локальных типов и констант;

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

diff --git a/src/oberon.c b/src/oberon.c
index ebcaa990f9640d227f34c139844e63b26e5defee..72bf1c68b5a1f774c8284b4cab65a17c6adfc788 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -693,9 +693,9 @@ oberon_read_number(oberon_context_t * ctx)
 }
 
 static void
-oberon_skip_space(oberon_context_t * ctx)
+oberon_get_lined_char(oberon_context_t * ctx)
 {
-       while(isspace(ctx -> c))
+       do
        {
                if(ctx -> c == 0xD)
                {
@@ -717,6 +717,15 @@ oberon_skip_space(oberon_context_t * ctx)
                {
                        oberon_get_char(ctx);
                }
+       } while(ctx -> c == 0xD || ctx -> c == 0xA);
+}
+
+static void
+oberon_skip_space(oberon_context_t * ctx)
+{
+       while(isspace(ctx -> c))
+       {
+               oberon_get_lined_char(ctx);
        }
 }
 
@@ -728,19 +737,19 @@ oberon_read_comment(oberon_context_t * ctx)
        {
                if(ctx -> c == '(')
                {
-                       oberon_get_char(ctx);
+                       oberon_get_lined_char(ctx);
                        if(ctx -> c == '*')
                        {
-                               oberon_get_char(ctx);
+                               oberon_get_lined_char(ctx);
                                nesting += 1;
                        }
                }
                else if(ctx -> c == '*')
                {
-                       oberon_get_char(ctx);
+                       oberon_get_lined_char(ctx);
                        if(ctx -> c == ')')
                        {
-                               oberon_get_char(ctx);
+                               oberon_get_lined_char(ctx);
                                nesting -= 1;
                        }
                }
@@ -750,7 +759,7 @@ oberon_read_comment(oberon_context_t * ctx)
                }
                else
                {
-                       oberon_get_char(ctx);
+                       oberon_get_lined_char(ctx);
                }
        }
 }
@@ -1150,8 +1159,6 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_item_t * desig)
        int num_args = desig -> num_args;
        int num_decl = fn -> num_decl;
 
-       printf("oberon_autocast_call: num_args %i num_decl %i\n", num_args, num_decl);
-
        if(num_args < num_decl)
        {
                oberon_error(ctx, "too few arguments");
@@ -1952,7 +1959,7 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
                                                break;
                                }
                        }
-                       else if(oberon_is_number_type(result))
+                       else if(oberon_is_real_type(result))
                        {
                                switch(token)
                                {
@@ -1966,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:
+                                               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;
                                }
@@ -3855,7 +3888,7 @@ oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
        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");
        }
@@ -3889,7 +3922,7 @@ oberon_make_inc_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
                oberon_error(ctx, "too few arguments");
        }
 
-       if(num_args > 1)
+       if(num_args > 2)
        {
                oberon_error(ctx, "too mach arguments");
        }
@@ -3903,8 +3936,24 @@ oberon_make_inc_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
                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;
-       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);
 }
 
@@ -3988,7 +4037,7 @@ oberon_make_dec_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
                oberon_error(ctx, "too few arguments");
        }
 
-       if(num_args > 1)
+       if(num_args > 2)
        {
                oberon_error(ctx, "too mach arguments");
        }
@@ -4002,8 +4051,24 @@ oberon_make_dec_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
                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;
-       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);
 }
 
@@ -4896,6 +4961,8 @@ 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);
+               oberon_new_intrinsic_type(ctx, "INT32", ctx -> int_type);
+               oberon_new_intrinsic_type(ctx, "SET32", ctx -> set_type);
 
                /* Functions */
                oberon_new_intrinsic(ctx, "CC", oberon_make_cc_call, NULL);