X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=oberon.c;h=7ca600e205a26e377f25bea0de64ff7ad0c758cf;hp=bd5498bbccc06ee9a4ac7ff684ca9f2532149bf9;hb=8520fd72cf3c1daeabbb8da91290dae85fc39c91;hpb=342c8f1a44765e744c64e14a3b8f1aa4031c5f62

diff --git a/oberon.c b/oberon.c
index bd5498b..7ca600e 100644
--- 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
@@ -1227,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 *
@@ -1268,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);