DEADSOFTWARE

Добавлен тип CHAR
authorDeaDDooMER <deaddoomer@deadsoftware.ru>
Wed, 2 Aug 2017 08:48:53 +0000 (11:48 +0300)
committerDeaDDooMER <deaddoomer@deadsoftware.ru>
Wed, 2 Aug 2017 08:48:53 +0000 (11:48 +0300)
notes
rtl/Out.java
src/backends/jvm/generator-jvm-basic.c
src/backends/jvm/generator-jvm.c
src/oberon-internals.h
src/oberon.c
src/test.c

diff --git a/notes b/notes
index 7431ec7b508b5d28a6652deb57e340be3db5667a..524b4ae19bef0e3b510872eb073fa2d1e6703567 100644 (file)
--- a/notes
+++ b/notes
@@ -1,9 +1,11 @@
 - нет символов и строк
-- Нет оператора IS
 - нету типа set
 
 - нету операторов if, while и т.д.
 
+- Нужен тип представляющий типы
+    Требуется для оператора IS и некоторых встраиваемых функций
+- Нет оператора IS
 - не реализованы все встроенные функции
 - не реализована свёртка констант
 
index 309578afe881cccdb7078a6bc2cdca151fcb0bf8..429d3214773b9b27fdf8974fa98e1f193e1fec00 100644 (file)
@@ -7,6 +7,21 @@ public class Out
 
        }
 
+       public static void Char(byte ch)
+       {
+               System.out.write(ch);
+       }
+
+       public static void String(byte[] str)
+       {
+               int i = 0;
+               while(str[i] != 0)
+               {
+                       i += 1;
+               }
+               System.out.write(str, 0, i);
+       }
+
        public static void Int(long i, long n)
        {
                System.out.print(i);
index 2b9b5483efa3b7b76050a4c105d3cb4b20dc655c..aad9747f25cbf4d091e86db1f0ea9a3d098753dc 100644 (file)
@@ -90,6 +90,26 @@ jvm_get_descriptor(oberon_type_t * type)
                                        break;
                        }
                        break;
+               case OBERON_TYPE_CHAR:
+                       switch(type -> size)
+                       {
+                               case 1:
+                                       return new_string("B");
+                                       break;
+                               case 2:
+                                       return new_string("C");
+                                       break;
+                               case 4:
+                                       return new_string("I");
+                                       break;
+                               case 8:
+                                       return new_string("J");
+                                       break;
+                               default:
+                                       gen_error("jvm_get_descriptor: unsupported char size %i", type -> size);
+                                       break;
+                       }
+                       break;
                case OBERON_TYPE_BOOLEAN:
                        return new_string("Z");
                        break;
@@ -121,6 +141,7 @@ jvm_get_prefix(oberon_type_t * type)
        {
                case OBERON_TYPE_BOOLEAN:
                case OBERON_TYPE_INTEGER:
+               case OBERON_TYPE_CHAR:
                        return (size <= 4) ? ('i') : ('l');
                        break;
                case OBERON_TYPE_PROCEDURE:
@@ -132,10 +153,11 @@ jvm_get_prefix(oberon_type_t * type)
                case OBERON_TYPE_REAL:
                        return (size <= 4) ? ('f') : ('d');
                        break;
+               default:
+                       gen_error("jvm_get_prefix: wat");
+                       return '!';
+                       break;
        }
-
-       gen_error("jvm_get_prefix: wat");
-       return '!';
 }
 
 char
@@ -167,6 +189,26 @@ jvm_get_postfix(oberon_type_t * type)
                                        break;
                        }
                        break;
+               case OBERON_TYPE_CHAR:
+                       switch(size)
+                       {
+                               case 1:
+                                       return 'b';
+                                       break;
+                               case 2:
+                                       return 'c';
+                                       break;
+                               case 4:
+                                       return 'i';
+                                       break;
+                               case 8:
+                                       return 'l';
+                                       break;
+                               default:
+                                       gen_error("jvm_get_postfix: char wat");
+                                       break;
+                       }
+                       break;
                case OBERON_TYPE_PROCEDURE:
                case OBERON_TYPE_ARRAY:
                case OBERON_TYPE_RECORD:
index d986a8e4cbc9af35a1fcf9361c531238c1de3fa8..e4c70b1c23d312e580c24f1a2d2348963548ecc1 100644 (file)
@@ -858,6 +858,7 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
                case OBERON_TYPE_BOOLEAN:
                case OBERON_TYPE_ARRAY:
                case OBERON_TYPE_REAL:
+               case OBERON_TYPE_CHAR:
                        break;
                case OBERON_TYPE_RECORD:
                        ;
@@ -1366,6 +1367,7 @@ push_item(gen_proc_t * p, oberon_item_t * item)
                        }
                        break;
                case MODE_INTEGER:
+               case MODE_CHAR:
                        jvm_generate_push_int_size(p, item -> integer, item -> result -> size);
                        break;
                case MODE_BOOLEAN:
index c28cfa5b80761a1d42992a32ffa5d49fa31dce76..c154d0127093d265ed6c970614f21549f9a0f557 100644 (file)
@@ -32,7 +32,7 @@ struct oberon_scope_t
        oberon_type_t * parent_type;
 };
 
-enum
+enum oberon_type_kind
 {
        OBERON_TYPE_VOID,
        OBERON_TYPE_INTEGER,
@@ -41,7 +41,8 @@ enum
        OBERON_TYPE_ARRAY,
        OBERON_TYPE_RECORD,
        OBERON_TYPE_POINTER,
-       OBERON_TYPE_REAL
+       OBERON_TYPE_REAL,
+       OBERON_TYPE_CHAR
 };
 
 typedef oberon_expr_t * (*GenerateFuncCallback)(oberon_context_t *, int, oberon_expr_t *);
@@ -49,7 +50,7 @@ typedef void (*GenerateProcCallback)(oberon_context_t *, int, oberon_expr_t *);
 
 struct oberon_type_t
 {
-       int class;
+       enum oberon_type_kind class;
        int size;
 
        int num_decl;
@@ -68,7 +69,7 @@ struct oberon_type_t
        gen_type_t * gen_type;
 };
 
-enum
+enum oberon_object_kind
 {
        OBERON_CLASS_VAR,
        OBERON_CLASS_TYPE,
@@ -83,7 +84,7 @@ enum
 struct oberon_object_t
 {
        char * name;
-       int class;
+       enum oberon_object_kind class;
        int export;
        int read_only;
 
@@ -140,6 +141,8 @@ struct oberon_context_t
        oberon_module_t * mod;
        /*** END PARSER DATA ***/
 
+       oberon_type_t * void_type;
+       oberon_type_t * void_ptr_type;
        oberon_type_t * bool_type;
        oberon_type_t * byte_type;
        oberon_type_t * shortint_type;
@@ -147,8 +150,7 @@ struct oberon_context_t
        oberon_type_t * longint_type;
        oberon_type_t * real_type;
        oberon_type_t * longreal_type;
-       oberon_type_t * void_type;
-       oberon_type_t * void_ptr_type;
+       oberon_type_t * char_type;
 
        oberon_scope_t * world_scope;
        oberon_module_t * module_list;
@@ -156,7 +158,7 @@ struct oberon_context_t
        gen_context_t * gen_context;
 };
 
-enum
+enum oberon_mode_kind
 {
        MODE_VAR,
        MODE_INTEGER,
@@ -168,9 +170,10 @@ enum
        MODE_NIL,
        MODE_NEW,
        MODE_REAL,
+       MODE_CHAR
 };
 
-enum
+enum oberon_operator_kind
 {
        OP_UNARY_MINUS,
        OP_BITWISE_NOT,
@@ -200,12 +203,12 @@ enum
 
 struct oberon_item_t
 {
-       int is_item; // == 1
+       bool is_item; // == 1
        oberon_type_t * result;
        oberon_expr_t * next;
-       int read_only;
+       bool read_only;
 
-       int mode;
+       enum oberon_mode_kind mode;
        long integer;
        double real;
        int boolean;
@@ -219,12 +222,12 @@ struct oberon_item_t
 
 struct oberon_oper_t
 {
-       int is_item; // == 0
+       bool is_item; // == 0
        oberon_type_t * result;
        oberon_expr_t * next;
-       int read_only;
+       bool read_only;
 
-       int op;
+       enum oberon_operator_kind op;
        oberon_expr_t * left;
        oberon_expr_t * right;
 };
@@ -232,10 +235,10 @@ struct oberon_oper_t
 union oberon_expr_t
 {
        struct {
-               int is_item;
+               bool is_item;
                oberon_type_t * result;
                oberon_expr_t * next;
-               int read_only;
+               bool read_only;
        };
 
        oberon_item_t item;
index e755b6cf625c2984edd3ef2dd8655810426fd44e..6cc5d1d193787867c68e74c0aec302d40a6022e0 100644 (file)
@@ -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
index 125c5df07d2f017942479ff9a7ed5e979f86b4f2..03ac7fc3ab12979d8fcaadac8c5ccd244769f4bc 100644 (file)
@@ -8,23 +8,42 @@ static char source_test[] =
        "(* Main module *)"
        "MODULE Test;"
        "IMPORT Out;"
-       "TYPE"
-       "  RecA = POINTER TO RecADesc;"
-       "  RecADesc = RECORD END;"
+       "CONST"
+       "  null = 0X;"
+       "  space = 020X;"
+       "  bang = 021X;"
+       "  h = 048X;"
+       "  e = 045X;"
+       "  l = 04CX;"
+       "  o = 04FX;"
+       "  w = 057X;"
+       "  r = 052X;"
+       "  d = 044X;"
        ""
-       "  RecB = POINTER TO RecBDesc;"
-       "  RecBDesc = RECORD (RecADesc) END;"
+       "TYPE"
+       "  Ident = ARRAY 20 OF CHAR;"
        ""
        "VAR"
-       "  pra : RecA;"
-       "  prb : RecB;"
-       "  ra  : RecADesc;"
-       "  rb  : RecBDesc;"
+       "  hello : Ident;"
+       "  cc : CHAR;"
        ""
        "BEGIN"
-       "  pra := prb;"
-       "  prb := pra(RecB);"
-       "  ra := prb^;"
+       "  hello[0] := h;"
+       "  hello[1] := e;"
+       "  hello[2] := l;"
+       "  hello[3] := l;"
+       "  hello[4] := o;"
+       "  hello[5] := space;"
+       "  hello[6] := w;"
+       "  hello[7] := o;"
+       "  hello[8] := r;"
+       "  hello[9] := l;"
+       "  hello[10] := d;"
+       "  hello[11] := bang;"
+       "  hello[12] := null;"
+       "  Out.Open;"
+       "  Out.String(hello);"
+       "  Out.Ln;"
        "END Test."
 ;
 
@@ -36,6 +55,12 @@ static char source_out[] =
        "  PROCEDURE Open*;"
        "  END Open;"
        ""
+       "  PROCEDURE Char* (ch : CHAR);"
+       "  END Char;"
+       ""
+       "  PROCEDURE String* (str : ARRAY OF CHAR);"
+       "  END String;"
+       ""
        "  PROCEDURE Int*(i, n : LONGINT);"
        "  END Int;"
        ""