X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Foberon.c;h=d6aefad6c94437641293674e57a730b7de2656e0;hb=ba8ed2cfa675b23cb19cba538f719a07a79ffb7f;hp=0fff8d7ba4c791846d662f1a6e728c6b2fbfe883;hpb=023ef0d8349acdfe751bba1b50749361682f72ff;p=dsw-obn.git diff --git a/src/oberon.c b/src/oberon.c index 0fff8d7..d6aefad 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -331,16 +331,6 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class, bool export return newvar; } -static oberon_object_t * -oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type, int export) -{ - oberon_object_t * id; - id = oberon_define_object(scope, name, OBERON_CLASS_TYPE, export, false, false); - id -> type = type; - oberon_generator_init_type(scope -> ctx, type); - return id; -} - // ======================================================================= // SCANER // ======================================================================= @@ -366,23 +356,20 @@ oberon_init_scaner(oberon_context_t * ctx, const char * code) static void oberon_read_ident(oberon_context_t * ctx) { - int len = 0; - int i = ctx -> code_index; + int start = ctx -> code_index; - int c = ctx -> code[i]; - while(isalnum(c)) + oberon_get_char(ctx); + while(isalnum(ctx -> c)) { - i += 1; - len += 1; - c = ctx -> code[i]; + oberon_get_char(ctx); } - char * ident = GC_MALLOC(len + 1); - memcpy(ident, &ctx->code[ctx->code_index], len); - ident[len] = 0; + int end = ctx -> code_index; + + char * ident = GC_MALLOC(end - start + 1); + memcpy(ident, &ctx -> code[start], end - start); + ident[end - start] = 0; - ctx -> code_index = i; - ctx -> c = ctx -> code[i]; ctx -> string = ident; ctx -> token = IDENT; @@ -748,7 +735,7 @@ static void oberon_read_string(oberon_context_t * ctx) char * string = GC_MALLOC(end - start + 1); strncpy(string, &ctx -> code[start], end - start); - string[end] = 0; + string[end - start] = 0; ctx -> token = STRING; ctx -> string = string; @@ -1047,10 +1034,14 @@ oberon_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * p cast = oberon_new_item(MODE_CHAR, ctx -> char_type, true); cast -> item.integer = expr -> item.string[0]; } - else + else if(!oberon_is_some_types(expr -> result, pref)) { cast = oberon_new_operator(OP_CAST, pref, expr, NULL); } + else + { + cast = expr; + } return cast; } @@ -1130,7 +1121,8 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_item_t * desig) { oberon_check_compatible_var_param(ctx, param -> type, arg -> result); } - casted[i] = oberon_cast_expr(ctx, arg, param -> type); + casted[i] = arg; + //casted[i] = oberon_cast_expr(ctx, arg, param -> type); } else { @@ -4469,34 +4461,36 @@ register_default_types(oberon_context_t * ctx) oberon_generator_init_type(ctx, ctx -> string_type); ctx -> bool_type = oberon_new_type_boolean(); - oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type, 1); + oberon_generator_init_type(ctx, ctx -> bool_type); ctx -> char_type = oberon_new_type_char(1); - oberon_define_type(ctx -> world_scope, "CHAR", ctx -> char_type, 1); + oberon_generator_init_type(ctx, ctx -> char_type); ctx -> byte_type = oberon_new_type_integer(1); - oberon_define_type(ctx -> world_scope, "SHORTINT", ctx -> byte_type, 1); + oberon_generator_init_type(ctx, ctx -> byte_type); ctx -> shortint_type = oberon_new_type_integer(2); - oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> shortint_type, 1); + oberon_generator_init_type(ctx, ctx -> shortint_type); ctx -> int_type = oberon_new_type_integer(4); - oberon_define_type(ctx -> world_scope, "LONGINT", ctx -> int_type, 1); + oberon_generator_init_type(ctx, ctx -> int_type); ctx -> longint_type = oberon_new_type_integer(8); - oberon_define_type(ctx -> world_scope, "HUGEINT", ctx -> longint_type, 1); + oberon_generator_init_type(ctx, ctx -> longint_type); ctx -> real_type = oberon_new_type_real(4); - oberon_define_type(ctx -> world_scope, "REAL", ctx -> real_type, 1); + oberon_generator_init_type(ctx, ctx -> real_type); ctx -> longreal_type = oberon_new_type_real(8); - oberon_define_type(ctx -> world_scope, "LONGREAL", ctx -> longreal_type, 1); + oberon_generator_init_type(ctx, ctx -> longreal_type); ctx -> set_type = oberon_new_type_set(4); - oberon_define_type(ctx -> world_scope, "SET", ctx -> set_type, 1); - + oberon_generator_init_type(ctx, ctx -> set_type); + ctx -> system_byte_type = oberon_new_type_ptr(OBERON_TYPE_SYSTEM_BYTE); + oberon_generator_init_type(ctx, ctx -> system_byte_type); + /* LONG / SHORT support */ ctx -> byte_type -> shorter = NULL; ctx -> byte_type -> longer = ctx -> shortint_type; @@ -4527,6 +4521,41 @@ oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f proc -> type -> genproc = p; } +static void oberon_new_intrinsic_type(oberon_context_t * ctx, char * name, oberon_type_t * type) +{ + oberon_object_t * id; + id = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, true, false, false); + id -> type = type; +} + +static void +oberon_begin_intrinsic_module(oberon_context_t * ctx, char * name, oberon_module_t ** m) +{ + oberon_scope_t * module_scope; + module_scope = oberon_open_scope(ctx); + + oberon_module_t * module; + module = GC_MALLOC(sizeof *module); + memset(module, 0, sizeof *module); + module -> name = name; + module -> intrinsic = true; + module -> decl = module_scope; + module -> next = ctx -> module_list; + + ctx -> mod = module; + ctx -> module_list = module; + + *m = module; +} + +static void +oberon_end_intrinsic_module(oberon_context_t * ctx, oberon_module_t * m) +{ + oberon_close_scope(m -> decl); + m -> ready = true; + ctx -> mod = NULL; +} + oberon_context_t * oberon_create_context(ModuleImportCallback import_module) { @@ -4541,12 +4570,24 @@ oberon_create_context(ModuleImportCallback import_module) oberon_generator_init_context(ctx); + /* Types */ register_default_types(ctx); /* Constants */ oberon_new_const(ctx, "TRUE", oberon_make_boolean(ctx, true)); oberon_new_const(ctx, "FALSE", oberon_make_boolean(ctx, false)); + /* Types */ + oberon_new_intrinsic_type(ctx, "BOOLEAN", ctx -> bool_type); + oberon_new_intrinsic_type(ctx, "CHAR", ctx -> char_type); + oberon_new_intrinsic_type(ctx, "SHORTINT", ctx -> byte_type); + oberon_new_intrinsic_type(ctx, "INTEGER", ctx -> shortint_type); + oberon_new_intrinsic_type(ctx, "LONGINT", ctx -> int_type); + oberon_new_intrinsic_type(ctx, "HUGEINT", ctx -> longint_type); + oberon_new_intrinsic_type(ctx, "REAL", ctx -> real_type); + oberon_new_intrinsic_type(ctx, "LONGREAL", ctx -> longreal_type); + oberon_new_intrinsic_type(ctx, "SET", ctx -> set_type); + /* Functions */ oberon_new_intrinsic(ctx, "ABS", oberon_make_abs_call, NULL); oberon_new_intrinsic(ctx, "ASH", oberon_make_ash_call, NULL); @@ -4572,6 +4613,14 @@ oberon_create_context(ModuleImportCallback import_module) oberon_new_intrinsic(ctx, "INCL", NULL, oberon_make_incl_call); oberon_new_intrinsic(ctx, "NEW", NULL, oberon_make_new_call); + /* MODULE SYSTEM */ + oberon_begin_intrinsic_module(ctx, "SYSTEM", &ctx -> system_module); + + /* Types */ + oberon_new_intrinsic_type(ctx, "BYTE", ctx -> system_byte_type); + + oberon_end_intrinsic_module(ctx, ctx -> system_module); + return ctx; }