X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Foberon.c;h=e684e655df644a277dbc65955983efcc62d08b27;hb=4e58c0e61815196bcf87405ab9d070631bc72f90;hp=c1e86d229c340de3f475029119b6335ea08f4aba;hpb=9aa6ede8ebe1b901501ad3cb49d79d6811a79dc9;p=dsw-obn.git

diff --git a/src/oberon.c b/src/oberon.c
index c1e86d2..e684e65 100644
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -10,8 +10,6 @@
 
 #include <gc.h>
 
-#include "../include/oberon.h"
-
 #include "oberon-internals.h"
 #include "oberon-type-compat.h"
 #include "oberon-common.h"
@@ -171,6 +169,17 @@ oberon_make_char(oberon_context_t * ctx, int64_t i)
 	return expr;
 }
 
+static oberon_expr_t *
+oberon_make_string(oberon_context_t * ctx, char * str)
+{
+	oberon_expr_t * expr;
+	expr = oberon_new_item(MODE_STRING, ctx -> string_type, true);
+	expr -> item.integer = str[0];
+	expr -> item.real = str[0];
+	expr -> item.string = str;
+	return expr;
+}
+
 static oberon_expr_t *
 oberon_make_real_typed(oberon_context_t * ctx, double r, oberon_type_t * result)
 {
@@ -351,15 +360,20 @@ oberon_get_char(oberon_context_t * ctx)
 	if(ctx -> code[ctx -> code_index])
 	{
 		ctx -> code_index += 1;
+		ctx -> xloc.col += 1;
 		ctx -> c = ctx -> code[ctx -> code_index];
 	}
 }
 
 static void
-oberon_init_scaner(oberon_context_t * ctx, const char * code)
+oberon_init_scaner(oberon_context_t * ctx, oberon_scanner_t * s)
 {
-	ctx -> code = code;
+	ctx -> code = s -> code;
 	ctx -> code_index = 0;
+	ctx -> xloc.source = s -> source;
+	ctx -> xloc.line = 1;
+	ctx -> xloc.col = 1;
+	ctx -> loc = ctx -> xloc;
 	ctx -> c = ctx -> code[ctx -> code_index];
 }
 
@@ -683,7 +697,26 @@ oberon_skip_space(oberon_context_t * ctx)
 {
 	while(isspace(ctx -> c))
 	{
-		oberon_get_char(ctx);
+		if(ctx -> c == 0xD)
+		{
+			oberon_get_char(ctx);
+			if(ctx -> c == 0xA)
+			{
+				oberon_get_char(ctx);
+			}
+			ctx -> xloc.line += 1;
+			ctx -> xloc.col = 1;
+		}
+		else if(ctx -> c == 0xA)
+		{
+			oberon_get_char(ctx);
+			ctx -> xloc.line += 1;
+			ctx -> xloc.col = 1;
+		}
+		else
+		{
+			oberon_get_char(ctx);
+		}
 	}
 }
 
@@ -899,6 +932,8 @@ oberon_read_token(oberon_context_t * ctx)
 {
 	oberon_skip_space(ctx);
 
+	ctx -> loc = ctx -> xloc;
+
 	int c = ctx -> c;
 	if(isalpha(c) || c == '_')
 	{
@@ -1666,9 +1701,7 @@ oberon_factor(oberon_context_t * ctx)
 			oberon_assert_token(ctx, CHAR);
 			break;
 		case STRING:
-			result = ctx -> string_type;
-			expr = oberon_new_item(MODE_STRING, result, true);
-			expr -> item.string = ctx -> string;
+			expr = oberon_make_string(ctx, ctx -> string);
 			oberon_assert_token(ctx, STRING);
 			break;
 		case REAL:
@@ -1705,7 +1738,7 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
 	oberon_expr_t * expr;
 	oberon_type_t * result;
 
-	oberon_check_compatible_bin_expr_types(ctx, token, a -> result, b -> result);
+	oberon_check_compatible_bin_expr(ctx, token, a, b);
 	oberon_check_src(ctx, a);
 	if(token != IS)
 	{
@@ -1730,7 +1763,22 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
 	}
 	else if((token >= EQUAL && token <= GEQ) || token == OR || token == AND)
 	{
-		result = oberon_get_longer_type(ctx, a -> result, b -> result);
+		if(oberon_is_string_of_one(a) && oberon_is_char_type(b -> result))
+		{
+			result = b -> result;
+		}
+		else if(oberon_is_string_of_one(b) && oberon_is_char_type(a -> result))
+		{
+			result = a -> result;
+		}
+		else if(oberon_is_string_of_one(a) && oberon_is_string_of_one(b))
+		{
+			result = ctx -> char_type;
+		}
+		else
+		{
+			result = oberon_get_longer_type(ctx, a -> result, b -> result);
+		}
 
 		if(oberon_is_const(a) && oberon_is_const(b)
 			&& (oberon_is_real_type(result) || oberon_is_integer_type(result)))
@@ -3132,7 +3180,7 @@ oberon_case_labels(oberon_context_t * ctx, oberon_expr_t * val)
 	oberon_expr_t * cond2;
 
 	e1 = (oberon_expr_t *) oberon_const_expr(ctx);
-	
+
 	e2 = NULL;
 	if(ctx -> token == DOTDOT)
 	{
@@ -3543,14 +3591,14 @@ oberon_import_module(oberon_context_t * ctx, char * alias, char * name)
 
 	if(m == NULL)
 	{
-		const char * code;
-		code = ctx -> import_module(name);
-		if(code == NULL)
+		oberon_scanner_t * s;
+		s = ctx -> import_module(name);
+		if(s == NULL)
 		{
-			oberon_error(ctx, "no such module");
+			oberon_error(ctx, "no such module %s", name);
 		}
 
-		m = oberon_compile_module(ctx, code);
+		m = oberon_compile_module(ctx, s);
 		assert(m);
 	}
 
@@ -4398,7 +4446,7 @@ oberon_make_ord_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
 	arg = list_args;
 	oberon_check_src(ctx, arg);
 
-	if(!oberon_is_char_type(arg -> result))
+	if(!oberon_is_char_type(arg -> result) && !oberon_is_string_of_one(arg))
 	{
 		oberon_error(ctx, "expected char");
 	}
@@ -4854,10 +4902,12 @@ oberon_destroy_context(oberon_context_t * ctx)
 }
 
 oberon_module_t *
-oberon_compile_module(oberon_context_t * ctx, const char * newcode)
+oberon_compile_module(oberon_context_t * ctx, oberon_scanner_t * s)
 {
 	const char * code = ctx -> code;
 	int code_index = ctx -> code_index;
+	oberon_location_t loc = ctx -> loc;
+	oberon_location_t xloc = ctx -> xloc;
 	char c = ctx -> c;
 	int token = ctx -> token;
 	char * string = ctx -> string;
@@ -4879,13 +4929,15 @@ oberon_compile_module(oberon_context_t * ctx, const char * newcode)
 	ctx -> mod = module;
 	ctx -> module_list = module;
 
-	oberon_init_scaner(ctx, newcode);
+	oberon_init_scaner(ctx, s);
 	oberon_parse_module(ctx);
 
 	module -> ready = 1;
 
 	ctx -> code = code;
 	ctx -> code_index = code_index;
+	ctx -> loc = loc;
+	ctx -> xloc = xloc;
 	ctx -> c = c;
 	ctx -> token = token;
 	ctx -> string = string;