X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=src%2Foberon.c;h=cf1a570f8084f96c21234f7de51ad5e1c4406676;hp=064cfb10bd0b24955eb0b23655c12ee68d62cf52;hb=bc1691627adee054210acf7e801361fa574f8086;hpb=879793eaf1d6378593f78a192f2961670f686530 diff --git a/src/oberon.c b/src/oberon.c index 064cfb1..cf1a570 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -24,8 +24,6 @@ enum { BEGIN, ASSIGN, INTEGER, - TRUE, - FALSE, LPAREN, RPAREN, EQUAL, @@ -344,14 +342,6 @@ oberon_read_ident(oberon_context_t * ctx) { ctx -> token = BEGIN; } - else if(strcmp(ident, "TRUE") == 0) - { - ctx -> token = TRUE; - } - else if(strcmp(ident, "FALSE") == 0) - { - ctx -> token = FALSE; - } else if(strcmp(ident, "OR") == 0) { ctx -> token = OR; @@ -700,8 +690,6 @@ static void oberon_read_string(oberon_context_t * ctx) ctx -> token = STRING; ctx -> string = string; - - printf("oberon_read_string: string ((%s))\n", string); } static void oberon_read_token(oberon_context_t * ctx); @@ -996,11 +984,8 @@ oberno_make_record_cast(oberon_context_t * ctx, oberon_expr_t * expr, oberon_typ oberon_type_t * from = expr -> result; oberon_type_t * to = rec; - printf("oberno_make_record_cast: from class %i to class %i\n", from -> class, to -> class); - if(from -> class == OBERON_TYPE_POINTER && to -> class == OBERON_TYPE_POINTER) { - printf("oberno_make_record_cast: pointers\n"); from = from -> base; to = to -> base; } @@ -1117,9 +1102,6 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * bool error = false; if(pref -> class != expr -> result -> class) { - printf("expr class %i\n", expr -> result -> class); - printf("pref class %i\n", pref -> class); - if(expr -> result -> class == OBERON_TYPE_STRING) { if(pref -> class == OBERON_TYPE_CHAR) @@ -1364,14 +1346,11 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args || ((x) == STRING) \ || ((x) == NIL) \ || ((x) == LPAREN) \ - || ((x) == NOT) \ - || ((x) == TRUE) \ - || ((x) == FALSE)) + || ((x) == NOT)) static oberon_expr_t * oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr) { - printf("oberno_make_dereferencing\n"); if(expr -> result -> class != OBERON_TYPE_POINTER) { oberon_error(ctx, "not a pointer"); @@ -1770,6 +1749,15 @@ oberon_set(oberon_context_t * ctx) return set; } +static oberon_expr_t * +oberon_make_boolean(oberon_context_t * ctx, bool cond) +{ + oberon_expr_t * expr; + expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true); + expr -> item.integer = cond; + return expr; +} + static oberon_expr_t * oberon_factor(oberon_context_t * ctx) { @@ -1804,16 +1792,6 @@ oberon_factor(oberon_context_t * ctx) expr -> item.real = ctx -> real; oberon_assert_token(ctx, REAL); break; - case TRUE: - expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true); - expr -> item.boolean = true; - oberon_assert_token(ctx, TRUE); - break; - case FALSE: - expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true); - expr -> item.boolean = false; - oberon_assert_token(ctx, FALSE); - break; case LBRACE: expr = oberon_set(ctx); break; @@ -2896,6 +2874,11 @@ oberon_prevent_recursive_record(oberon_context_t * ctx, oberon_type_t * type) type -> recursive = 1; + if(type -> base) + { + oberon_prevent_recursive_record(ctx, type -> base); + } + int num_fields = type -> num_decl; oberon_object_t * field = type -> decl; for(int i = 0; i < num_fields; i++) @@ -4038,6 +4021,15 @@ oberon_make_new_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ oberon_assign(ctx, src, dst); } +static void +oberon_new_const(oberon_context_t * ctx, char * name, oberon_expr_t * expr) +{ + oberon_object_t * constant; + constant = oberon_define_object(ctx -> decl, name, OBERON_CLASS_CONST, true, false, false); + oberon_check_const(ctx, expr); + constant -> value = (oberon_item_t *) expr; +} + oberon_context_t * oberon_create_context(ModuleImportCallback import_module) { @@ -4053,6 +4045,10 @@ oberon_create_context(ModuleImportCallback import_module) 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)); + /* Functions */ oberon_new_intrinsic(ctx, "ABS", oberon_make_abs_call, NULL); oberon_new_intrinsic(ctx, "MIN", oberon_make_min_call, NULL);