From: DeaDDooMER <deaddoomer@deadsoftware.ru>
Date: Wed, 2 Aug 2017 08:48:53 +0000 (+0300)
Subject: Добавлен тип CHAR
X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=commitdiff_plain;h=36c1947b3e98abab25f16a0f1c2679125651fe95

Добавлен тип CHAR
---

diff --git a/notes b/notes
index 7431ec7..524b4ae 100644
--- a/notes
+++ b/notes
@@ -1,9 +1,11 @@
 - нет символов и строк
-- Нет оператора IS
 - нету типа set
 
 - нету операторов if, while и т.д.
 
+- Нужен тип представляющий типы
+    Требуется для оператора IS и некоторых встраиваемых функций
+- Нет оператора IS
 - не реализованы все встроенные функции
 - не реализована свёртка констант
 
diff --git a/rtl/Out.java b/rtl/Out.java
index 309578a..429d321 100644
--- a/rtl/Out.java
+++ b/rtl/Out.java
@@ -7,6 +7,21 @@ public class Out
 
 	}
 
+	public static void Char(byte ch)
+	{
+		System.out.write(ch);
+	}
+
+	public static void String(byte[] str)
+	{
+		int i = 0;
+		while(str[i] != 0)
+		{
+			i += 1;
+		}
+		System.out.write(str, 0, i);
+	}
+
 	public static void Int(long i, long n)
 	{
 		System.out.print(i);
diff --git a/src/backends/jvm/generator-jvm-basic.c b/src/backends/jvm/generator-jvm-basic.c
index 2b9b548..aad9747 100644
--- a/src/backends/jvm/generator-jvm-basic.c
+++ b/src/backends/jvm/generator-jvm-basic.c
@@ -90,6 +90,26 @@ jvm_get_descriptor(oberon_type_t * type)
 					break;
 			}
 			break;
+		case OBERON_TYPE_CHAR:
+			switch(type -> size)
+			{
+				case 1:
+					return new_string("B");
+					break;
+				case 2:
+					return new_string("C");
+					break;
+				case 4:
+					return new_string("I");
+					break;
+				case 8:
+					return new_string("J");
+					break;
+				default:
+					gen_error("jvm_get_descriptor: unsupported char size %i", type -> size);
+					break;
+			}
+			break;
 		case OBERON_TYPE_BOOLEAN:
 			return new_string("Z");
 			break;
@@ -121,6 +141,7 @@ jvm_get_prefix(oberon_type_t * type)
 	{
 		case OBERON_TYPE_BOOLEAN:
 		case OBERON_TYPE_INTEGER:
+		case OBERON_TYPE_CHAR:
 			return (size <= 4) ? ('i') : ('l');
 			break;
 		case OBERON_TYPE_PROCEDURE:
@@ -132,10 +153,11 @@ jvm_get_prefix(oberon_type_t * type)
 		case OBERON_TYPE_REAL:
 			return (size <= 4) ? ('f') : ('d');
 			break;
+		default:
+			gen_error("jvm_get_prefix: wat");
+			return '!';
+			break;
 	}
-
-	gen_error("jvm_get_prefix: wat");
-	return '!';
 }
 
 char
@@ -167,6 +189,26 @@ jvm_get_postfix(oberon_type_t * type)
 					break;
 			}
 			break;
+		case OBERON_TYPE_CHAR:
+			switch(size)
+			{
+				case 1:
+					return 'b';
+					break;
+				case 2:
+					return 'c';
+					break;
+				case 4:
+					return 'i';
+					break;
+				case 8:
+					return 'l';
+					break;
+				default:
+					gen_error("jvm_get_postfix: char wat");
+					break;
+			}
+			break;
 		case OBERON_TYPE_PROCEDURE:
 		case OBERON_TYPE_ARRAY:
 		case OBERON_TYPE_RECORD:
diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c
index d986a8e..e4c70b1 100644
--- a/src/backends/jvm/generator-jvm.c
+++ b/src/backends/jvm/generator-jvm.c
@@ -858,6 +858,7 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
 		case OBERON_TYPE_BOOLEAN:
 		case OBERON_TYPE_ARRAY:
 		case OBERON_TYPE_REAL:
+		case OBERON_TYPE_CHAR:
 			break;
 		case OBERON_TYPE_RECORD:
 			;
@@ -1366,6 +1367,7 @@ push_item(gen_proc_t * p, oberon_item_t * item)
 			}
 			break;
 		case MODE_INTEGER:
+		case MODE_CHAR:
 			jvm_generate_push_int_size(p, item -> integer, item -> result -> size);
 			break;
 		case MODE_BOOLEAN:
diff --git a/src/oberon-internals.h b/src/oberon-internals.h
index c28cfa5..c154d01 100644
--- a/src/oberon-internals.h
+++ b/src/oberon-internals.h
@@ -32,7 +32,7 @@ struct oberon_scope_t
 	oberon_type_t * parent_type;
 };
 
-enum
+enum oberon_type_kind
 {
 	OBERON_TYPE_VOID,
 	OBERON_TYPE_INTEGER,
@@ -41,7 +41,8 @@ enum
 	OBERON_TYPE_ARRAY,
 	OBERON_TYPE_RECORD,
 	OBERON_TYPE_POINTER,
-	OBERON_TYPE_REAL
+	OBERON_TYPE_REAL,
+	OBERON_TYPE_CHAR
 };
 
 typedef oberon_expr_t * (*GenerateFuncCallback)(oberon_context_t *, int, oberon_expr_t *);
@@ -49,7 +50,7 @@ typedef void (*GenerateProcCallback)(oberon_context_t *, int, oberon_expr_t *);
 
 struct oberon_type_t
 {
-	int class;
+	enum oberon_type_kind class;
 	int size;
 
 	int num_decl;
@@ -68,7 +69,7 @@ struct oberon_type_t
 	gen_type_t * gen_type;
 };
 
-enum
+enum oberon_object_kind
 {
 	OBERON_CLASS_VAR,
 	OBERON_CLASS_TYPE,
@@ -83,7 +84,7 @@ enum
 struct oberon_object_t
 {
 	char * name;
-	int class;
+	enum oberon_object_kind class;
 	int export;
 	int read_only;
 
@@ -140,6 +141,8 @@ struct oberon_context_t
 	oberon_module_t * mod;
 	/*** END PARSER DATA ***/
 
+	oberon_type_t * void_type;
+	oberon_type_t * void_ptr_type;
 	oberon_type_t * bool_type;
 	oberon_type_t * byte_type;
 	oberon_type_t * shortint_type;
@@ -147,8 +150,7 @@ struct oberon_context_t
 	oberon_type_t * longint_type;
 	oberon_type_t * real_type;
 	oberon_type_t * longreal_type;
-	oberon_type_t * void_type;
-	oberon_type_t * void_ptr_type;
+	oberon_type_t * char_type;
 
 	oberon_scope_t * world_scope;
 	oberon_module_t * module_list;
@@ -156,7 +158,7 @@ struct oberon_context_t
 	gen_context_t * gen_context;
 };
 
-enum
+enum oberon_mode_kind
 {
 	MODE_VAR,
 	MODE_INTEGER,
@@ -168,9 +170,10 @@ enum
 	MODE_NIL,
 	MODE_NEW,
 	MODE_REAL,
+	MODE_CHAR
 };
 
-enum
+enum oberon_operator_kind
 {
 	OP_UNARY_MINUS,
 	OP_BITWISE_NOT,
@@ -200,12 +203,12 @@ enum
 
 struct oberon_item_t
 {
-	int is_item; // == 1
+	bool is_item; // == 1
 	oberon_type_t * result;
 	oberon_expr_t * next;
-	int read_only;
+	bool read_only;
 
-	int mode;
+	enum oberon_mode_kind mode;
 	long integer;
 	double real;
 	int boolean;
@@ -219,12 +222,12 @@ struct oberon_item_t
 
 struct oberon_oper_t
 {
-	int is_item; // == 0
+	bool is_item; // == 0
 	oberon_type_t * result;
 	oberon_expr_t * next;
-	int read_only;
+	bool read_only;
 
-	int op;
+	enum oberon_operator_kind op;
 	oberon_expr_t * left;
 	oberon_expr_t * right;
 };
@@ -232,10 +235,10 @@ struct oberon_oper_t
 union oberon_expr_t
 {
 	struct {
-		int is_item;
+		bool is_item;
 		oberon_type_t * result;
 		oberon_expr_t * next;
-		int read_only;
+		bool read_only;
 	};
 
 	oberon_item_t item;
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
diff --git a/src/test.c b/src/test.c
index 125c5df..03ac7fc 100644
--- a/src/test.c
+++ b/src/test.c
@@ -8,23 +8,42 @@ static char source_test[] =
 	"(* Main module *)"
 	"MODULE Test;"
 	"IMPORT Out;"
-	"TYPE"
-	"  RecA = POINTER TO RecADesc;"
-	"  RecADesc = RECORD END;"
+	"CONST"
+	"  null = 0X;"
+	"  space = 020X;"
+	"  bang = 021X;"
+	"  h = 048X;"
+	"  e = 045X;"
+	"  l = 04CX;"
+	"  o = 04FX;"
+	"  w = 057X;"
+	"  r = 052X;"
+	"  d = 044X;"
 	""
-	"  RecB = POINTER TO RecBDesc;"
-	"  RecBDesc = RECORD (RecADesc) END;"
+	"TYPE"
+	"  Ident = ARRAY 20 OF CHAR;"
 	""
 	"VAR"
-	"  pra : RecA;"
-	"  prb : RecB;"
-	"  ra  : RecADesc;"
-	"  rb  : RecBDesc;"
+	"  hello : Ident;"
+	"  cc : CHAR;"
 	""
 	"BEGIN"
-	"  pra := prb;"
-	"  prb := pra(RecB);"
-	"  ra := prb^;"
+	"  hello[0] := h;"
+	"  hello[1] := e;"
+	"  hello[2] := l;"
+	"  hello[3] := l;"
+	"  hello[4] := o;"
+	"  hello[5] := space;"
+	"  hello[6] := w;"
+	"  hello[7] := o;"
+	"  hello[8] := r;"
+	"  hello[9] := l;"
+	"  hello[10] := d;"
+	"  hello[11] := bang;"
+	"  hello[12] := null;"
+	"  Out.Open;"
+	"  Out.String(hello);"
+	"  Out.Ln;"
 	"END Test."
 ;
 
@@ -36,6 +55,12 @@ static char source_out[] =
 	"  PROCEDURE Open*;"
 	"  END Open;"
 	""
+	"  PROCEDURE Char* (ch : CHAR);"
+	"  END Char;"
+	""
+	"  PROCEDURE String* (str : ARRAY OF CHAR);"
+	"  END String;"
+	""
 	"  PROCEDURE Int*(i, n : LONGINT);"
 	"  END Int;"
 	""