DEADSOFTWARE

Добавлены указатели
[dsw-obn.git] / oberon.c
index 2b4e09f5e8a3ca7e95e4923a6d4773fa9e5202bf..7ca600e205a26e377f25bea0de64ff7ad0c758cf 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -48,7 +48,9 @@ enum {
        OF,
        LBRACE,
        RBRACE,
-       RECORD
+       RECORD,
+       POINTER,
+       TO
 };
 
 // =======================================================================
@@ -387,6 +389,14 @@ oberon_read_ident(oberon_context_t * ctx)
        {
                ctx -> token = RECORD;
        }
+       else if(strcmp(ident, "POINTER") == 0)
+       {
+               ctx -> token = POINTER;
+       }
+       else if(strcmp(ident, "TO") == 0)
+       {
+               ctx -> token = TO;
+       }
 }
 
 static void
@@ -653,6 +663,14 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
                        oberon_error(ctx, "incompatible size");
                }
        }
+       else if(pref -> class == OBERON_TYPE_RECORD)
+       {
+               if(expr -> result != pref)
+               {
+                       printf("oberon_autocast_to: rec %p != %p\n", expr -> result, pref);
+                       oberon_error(ctx, "incompatible record types");
+               }
+       }
 
        // TODO cast
 
@@ -1219,6 +1237,31 @@ oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec)
        }
 }
 
+static oberon_type_t *
+oberon_make_pointer(oberon_context_t * ctx, oberon_type_t * type)
+{
+       if(type -> class == OBERON_TYPE_POINTER)
+       {
+               return type;
+       }
+
+       if(type -> class == OBERON_TYPE_INTEGER
+               || type -> class == OBERON_TYPE_BOOLEAN
+               || type -> class == OBERON_TYPE_PROCEDURE
+               || type -> class == OBERON_TYPE_VOID)
+       {
+               oberon_error(ctx, "oberon not support pointers to non structure types");
+       }
+
+       oberon_type_t * newtype;
+       newtype = oberon_new_type_ptr(OBERON_TYPE_POINTER);
+       newtype -> base = type;
+
+       oberon_generator_init_type(ctx, newtype);
+
+       return newtype;
+}
+
 static oberon_type_t * oberon_opt_formal_pars(oberon_context_t * ctx, int class);
 
 static oberon_type_t *
@@ -1260,6 +1303,13 @@ oberon_type(oberon_context_t * ctx)
                type -> decl = type -> decl -> next;
                oberon_generator_init_type(ctx, type);
        }
+       else if(ctx -> token == POINTER)
+       {
+               oberon_assert_token(ctx, POINTER);
+               oberon_assert_token(ctx, TO);
+               type = oberon_type(ctx);
+               type = oberon_make_pointer(ctx, type);
+       }
        else if(ctx -> token == PROCEDURE)
        {
                oberon_assert_token(ctx, PROCEDURE);