Добавлен тип CHAR

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

diff --git a/src/oberon.c b/src/oberon.c
index e755b6cf625c2984edd3ef2dd8655810426fd44e..6cc5d1d193787867c68e74c0aec302d40a6022e0 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -59,7 +59,8 @@ enum {
        UPARROW,
        NIL,
        IMPORT,
-       REAL
+       REAL,
+       CHAR
 };
 
 // =======================================================================
@@ -116,6 +117,15 @@ oberon_new_type_real(int size)
        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;
+}
+
 // =======================================================================
 //   TABLE
 // ======================================================================= 
@@ -377,6 +387,7 @@ oberon_read_number(oberon_context_t * ctx)
         * mode = 1 == HEX
         * mode = 2 == REAL
         * mode = 3 == LONGREAL
+        * mode = 4 == CHAR
         */
        int mode = 0;
        start_i = ctx -> code_index;
@@ -398,11 +409,20 @@ oberon_read_number(oberon_context_t * ctx)
 
                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_get_char(ctx);
        }
        else if(ctx -> c == '.')
        {
@@ -440,6 +460,20 @@ oberon_read_number(oberon_context_t * ctx)
                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);
@@ -470,6 +504,11 @@ oberon_read_number(oberon_context_t * ctx)
                        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;
@@ -747,7 +786,14 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first,
        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);
@@ -1106,10 +1152,13 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_ar
        || ((x) == MINUS) \
        || ((x) == IDENT) \
        || ((x) == INTEGER) \
+       || ((x) == REAL) \
+       || ((x) == CHAR) \
+       || ((x) == NIL) \
        || ((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)
@@ -1373,7 +1422,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)
 {
-       assert(expr -> is_item == 1);
+       assert(expr -> is_item);
 
        int num_args = 0;
        oberon_expr_t * arguments = NULL;
@@ -1433,6 +1482,12 @@ oberon_factor(oberon_context_t * ctx)
                        expr -> item.integer = ctx -> integer;
                        oberon_assert_token(ctx, INTEGER);
                        break;
+               case CHAR:
+                       result = ctx -> char_type;
+                       expr = oberon_new_item(MODE_CHAR, result, 1);
+                       expr -> item.integer = ctx -> integer;
+                       oberon_assert_token(ctx, CHAR);
+                       break;
                case REAL:
                        result = (ctx -> longmode) ? (ctx -> longreal_type) : (ctx -> real_type);
                        expr = oberon_new_item(MODE_REAL, result, 1);
@@ -2915,6 +2970,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 -> char_type = oberon_new_type_char(1);
+       oberon_define_type(ctx -> world_scope, "CHAR", ctx -> char_type, 1);
 }
 
 static void