Добавлены объявления типов-записей и типов-процедур, добавлены и исправлены селекторы...

diff --git a/generator.c b/generator.c
index 685786f19f9af12ff75fdc30ab16801a75cb922d..4ffba1173bf23582df014dea6d89d290656afcd3 100644 (file)
--- a/generator.c
+++ b/generator.c
@@ -65,7 +65,8 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
        gen_context_t * gen_context = ctx -> gen_context;
        gcc_jit_context * gcc_context = gen_context -> gcc_context;
 
-       gcc_jit_type * gcc_type;
+       gcc_jit_type * gcc_type = NULL;
+       gcc_jit_struct * gcc_struct = NULL;
        if(type -> class == OBERON_TYPE_VOID)
        {
                gcc_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_VOID);
@@ -80,7 +81,22 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
        }
        else if(type -> class == OBERON_TYPE_PROCEDURE)
        {
-               gcc_type = NULL; // not used
+               int num_params = type -> num_decl;
+               gcc_jit_type * params[num_params];
+               oberon_object_t * o = type -> decl;
+               for(int i = 0; i < num_params; i++)
+               {
+                       gen_type_t * gen_type = o -> type -> gen_type;
+                       params[i] = gen_type -> gcc_type;
+                       o = o -> next;
+               }
+
+               gen_type_t * base = type -> base -> gen_type;
+               gcc_jit_type * result_type = base -> gcc_type;
+
+               gcc_type = gcc_jit_context_new_function_ptr_type(
+                       gcc_context, NULL, result_type, num_params, params, 0
+               );
        }
        else if(type -> class == OBERON_TYPE_ARRAY)
        {
@@ -94,12 +110,31 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
 
                gcc_type = gcc_jit_context_new_array_type(gcc_context, NULL, gcc_base, type -> size);
        }
+       else if(type -> class == OBERON_TYPE_RECORD)
+       {
+               // TODO type exstension
+
+               int num_fields = type -> num_decl;
+               gcc_jit_field * fields[num_fields];
+               oberon_object_t * o = type -> decl;
+               for(int i = 0; i < num_fields; i++)
+               {
+                       assert(o -> class == OBERON_CLASS_FIELD);
+                       gen_var_t * var = o -> gen_var;
+                       fields[i] = var -> gcc_field;
+                       o = o -> next;
+               }
+
+               gcc_struct = gcc_jit_context_new_struct_type(gcc_context, NULL, "", num_fields, fields);
+               gcc_type = gcc_jit_struct_as_type(gcc_struct);
+       }
        else
        {
                oberon_error(ctx, "oberon_generator_init_type: invalid type class %i", type -> class);
        }
 
        gen_type -> gcc_type = gcc_type;
+       gen_type -> gcc_struct = gcc_struct;
 }
 
 void
@@ -117,21 +152,32 @@ oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
        const char * name = var -> name;
 
        // TODO var param
+       gcc_jit_lvalue * gcc_lvalue = NULL;
+       gcc_jit_param * gcc_param = NULL;
+       gcc_jit_field * gcc_field = NULL;
        if(var -> class == OBERON_CLASS_VAR)
        {
-               gen_var -> gcc_lvalue = gcc_jit_context_new_global(
+               gcc_lvalue = gcc_jit_context_new_global(
                        gcc_context, NULL, GCC_JIT_GLOBAL_INTERNAL, gcc_type, name
                );
        }
        else if(var -> class == OBERON_CLASS_PARAM)
        {
-               gen_var -> gcc_param = gcc_jit_context_new_param(gcc_context, NULL, gcc_type, name);
-               gen_var -> gcc_lvalue = gcc_jit_param_as_lvalue(gen_var -> gcc_param);
+               gcc_param = gcc_jit_context_new_param(gcc_context, NULL, gcc_type, name);
+               gcc_lvalue = gcc_jit_param_as_lvalue(gcc_param);
+       }
+       else if(var -> class == OBERON_CLASS_FIELD)
+       {
+               gcc_field = gcc_jit_context_new_field(gcc_context, NULL, gcc_type, name);
        }
        else
        {
                oberon_error(ctx, "oberon_generator_init_var: invalid class %i", var -> class);
        }
+
+       gen_var -> gcc_lvalue = gcc_lvalue;
+       gen_var -> gcc_param = gcc_param;
+       gen_var -> gcc_field = gcc_field;
 }
 
 void
@@ -173,6 +219,7 @@ oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc)
 //   GENERATOR
 // ======================================================================= 
 
+static gcc_jit_rvalue * rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item);
 static gcc_jit_rvalue * rvalue_from_expr(oberon_context_t * ctx, oberon_expr_t * expr);
 
 void
@@ -253,6 +300,42 @@ oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr)
        }
 }
 
+static gcc_jit_lvalue *
+lvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
+{
+       gen_context_t * gen_context = ctx -> gen_context;
+       gcc_jit_context * gcc_context = gen_context -> gcc_context;
+
+       gcc_jit_lvalue * left;
+
+       if(item -> mode == MODE_VAR)
+       {
+               gen_var_t * gen_var = item -> var -> gen_var;
+               left = gen_var -> gcc_lvalue;
+       }
+       else if(item -> mode == MODE_INDEX)
+       {
+               assert(item -> num_args == 1);
+               gcc_jit_rvalue * parent = rvalue_from_item(ctx, item -> parent);
+               gcc_jit_rvalue * index = rvalue_from_expr(ctx, item -> args);
+               left = gcc_jit_context_new_array_access(gcc_context, NULL, parent, index);
+       }
+       else if(item -> mode == MODE_FIELD)
+       {
+               gen_var_t * gen_var = item -> var -> gen_var;
+               gcc_jit_field * gcc_field = gen_var -> gcc_field;
+
+               gcc_jit_lvalue * parent = lvalue_from_item(ctx, item -> parent);
+               left = gcc_jit_lvalue_access_field(parent, NULL, gcc_field);
+       }
+       else
+       {
+               oberon_error(ctx, "invalid lvalue expression");
+       }
+
+       return left;
+}
+
 static gcc_jit_lvalue *
 lvalue_from_expr(oberon_context_t *ctx, oberon_expr_t * expr)
 {
@@ -262,12 +345,7 @@ lvalue_from_expr(oberon_context_t *ctx, oberon_expr_t * expr)
        if(expr -> is_item)
        {
                item = (oberon_item_t *) expr;
-               if(item -> mode != MODE_VAR)
-               {
-                       oberon_error(ctx, "invalid lvalue expression");
-               }
-               gen_var_t * gen_var = item -> var -> gen_var;
-               left = gen_var -> gcc_lvalue;
+               left = lvalue_from_item(ctx, item);
        }
        else
        {
@@ -329,9 +407,22 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
                        gcc_context, NULL, func, num_args, args
                );
        }
+       else if(item -> mode == MODE_INDEX)
+       {
+               gcc_jit_lvalue * left = lvalue_from_item(ctx, item);
+               right = gcc_jit_lvalue_as_rvalue(left);
+       }
+       else if(item -> mode == MODE_FIELD)
+       {
+               gen_var_t * gen_var = item -> var -> gen_var;
+               gcc_jit_field * gcc_field = gen_var -> gcc_field;
+
+               gcc_jit_rvalue * parent = rvalue_from_item(ctx, item -> parent);
+               right = gcc_jit_rvalue_access_field(parent, NULL, gcc_field);
+       }
        else
        {
-               oberon_error(ctx, "oberon_generate_push: invalid mode %i", item -> mode);
+               oberon_error(ctx, "rvalue_from_item: invalid mode %i", item -> mode);
        }
 
        return right;

diff --git a/notes b/notes
index b82a34fc4769894e9824f54171efd53fb460f3c3..0925eb083c763703c3ab831bee7d3f12eb7992f0 100644 (file)
--- a/notes
+++ b/notes
@@ -1,6 +1,8 @@
 - нету автокаста в присвоении и передачи параметров
-- нету секции type
 - нету локальных объявлений в процедурах
 - нету свёртки констант
 - нету полного контроля return
-- нету селекторов
+- нету типа procedure
+- нету указателей
+- нету расширения типа
+- нету var-параметров в генераторе

diff --git a/oberon.c b/oberon.c
index 65803c0d7eaf5924fdc96b42858b0eb3834c016d..2b4e09f5e8a3ca7e95e4923a6d4773fa9e5202bf 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -48,6 +48,7 @@ enum {
        OF,
        LBRACE,
        RBRACE,
+       RECORD
 };
 
 // =======================================================================
@@ -148,6 +149,32 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class)
        return newvar;
 }
 
+static void
+oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char *  name, oberon_type_t * type)
+{
+       oberon_object_t * x = rec -> decl;
+       while(x -> next && strcmp(x -> next -> name, name) != 0)
+       {
+               x = x -> next;
+       }
+
+       if(x -> next)
+       {
+               oberon_error(ctx, "multiple definition");
+       }
+
+       oberon_object_t * field = malloc(sizeof *field);
+       memset(field, 0, sizeof *field);
+       field -> name = name;
+       field -> class = OBERON_CLASS_FIELD;
+       field -> type = type;
+
+       rec -> num_decl += 1;
+       oberon_generator_init_var(ctx, field);
+
+       x -> next = field;
+}
+
 static oberon_object_t *
 oberon_find_object_in_list(oberon_object_t * list, char * name)
 {
@@ -179,6 +206,24 @@ oberon_find_object(oberon_scope_t * scope, char * name)
        return result;
 }
 
+static oberon_object_t *
+oberon_find_field(oberon_context_t * ctx, oberon_type_t * rec, char * name)
+{
+       oberon_object_t * x = rec -> decl;
+       for(int i = 0; i < rec -> num_decl; i++)
+       {
+               if(strcmp(x -> name, name) == 0)
+               {
+                       return x;
+               }
+               x = x -> next;
+       }
+
+       oberon_error(ctx, "field not defined");
+
+       return NULL;
+}
+
 static oberon_object_t *
 oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type)
 {
@@ -338,6 +383,10 @@ oberon_read_ident(oberon_context_t * ctx)
        {
                ctx -> token = OF;
        }
+       else if(strcmp(ident, "RECORD") == 0)
+       {
+               ctx -> token = RECORD;
+       }
 }
 
 static void
@@ -591,11 +640,12 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first)
 static oberon_expr_t *
 oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
 {
-       if(expr -> result -> class != pref -> class)
+       if(pref -> class != expr -> result -> class)
        {
                oberon_error(ctx, "incompatible types");
        }
 
+
        if(pref -> class == OBERON_TYPE_INTEGER)
        {
                if(expr -> result -> class > pref -> class)
@@ -660,6 +710,79 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
        || ((x) == TRUE) \
        || ((x) == FALSE))
 
+#define ISSELECTOR(x) \
+       (((x) == LBRACE) \
+       || ((x) == DOT))
+
+static oberon_expr_t *
+oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int num_indexes, oberon_expr_t * indexes)
+{
+       assert(desig -> is_item == 1);
+
+       if(desig -> item.mode != MODE_VAR)
+       {
+               oberon_error(ctx, "not MODE_VAR");
+       }
+
+       int class = desig -> item.var -> class;
+       switch(class)
+       {
+               case OBERON_CLASS_VAR:
+               case OBERON_CLASS_VAR_PARAM:
+               case OBERON_CLASS_PARAM:
+                       break;
+               default:
+                       oberon_error(ctx, "not variable");
+                       break;
+       }
+
+       oberon_type_t * type = desig -> item.var -> type;
+       if(type -> class != OBERON_TYPE_ARRAY)
+       {
+               oberon_error(ctx, "not array");
+       }
+
+       int dim = desig -> item.var -> type -> dim;
+       if(num_indexes != dim)
+       {
+               oberon_error(ctx, "dimesions not matched");
+       }
+
+       oberon_type_t * base = desig -> item.var -> type -> base;
+
+       oberon_expr_t * selector;
+       selector = oberon_new_item(MODE_INDEX, base);
+       selector -> item.parent = (oberon_item_t *) desig;
+       selector -> item.num_args = num_indexes;
+       selector -> item.args = indexes;
+
+       return selector;
+}
+
+static oberon_expr_t *
+oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * name)
+{
+       assert(expr -> is_item == 1);
+
+       int class = expr -> result -> class;
+       if(class != OBERON_TYPE_RECORD)
+       {
+               oberon_error(ctx, "not record");
+       }
+
+       oberon_type_t * rec = expr -> result;
+
+       oberon_object_t * field;
+       field = oberon_find_field(ctx, rec, name);
+
+       oberon_expr_t * selector;
+       selector = oberon_new_item(MODE_FIELD, field -> type);
+       selector -> item.var = field;
+       selector -> item.parent = (oberon_item_t *) expr;
+
+       return selector;
+}
+
 static oberon_expr_t *
 oberon_designator(oberon_context_t * ctx)
 {
@@ -688,8 +811,30 @@ oberon_designator(oberon_context_t * ctx)
                        oberon_error(ctx, "invalid designator");
                        break;
        }
-
        expr -> item.var = var;
+
+       while(ISSELECTOR(ctx -> token))
+       {
+               switch(ctx -> token)
+               {
+                       case DOT:
+                               oberon_assert_token(ctx, DOT);
+                               name = oberon_assert_ident(ctx);
+                               expr = oberon_make_record_selector(ctx, expr, name);
+                               break;
+                       case LBRACE:
+                               oberon_assert_token(ctx, LBRACE);
+                               int num_indexes = 0;
+                               oberon_expr_t * indexes = NULL;
+                               oberon_expr_list(ctx, &num_indexes, &indexes);
+                               oberon_assert_token(ctx, RBRACE);
+                               expr = oberon_make_array_selector(ctx, expr, num_indexes, indexes);
+                               break;
+                       default:
+                               oberon_error(ctx, "oberon_designator: wat");
+                               break;
+               }
+       }
        return expr;
 }
 
@@ -697,8 +842,14 @@ static oberon_expr_t *
 oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 {
        assert(expr -> is_item == 1);
+
        if(ctx -> token == LPAREN)
        {
+               if(expr -> result -> class != OBERON_TYPE_PROCEDURE)
+               {
+                       oberon_error(ctx, "not a procedure");
+               }
+
                oberon_assert_token(ctx, LPAREN);
 
                int num_args = 0;
@@ -1054,6 +1205,22 @@ oberon_make_array_type(oberon_context_t * ctx, int dim, oberon_item_t * size, ob
        return newtype;
 }
 
+static void
+oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec)
+{
+       if(ctx -> token == IDENT)
+       {
+               char * name;
+               oberon_type_t * type;
+               name = oberon_assert_ident(ctx);
+               oberon_assert_token(ctx, COLON);
+               type = oberon_type(ctx);
+               oberon_define_field(ctx, rec, name, type);
+       }
+}
+
+static oberon_type_t * oberon_opt_formal_pars(oberon_context_t * ctx, int class);
+
 static oberon_type_t *
 oberon_type(oberon_context_t * ctx)
 {
@@ -1072,6 +1239,32 @@ oberon_type(oberon_context_t * ctx)
                oberon_type_t * base = oberon_type(ctx);
                type = oberon_make_array_type(ctx, 1, size, base);
        }
+       else if(ctx -> token == RECORD)
+       {
+               type = oberon_new_type_ptr(OBERON_TYPE_RECORD);
+               oberon_object_t * list = malloc(sizeof *list);
+               memset(list, 0, sizeof *list);
+               type -> num_decl = 0;
+               type -> base = NULL;
+               type -> decl = list;
+
+               oberon_assert_token(ctx, RECORD);
+               oberon_field_list(ctx, type);
+               while(ctx -> token == SEMICOLON)
+               {
+                       oberon_assert_token(ctx, SEMICOLON);
+                       oberon_field_list(ctx, type);
+               }
+               oberon_assert_token(ctx, END);
+
+               type -> decl = type -> decl -> next;
+               oberon_generator_init_type(ctx, type);
+       }
+       else if(ctx -> token == PROCEDURE)
+       {
+               oberon_assert_token(ctx, PROCEDURE);
+               type = oberon_opt_formal_pars(ctx, OBERON_TYPE_PROCEDURE);
+       }
        else
        {
                oberon_error(ctx, "invalid type declaration");
@@ -1170,6 +1363,27 @@ oberon_formal_pars(oberon_context_t * ctx)
        return tp;
 }
 
+static oberon_type_t *
+oberon_opt_formal_pars(oberon_context_t * ctx, int class)
+{
+       oberon_type_t * signature;
+
+       if(ctx -> token == LPAREN)
+       {
+               signature = oberon_formal_pars(ctx);
+       }
+       else
+       {
+               signature = oberon_new_type_ptr(class);
+               signature -> num_decl = 0;
+               signature -> base = ctx -> void_type;
+               signature -> decl = NULL;
+               oberon_generator_init_type(ctx, signature);
+       }
+
+       return signature;
+}
+
 static void
 oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
 {
@@ -1207,18 +1421,7 @@ oberon_proc_decl(oberon_context_t * ctx)
        oberon_open_scope(ctx);
 
        oberon_type_t * signature;
-       if(ctx -> token == LPAREN)
-       {
-               signature = oberon_formal_pars(ctx);
-       }
-       else
-       {
-               signature = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
-               signature -> num_decl = 0;
-               signature -> base = ctx -> void_type;
-               signature -> decl = NULL;
-               oberon_generator_init_type(ctx, signature);
-       }
+       signature = oberon_opt_formal_pars(ctx, OBERON_TYPE_PROCEDURE);
 
        oberon_object_t * proc;
        proc = oberon_define_proc(this_proc_def_scope, name, signature);

diff --git a/oberon.h b/oberon.h
index becdd78e6cf530ec53d67ab0ce1ed9b86ab818ef..69ee927fede72bb5a643c55608c23db621e78c44 100644 (file)
--- a/oberon.h
+++ b/oberon.h
@@ -15,20 +15,21 @@ typedef struct
 typedef struct
 {
        gcc_jit_type * gcc_type;
+       gcc_jit_struct * gcc_struct;
 } gen_type_t;
 
 typedef struct
 {
-        char stub[16];
-        gcc_jit_lvalue * gcc_lvalue;
-        gcc_jit_param * gcc_param;
+       gcc_jit_lvalue * gcc_lvalue;
+       gcc_jit_param * gcc_param;
+       gcc_jit_field * gcc_field;
 } gen_var_t;
 
 typedef struct
 {
-        gcc_jit_context * gcc_context;
-        gcc_jit_block * gcc_block;
-        gcc_jit_result * gcc_result;
+       gcc_jit_context * gcc_context;
+       gcc_jit_block * gcc_block;
+       gcc_jit_result * gcc_result;
 } gen_context_t;
 
 typedef struct oberon_type_s oberon_type_t;
@@ -69,7 +70,8 @@ enum
        OBERON_TYPE_INTEGER,
        OBERON_TYPE_BOOLEAN,
        OBERON_TYPE_PROCEDURE,
-       OBERON_TYPE_ARRAY
+       OBERON_TYPE_ARRAY,
+       OBERON_TYPE_RECORD,
 };
 
 /*
@@ -120,7 +122,8 @@ enum
        OBERON_CLASS_PROC,
        OBERON_CLASS_PARAM,
        OBERON_CLASS_VAR_PARAM,
-       OBERON_CLASS_CONST
+       OBERON_CLASS_CONST,
+       OBERON_CLASS_FIELD
 };
 
 /*
@@ -209,7 +212,9 @@ enum
        MODE_VAR,
        MODE_INTEGER,
        MODE_BOOLEAN,
-       MODE_CALL
+       MODE_CALL,
+       MODE_INDEX,
+       MODE_FIELD
 };
 
 enum
@@ -242,6 +247,8 @@ struct oberon_item_s
        int boolean;
        oberon_object_t * var;
 
+       oberon_item_t * parent;
+
        int num_args;
        oberon_expr_t * args;
 };

diff --git a/test.c b/test.c
index 7c8e6720506e4c8113282b94656fdaf20d44baca..42526b66791c035ca854e2221050f26eeac893e5 100644 (file)
--- a/test.c
+++ b/test.c
@@ -9,12 +9,16 @@ static const char source[] =
        "TYPE"
        "       MyInt = INTEGER;"
        "       MyArr = ARRAY con OF MyInt;"
+       "       MyRec = RECORD a : MyInt; b : MyInt; END;"
+       "       MyProc = PROCEDURE;"
        ""
        "VAR"
        "       k : INTEGER;"
        "       i : INTEGER;"
        "       b : BOOLEAN;"
        "       arr : MyArr;"
+       "       rec : MyRec;"
+       "       proc : MyProc;"
        ""
        "PROCEDURE Tier;"
        "BEGIN"
@@ -38,7 +42,10 @@ static const char source[] =
        "       Tier();"
        "       Tier2(21, 13);"
        "       k := Tier3(2);"
-//     "       arr[0] := 1;"
+       "       arr[0] := 1;"
+       "       arr[1] := arr[0];"
+       "       rec.a := 1;"
+       "       rec.b := rec.a;"
        "END Test."
 ;