X-Git-Url: https://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=src%2Foberon.c;h=6cc5d1d193787867c68e74c0aec302d40a6022e0;hp=e755b6cf625c2984edd3ef2dd8655810426fd44e;hb=36c1947b3e98abab25f16a0f1c2679125651fe95;hpb=e6a70a3b694efa5600cfcd0d8110f8d9e8866342

diff --git a/src/oberon.c b/src/oberon.c
index e755b6c..6cc5d1d 100644
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -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