From: DeaDDooMER Date: Fri, 18 Aug 2017 09:18:11 +0000 (+0300) Subject: Добавлен тип SYSTEM.PTR X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=0570527a2279ee6bd14b4c08e653b6d68369475a;p=dsw-obn.git Добавлен тип SYSTEM.PTR --- diff --git a/Test.obn b/Test.obn index fa347cd..0bad0ad 100644 --- a/Test.obn +++ b/Test.obn @@ -1,21 +1,12 @@ MODULE Test; -IMPORT Files, Out; +IMPORT SYSTEM; VAR - f : Files.File; - r : Files.Rider; - len : LONGINT; - x : POINTER TO ARRAY OF CHAR; + ptr : SYSTEM.PTR; + arr : POINTER TO ARRAY OF INTEGER; BEGIN - f := Files.Old("Test.obn"); - ASSERT(f # NIL); - Files.Set(r, f, 0); - - len := Files.Length(f); - NEW(x, len + 1); - - Files.ReadBytes(r, x, len); - Out.String(x^); Out.Ln; + NEW(arr, 20); + ptr := arr; END Test. diff --git a/notes b/notes index f2ee7c3..14f5f21 100644 --- a/notes +++ b/notes @@ -1,6 +1,5 @@ - Перепроверить конверсию строк единичного размера в символ. - Не полная реализация модуля SYSTEM - * Нет типа SYSTEM.PTR * Нет процедур CC LSH ROT VAL * Процедуры GETREG PUTREG впринципе вписываются в jvm и могут быть полезны при реализции рефлекции diff --git a/src/backends/jvm/generator-jvm-basic.c b/src/backends/jvm/generator-jvm-basic.c index 478a92c..2baed65 100644 --- a/src/backends/jvm/generator-jvm-basic.c +++ b/src/backends/jvm/generator-jvm-basic.c @@ -149,6 +149,9 @@ jvm_get_descriptor(oberon_type_t * type) break; } break; + case OBERON_TYPE_SYSTEM_PTR: + return new_string("Ljava/lang/Object;"); + break; default: gen_error("jvm_get_descriptor: unsupported type class %i", type -> class); break; @@ -172,6 +175,9 @@ jvm_get_descriptor_safe(oberon_type_t * type) case OBERON_TYPE_ARRAY: return new_string("A%s", jvm_get_descriptor_safe(type -> base)); break; + case OBERON_TYPE_SYSTEM_PTR: + return new_string("SYSPTR"); + break; default: return jvm_get_descriptor(type); break; @@ -199,6 +205,7 @@ jvm_get_prefix(oberon_type_t * type) case OBERON_TYPE_POINTER: case OBERON_TYPE_STRING: case OBERON_TYPE_NIL: + case OBERON_TYPE_SYSTEM_PTR: return 'a'; break; case OBERON_TYPE_REAL: @@ -270,6 +277,7 @@ jvm_get_postfix(oberon_type_t * type) case OBERON_TYPE_POINTER: case OBERON_TYPE_STRING: case OBERON_TYPE_NIL: + case OBERON_TYPE_SYSTEM_PTR: return 'a'; break; case OBERON_TYPE_REAL: @@ -386,6 +394,9 @@ jvm_get_class_full_name(oberon_type_t * type) rec_id = type -> gen_type -> rec_id; name = new_string("%s$RECORD%i", type -> module -> name, rec_id); break; + case OBERON_TYPE_SYSTEM_PTR: + name = new_string("java/lang/Object"); + break; default: gen_error("jvm_get_class_full_name: unk type class %i", type -> class); break; diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c index 1ba25c9..feace6f 100644 --- a/src/backends/jvm/generator-jvm.c +++ b/src/backends/jvm/generator-jvm.c @@ -493,6 +493,7 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type) case OBERON_TYPE_SET: case OBERON_TYPE_NIL: case OBERON_TYPE_SYSTEM_BYTE: + case OBERON_TYPE_SYSTEM_PTR: break; case OBERON_TYPE_RECORD: m = type -> module -> gen_mod; diff --git a/src/oberon-internals.h b/src/oberon-internals.h index c1454d4..0a97386 100644 --- a/src/oberon-internals.h +++ b/src/oberon-internals.h @@ -48,7 +48,8 @@ enum oberon_type_kind OBERON_TYPE_STRING, OBERON_TYPE_SET, OBERON_TYPE_NIL, - OBERON_TYPE_SYSTEM_BYTE + OBERON_TYPE_SYSTEM_BYTE, + OBERON_TYPE_SYSTEM_PTR }; typedef oberon_expr_t * (*GenerateFuncCallback)(oberon_context_t *, int, oberon_expr_t *); @@ -166,6 +167,7 @@ struct oberon_context_t oberon_module_t * system_module; oberon_type_t * system_byte_type; + oberon_type_t * system_ptr_type; oberon_module_t * module_list; ModuleImportCallback import_module; diff --git a/src/oberon-type-compat.c b/src/oberon-type-compat.c index a99a04d..4291f6c 100644 --- a/src/oberon-type-compat.c +++ b/src/oberon-type-compat.c @@ -45,6 +45,12 @@ oberon_is_system_byte_type(oberon_type_t * t) return t -> class == OBERON_TYPE_SYSTEM_BYTE; } +bool +oberon_is_system_ptr_type(oberon_type_t * t) +{ + return t -> class == OBERON_TYPE_SYSTEM_PTR; +} + bool oberon_is_byte_type(oberon_type_t * t) { @@ -291,24 +297,10 @@ oberon_is_assignment_compatible_expressions(oberon_expr_t * e, oberon_type_t * T /* Доп: Tv - символ, е - строковая константа из одного символа */ /* SYSTEM: переменным типа BYTE можно присваивать значения переменных типа CHAR или SHORTINT. */ + /* SYSTEM: Переменным типа PTR могут быть присвоены значения переменных-указателей любого типа. */ oberon_type_t * Te = e -> result; -/* - printf("<<< oberon_is_assignment_compatible_expressions ===\n"); - printf(": Te -> class == %i\n", Te -> class); - printf(": Tv -> class == %i\n", Tv -> class); - printf(":: oberon_is_some_types(Te, Tv) == %i\n", oberon_is_some_types(Te, Tv)); - printf("::: oberon_is_number_type(Te) == %i\n", oberon_is_number_type(Te)); - printf("::: oberon_is_number_type(Tv) == %i\n", oberon_is_number_type(Tv)); - printf("::: oberon_incluses_type(Tv, Te) == %i\n", oberon_incluses_type(Tv, Te)); - printf(":::: oberon_is_record_type(Te) == %i\n", oberon_is_record_type(Te)); - printf(":::: oberon_is_record_type(Tv) == %i\n", oberon_is_record_type(Tv)); -// printf(":::: oberon_extension_of(Te, Tv) == %i\n", oberon_extension_of(Te, Tv)); - printf(":::: oberon_extension_of(Tv, Te) == %i\n", oberon_extension_of(Tv, Te)); - printf("=== oberon_is_assignment_compatible_expressions >>>\n"); -*/ - return oberon_is_some_types(Te, Tv) || (oberon_is_number_type(Te) && oberon_is_number_type(Tv) && oberon_incluses_type(Tv, Te)) || (oberon_is_record_type(Te) && oberon_is_record_type(Tv) && oberon_extension_of(Tv, Te)) @@ -317,7 +309,8 @@ oberon_is_assignment_compatible_expressions(oberon_expr_t * e, oberon_type_t * T || (oberon_is_array_of_char_type(Tv) && !oberon_is_open_array(Tv) && oberon_is_const_string(e) && (strlen(e -> item.string) < Tv -> size)) || (oberon_is_procedure_type(Tv) && e -> is_item && e -> item.var -> class == OBERON_CLASS_PROC && oberon_is_some_procedure_signatures(Tv, e -> result)) || (oberon_is_char_type(Tv) && oberon_is_const_string(e) && strlen(e -> item.string) == 1) - || (oberon_is_system_byte_type(Tv) && (oberon_is_char_type(Te) || oberon_is_byte_type(Te))); + || (oberon_is_system_byte_type(Tv) && (oberon_is_char_type(Te) || oberon_is_byte_type(Te))) + || (oberon_is_system_ptr_type(Tv) && oberon_is_pointer_type(Te)); } static bool @@ -452,10 +445,13 @@ oberon_is_compatible_var_param(oberon_type_t * Tf, oberon_type_t * Ta) /* SYSTEM: Если формальный параметр-переменная имеет тип ARRAY OF BYTE, */ /* то соответствующий фактический параметр может иметь любой тип. */ + /* SYSTEM: Если формальный параметр-переменная имеет тип PTR, */ + /* фактический параметр может быть указателем любого типа. */ return oberon_is_some_types(Tf, Ta) || (oberon_is_record_type(Tf) && oberon_extension_of(Ta, Tf)) - || (oberon_is_array_of_system_byte_type(Tf)); + || (oberon_is_array_of_system_byte_type(Tf)) + || (oberon_is_system_ptr_type(Tf)); } void diff --git a/src/oberon.c b/src/oberon.c index fbf0c45..07c83c2 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -4490,6 +4490,9 @@ register_default_types(oberon_context_t * ctx) ctx -> system_byte_type = oberon_new_type_ptr(OBERON_TYPE_SYSTEM_BYTE); oberon_generator_init_type(ctx, ctx -> system_byte_type); + ctx -> system_ptr_type = oberon_new_type_ptr(OBERON_TYPE_SYSTEM_PTR); + oberon_generator_init_type(ctx, ctx -> system_ptr_type); + /* LONG / SHORT support */ ctx -> byte_type -> shorter = NULL; ctx -> byte_type -> longer = ctx -> shortint_type; @@ -4618,6 +4621,7 @@ oberon_create_context(ModuleImportCallback import_module) /* Types */ oberon_new_intrinsic_type(ctx, "BYTE", ctx -> system_byte_type); + oberon_new_intrinsic_type(ctx, "PTR", ctx -> system_ptr_type); oberon_end_intrinsic_module(ctx, ctx -> system_module);