X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=oberon.c;h=dfed94a274ad3991d56ab8adf5223fabac446e38;hp=f4a711f5da3156912e43afb4bc8887dd076936a3;hb=338eeae16495bbdcbd8c4f3dad4996346e26139b;hpb=7bff9378302d5e23c6e9eabe7e6edc8034dcd562

diff --git a/oberon.c b/oberon.c
index f4a711f..dfed94a 100644
--- a/oberon.c
+++ b/oberon.c
@@ -50,7 +50,9 @@ enum {
 	RBRACE,
 	RECORD,
 	POINTER,
-	TO
+	TO,
+	UPARROW,
+	NIL
 };
 
 // =======================================================================
@@ -395,6 +397,10 @@ oberon_read_ident(oberon_context_t * ctx)
 	{
 		ctx -> token = TO;
 	}
+	else if(strcmp(ident, "NIL") == 0)
+	{
+		ctx -> token = NIL;
+	}
 }
 
 static void
@@ -527,6 +533,10 @@ oberon_read_symbol(oberon_context_t * ctx)
 			ctx -> token = RBRACE;
 			oberon_get_char(ctx);
 			break;
+		case '^':
+			ctx -> token = UPARROW;
+			oberon_get_char(ctx);
+			break;
 		default:
 			oberon_error(ctx, "invalid char");
 			break;
@@ -726,45 +736,42 @@ 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)
+oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
 {
-	assert(desig -> is_item == 1);
-
-	if(desig -> item.mode != MODE_VAR)
+	if(expr -> result -> class != OBERON_TYPE_POINTER)
 	{
-		oberon_error(ctx, "not MODE_VAR");
+		oberon_error(ctx, "not a pointer");
 	}
 
-	int class = desig -> item.var -> class;
-	switch(class)
+	assert(expr -> is_item);
+
+	oberon_expr_t * selector;
+	selector = oberon_new_item(MODE_DEREF, expr -> result -> base);
+	selector -> item.parent = (oberon_item_t *) expr;
+
+	return selector;
+}
+
+static oberon_expr_t *
+oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int num_indexes, oberon_expr_t * indexes)
+{
+	if(desig -> result -> class == OBERON_TYPE_POINTER)
 	{
-		case OBERON_CLASS_VAR:
-		case OBERON_CLASS_VAR_PARAM:
-		case OBERON_CLASS_PARAM:
-			break;
-		default:
-			oberon_error(ctx, "not variable");
-			break;
+		desig = oberno_make_dereferencing(ctx, desig);
 	}
 
-	oberon_type_t * type = desig -> item.var -> type;
-	if(type -> class != OBERON_TYPE_ARRAY)
+	assert(desig -> is_item);
+
+	if(desig -> result -> 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;
+	base = desig -> result -> base;
 
-	oberon_type_t * base = desig -> item.var -> type -> base;
+	// TODO check ranges
 
 	oberon_expr_t * selector;
 	selector = oberon_new_item(MODE_INDEX, base);
@@ -778,10 +785,14 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int nu
 static oberon_expr_t *
 oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * name)
 {
+	if(expr -> result -> class == OBERON_TYPE_POINTER)
+	{
+		expr = oberno_make_dereferencing(ctx, expr);
+	}
+
 	assert(expr -> is_item == 1);
 
-	int class = expr -> result -> class;
-	if(class != OBERON_TYPE_RECORD)
+	if(expr -> result -> class != OBERON_TYPE_RECORD)
 	{
 		oberon_error(ctx, "not record");
 	}
@@ -799,6 +810,11 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
 	return selector;
 }
 
+#define ISSELECTOR(x) \
+	(((x) == LBRACE) \
+	|| ((x) == DOT) \
+	|| ((x) == UPARROW))
+
 static oberon_expr_t *
 oberon_designator(oberon_context_t * ctx)
 {
@@ -846,6 +862,10 @@ oberon_designator(oberon_context_t * ctx)
 				oberon_assert_token(ctx, RBRACE);
 				expr = oberon_make_array_selector(ctx, expr, num_indexes, indexes);
 				break;
+			case UPARROW:
+				oberon_assert_token(ctx, UPARROW);
+				expr = oberno_make_dereferencing(ctx, expr);
+				break;
 			default:
 				oberon_error(ctx, "oberon_designator: wat");
 				break;
@@ -924,6 +944,10 @@ oberon_factor(oberon_context_t * ctx)
 			expr = oberon_factor(ctx);
 			expr = oberon_make_unary_op(ctx, NOT, expr);
 			break;
+		case NIL:
+			oberon_assert_token(ctx, NIL);
+			expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type);
+			break;
 		default:
 			oberon_error(ctx, "invalid expression");
 	}
@@ -1773,16 +1797,8 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
 
 	if(type -> class == OBERON_TYPE_POINTER)
 	{
-		if(type -> base -> class == OBERON_TYPE_RECORD)
-		{
-			oberon_generator_init_type(ctx, type -> base);
-			oberon_generator_init_type(ctx, type);
-		}
-		else
-		{
-			oberon_initialize_type(ctx, type -> base);
-			oberon_generator_init_type(ctx, type);
-		}
+		oberon_initialize_type(ctx, type -> base);
+		oberon_generator_init_type(ctx, type);
 	}
 	else if(type -> class == OBERON_TYPE_ARRAY)
 	{
@@ -1995,6 +2011,10 @@ register_default_types(oberon_context_t * ctx)
 	ctx -> void_type = oberon_new_type_ptr(OBERON_TYPE_VOID);
 	oberon_generator_init_type(ctx, ctx -> void_type);
 
+	ctx -> void_ptr_type = oberon_new_type_ptr(OBERON_TYPE_POINTER);
+	ctx -> void_ptr_type -> base = ctx -> void_type;
+	oberon_generator_init_type(ctx, ctx -> void_ptr_type);
+
 	ctx -> int_type = oberon_new_type_integer(sizeof(int));
 	oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type);