X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Foberon.c;h=0bbeec188b3d5b4e7fafe506285a9d096cb809b7;hb=1233fb1d5d8f67a8f5e970386c1c4cbb6691ec04;hp=efa6fed9c13a02e3e3d5438a8be29c7121768970;hpb=757bfb90589d07922991e34a4cc36ef434c8e3bb;p=dsw-obn.git diff --git a/src/oberon.c b/src/oberon.c index efa6fed..0bbeec1 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -8,6 +8,8 @@ #include #include +#include + #include "../include/oberon.h" #include "oberon-internals.h" @@ -25,7 +27,7 @@ oberon_make_copy_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list static oberon_type_t * oberon_new_type_ptr(int class) { - oberon_type_t * x = malloc(sizeof *x); + oberon_type_t * x = GC_MALLOC(sizeof *x); memset(x, 0, sizeof *x); x -> class = class; return x; @@ -88,7 +90,7 @@ static oberon_expr_t * oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right) { oberon_oper_t * operator; - operator = malloc(sizeof *operator); + operator = GC_MALLOC(sizeof *operator); memset(operator, 0, sizeof *operator); operator -> is_item = 0; @@ -105,7 +107,7 @@ static oberon_expr_t * oberon_new_item(int mode, oberon_type_t * result, int read_only) { oberon_item_t * item; - item = malloc(sizeof *item); + item = GC_MALLOC(sizeof *item); memset(item, 0, sizeof *item); item -> is_item = 1; @@ -224,8 +226,11 @@ oberon_make_set_range(oberon_context_t * ctx, int64_t x, int64_t y) static oberon_scope_t * oberon_open_scope(oberon_context_t * ctx) { - oberon_scope_t * scope = calloc(1, sizeof *scope); - oberon_object_t * list = calloc(1, sizeof *list); + oberon_scope_t * scope = GC_MALLOC(sizeof *scope); + memset(scope, 0, sizeof *scope); + + oberon_object_t * list = GC_MALLOC(sizeof *list); + memset(list, 0, sizeof *list); scope -> ctx = ctx; scope -> list = list; @@ -284,7 +289,7 @@ oberon_find_object(oberon_scope_t * scope, char * name, bool check_it) static oberon_object_t * oberon_create_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only) { - oberon_object_t * newvar = malloc(sizeof *newvar); + oberon_object_t * newvar = GC_MALLOC(sizeof *newvar); memset(newvar, 0, sizeof *newvar); newvar -> name = name; newvar -> class = class; @@ -326,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 // ======================================================================= @@ -372,7 +367,7 @@ oberon_read_ident(oberon_context_t * ctx) c = ctx -> code[i]; } - char * ident = malloc(len + 1); + char * ident = GC_MALLOC(len + 1); memcpy(ident, &ctx->code[ctx->code_index], len); ident[len] = 0; @@ -631,7 +626,7 @@ oberon_read_number(oberon_context_t * ctx) } int len = end_i - start_i; - ident = malloc(len + 1); + ident = GC_MALLOC(len + 1); memcpy(ident, &ctx -> code[start_i], len); ident[len] = 0; @@ -741,8 +736,9 @@ static void oberon_read_string(oberon_context_t * ctx) oberon_get_char(ctx); - char * string = calloc(1, end - start + 1); + char * string = GC_MALLOC(end - start + 1); strncpy(string, &ctx -> code[start], end - start); + string[end] = 0; ctx -> token = STRING; ctx -> string = string; @@ -1041,10 +1037,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; } @@ -1124,7 +1124,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 { @@ -2940,9 +2941,10 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type) oberon_object_t * field = type -> decl; for(int i = 0; i < num_fields; i++) { - oberon_initialize_object(ctx, field); + //oberon_initialize_object(ctx, field); + oberon_initialize_type(ctx, field -> type); field = field -> next; - } + } oberon_generator_init_type(ctx, type); } @@ -4462,34 +4464,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; @@ -4520,10 +4524,46 @@ 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) { - oberon_context_t * ctx = calloc(1, sizeof *ctx); + oberon_context_t * ctx = GC_MALLOC(sizeof *ctx); + memset(ctx, 0, sizeof *ctx); oberon_scope_t * world_scope; world_scope = oberon_open_scope(ctx); @@ -4533,12 +4573,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); @@ -4564,6 +4616,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; } @@ -4571,7 +4631,6 @@ void oberon_destroy_context(oberon_context_t * ctx) { oberon_generator_destroy_context(ctx); - free(ctx); } oberon_module_t * @@ -4592,7 +4651,8 @@ oberon_compile_module(oberon_context_t * ctx, const char * newcode) module_scope = oberon_open_scope(ctx); oberon_module_t * module; - module = calloc(1, sizeof *module); + module = GC_MALLOC(sizeof *module); + memset(module, 0, sizeof *module); module -> decl = module_scope; module -> next = ctx -> module_list;