X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=oberon.c;h=b0bb6aa6fa3ba13a60fe7f956fc8dc820d683501;hb=d3438ae51da4c98b47441911495f10e686191abd;hp=dfed94a274ad3991d56ab8adf5223fabac446e38;hpb=338eeae16495bbdcbd8c4f3dad4996346e26139b;p=dsw-obn.git diff --git a/oberon.c b/oberon.c index dfed94a..b0bb6aa 100644 --- a/oberon.c +++ b/oberon.c @@ -118,6 +118,12 @@ oberon_open_scope(oberon_context_t * ctx) scope -> list = list; scope -> up = ctx -> decl; + if(scope -> up) + { + scope -> parent = scope -> up -> parent; + scope -> local = scope -> up -> local; + } + ctx -> decl = scope; return scope; } @@ -147,6 +153,8 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class) memset(newvar, 0, sizeof *newvar); newvar -> name = name; newvar -> class = class; + newvar -> local = scope -> local; + newvar -> parent = scope -> parent; x -> next = newvar; @@ -156,6 +164,8 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class) static void oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char * name, oberon_type_t * type) { + // TODO check base fields + oberon_object_t * x = rec -> decl; while(x -> next && strcmp(x -> next -> name, name) != 0) { @@ -172,6 +182,8 @@ oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char * name, o field -> name = name; field -> class = OBERON_CLASS_FIELD; field -> type = type; + field -> local = 1; + field -> parent = NULL; rec -> num_decl += 1; x -> next = field; @@ -274,6 +286,7 @@ oberon_find_var(oberon_scope_t * scope, char * name) } */ +/* static oberon_object_t * oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signature) { @@ -282,6 +295,7 @@ oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signatur proc -> type = signature; return proc; } +*/ // ======================================================================= // SCANER @@ -572,6 +586,7 @@ static oberon_expr_t * oberon_expr(oberon_context_t * ctx); static void oberon_assert_token(oberon_context_t * ctx, int token); static char * oberon_assert_ident(oberon_context_t * ctx); static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type); +static oberon_item_t * oberon_const_expr(oberon_context_t * ctx); static oberon_expr_t * oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right) @@ -638,7 +653,7 @@ oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a) } static void -oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first) +oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first, int const_expr) { oberon_expr_t * last; @@ -648,7 +663,16 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first) { oberon_assert_token(ctx, COMMA); oberon_expr_t * current; - current = oberon_expr(ctx); + + if(const_expr) + { + current = (oberon_expr_t *) oberon_const_expr(ctx); + } + else + { + current = oberon_expr(ctx); + } + last -> next = current; last = current; *num_expr += 1; @@ -663,7 +687,6 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * oberon_error(ctx, "incompatible types"); } - if(pref -> class == OBERON_TYPE_INTEGER) { if(expr -> result -> class > pref -> class) @@ -679,6 +702,16 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * oberon_error(ctx, "incompatible record types"); } } + else if(pref -> class == OBERON_TYPE_POINTER) + { + if(expr -> result -> base != pref -> base) + { + if(expr -> result -> base -> class != OBERON_TYPE_VOID) + { + oberon_error(ctx, "incompatible pointer types"); + } + } + } // TODO cast @@ -698,7 +731,7 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) oberon_error(ctx, "expected mode CALL"); } - if(desig -> item.var -> class != OBERON_CLASS_PROC) + if(desig -> item.var -> type -> class != OBERON_TYPE_PROCEDURE) { oberon_error(ctx, "only procedures can be called"); } @@ -720,12 +753,132 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig) oberon_object_t * param = fn -> decl; for(int i = 0; i < num_args; i++) { + if(param -> class == OBERON_CLASS_VAR_PARAM) + { + if(arg -> is_item) + { + switch(arg -> item.mode) + { + case MODE_VAR: + case MODE_INDEX: + case MODE_FIELD: + // Допустимо разыменование? + //case MODE_DEREF: + break; + default: + oberon_error(ctx, "var-parameter accept only variables"); + break; + } + } + } oberon_autocast_to(ctx, arg, param -> type); arg = arg -> next; param = param -> next; } } +static oberon_expr_t * +oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args) +{ + switch(proc -> class) + { + case OBERON_CLASS_PROC: + if(proc -> class != OBERON_CLASS_PROC) + { + oberon_error(ctx, "not a procedure"); + } + break; + case OBERON_CLASS_VAR: + case OBERON_CLASS_VAR_PARAM: + case OBERON_CLASS_PARAM: + if(proc -> type -> class != OBERON_TYPE_PROCEDURE) + { + oberon_error(ctx, "not a procedure"); + } + break; + default: + oberon_error(ctx, "not a procedure"); + break; + } + + oberon_expr_t * call; + + if(proc -> sysproc) + { + if(proc -> genfunc == NULL) + { + oberon_error(ctx, "not a function-procedure"); + } + + call = proc -> genfunc(ctx, num_args, list_args); + } + else + { + if(proc -> type -> base -> class == OBERON_TYPE_VOID) + { + oberon_error(ctx, "attempt to call procedure in expression"); + } + + call = oberon_new_item(MODE_CALL, proc -> type -> base); + call -> item.var = proc; + call -> item.num_args = num_args; + call -> item.args = list_args; + oberon_autocast_call(ctx, call); + } + + return call; +} + +static void +oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args) +{ + switch(proc -> class) + { + case OBERON_CLASS_PROC: + if(proc -> class != OBERON_CLASS_PROC) + { + oberon_error(ctx, "not a procedure"); + } + break; + case OBERON_CLASS_VAR: + case OBERON_CLASS_VAR_PARAM: + case OBERON_CLASS_PARAM: + if(proc -> type -> class != OBERON_TYPE_PROCEDURE) + { + oberon_error(ctx, "not a procedure"); + } + break; + default: + oberon_error(ctx, "not a procedure"); + break; + } + + if(proc -> sysproc) + { + if(proc -> genproc == NULL) + { + oberon_error(ctx, "requres non-typed procedure"); + } + + proc -> genproc(ctx, num_args, list_args); + } + else + { + if(proc -> type -> base -> class != OBERON_TYPE_VOID) + { + oberon_error(ctx, "attempt to call function as non-typed procedure"); + } + + oberon_expr_t * call; + call = oberon_new_item(MODE_CALL, proc -> type -> base); + call -> item.var = proc; + call -> item.num_args = num_args; + call -> item.args = list_args; + oberon_autocast_call(ctx, call); + oberon_generate_call_proc(ctx, call); + } +} + #define ISEXPR(x) \ (((x) == PLUS) \ || ((x) == MINUS) \ @@ -754,7 +907,7 @@ oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr) } static oberon_expr_t * -oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int num_indexes, oberon_expr_t * indexes) +oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon_expr_t * index) { if(desig -> result -> class == OBERON_TYPE_POINTER) { @@ -771,13 +924,30 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int nu oberon_type_t * base; base = desig -> result -> base; - // TODO check ranges + if(index -> result -> class != OBERON_TYPE_INTEGER) + { + oberon_error(ctx, "index must be integer"); + } + + // Статическая проверка границ массива + if(index -> is_item) + { + if(index -> item.mode == MODE_INTEGER) + { + int arr_size = desig -> result -> size; + int index_int = index -> item.integer; + if(index_int < 0 || index_int > arr_size - 1) + { + oberon_error(ctx, "not in range (dimension size 0..%i)", arr_size - 1); + } + } + } oberon_expr_t * selector; selector = oberon_new_item(MODE_INDEX, base); selector -> item.parent = (oberon_item_t *) desig; - selector -> item.num_args = num_indexes; - selector -> item.args = indexes; + selector -> item.num_args = 1; + selector -> item.args = index; return selector; } @@ -834,10 +1004,8 @@ oberon_designator(oberon_context_t * ctx) case OBERON_CLASS_VAR: case OBERON_CLASS_VAR_PARAM: case OBERON_CLASS_PARAM: - expr = oberon_new_item(MODE_VAR, var -> type); - break; case OBERON_CLASS_PROC: - expr = oberon_new_item(MODE_CALL, var -> type); + expr = oberon_new_item(MODE_VAR, var -> type); break; default: oberon_error(ctx, "invalid designator"); @@ -858,9 +1026,14 @@ oberon_designator(oberon_context_t * ctx) oberon_assert_token(ctx, LBRACE); int num_indexes = 0; oberon_expr_t * indexes = NULL; - oberon_expr_list(ctx, &num_indexes, &indexes); + oberon_expr_list(ctx, &num_indexes, &indexes, 0); oberon_assert_token(ctx, RBRACE); - expr = oberon_make_array_selector(ctx, expr, num_indexes, indexes); + + for(int i = 0; i < num_indexes; i++) + { + expr = oberon_make_array_selector(ctx, expr, indexes); + indexes = indexes -> next; + } break; case UPARROW: oberon_assert_token(ctx, UPARROW); @@ -875,17 +1048,13 @@ oberon_designator(oberon_context_t * ctx) } static oberon_expr_t * -oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr) +oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr) { assert(expr -> is_item == 1); + /* Если есть скобки - значит вызов. Если нет, то передаём указатель. */ if(ctx -> token == LPAREN) { - if(expr -> result -> class != OBERON_TYPE_PROCEDURE) - { - oberon_error(ctx, "not a procedure"); - } - oberon_assert_token(ctx, LPAREN); int num_args = 0; @@ -893,21 +1062,41 @@ oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr) if(ISEXPR(ctx -> token)) { - oberon_expr_list(ctx, &num_args, &arguments); + oberon_expr_list(ctx, &num_args, &arguments, 0); } - expr -> result = expr -> item.var -> type -> base; - expr -> item.mode = MODE_CALL; - expr -> item.num_args = num_args; - expr -> item.args = arguments; - oberon_assert_token(ctx, RPAREN); + expr = oberon_make_call_func(ctx, expr -> item.var, num_args, arguments); - oberon_autocast_call(ctx, expr); + oberon_assert_token(ctx, RPAREN); } return expr; } +static void +oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr) +{ + assert(expr -> is_item == 1); + + int num_args = 0; + oberon_expr_t * arguments = NULL; + + if(ctx -> token == LPAREN) + { + oberon_assert_token(ctx, LPAREN); + + if(ISEXPR(ctx -> token)) + { + oberon_expr_list(ctx, &num_args, &arguments, 0); + } + + oberon_assert_token(ctx, RPAREN); + } + + /* Вызов происходит даже без скобок */ + oberon_make_call_proc(ctx, expr -> item.var, num_args, arguments); +} + static oberon_expr_t * oberon_factor(oberon_context_t * ctx) { @@ -917,7 +1106,7 @@ oberon_factor(oberon_context_t * ctx) { case IDENT: expr = oberon_designator(ctx); - expr = oberon_opt_proc_parens(ctx, expr); + expr = oberon_opt_func_parens(ctx, expr); break; case INTEGER: expr = oberon_new_item(MODE_INTEGER, ctx -> int_type); @@ -1198,7 +1387,9 @@ oberon_const_expr(oberon_context_t * ctx) // PARSER // ======================================================================= +static void oberon_decl_seq(oberon_context_t * ctx); static void oberon_statement_seq(oberon_context_t * ctx); +static void oberon_initialize_decl(oberon_context_t * ctx); static void oberon_expect_token(oberon_context_t * ctx, int token) @@ -1307,6 +1498,7 @@ oberon_formal_pars(oberon_context_t * ctx, oberon_type_t * signature) if(ctx -> token == COLON) { oberon_assert_token(ctx, COLON); + // TODO get by qualident oberon_type(ctx, &signature -> base); } } @@ -1327,10 +1519,41 @@ oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type) } } +static void +oberon_compare_signatures(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b) +{ + if(a -> num_decl != b -> num_decl) + { + oberon_error(ctx, "number parameters not matched"); + } + + int num_param = a -> num_decl; + oberon_object_t * param_a = a -> decl; + oberon_object_t * param_b = b -> decl; + for(int i = 0; i < num_param; i++) + { + if(strcmp(param_a -> name, param_b -> name) != 0) + { + oberon_error(ctx, "param %i name not matched", i + 1); + } + + if(param_a -> type != param_b -> type) + { + oberon_error(ctx, "param %i type not matched", i + 1); + } + + param_a = param_a -> next; + param_b = param_b -> next; + } +} + static void oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr) { - if(ctx -> result_type -> class == OBERON_TYPE_VOID) + oberon_object_t * proc = ctx -> decl -> parent; + oberon_type_t * result_type = proc -> type -> base; + + if(result_type -> class == OBERON_TYPE_VOID) { if(expr != NULL) { @@ -1344,41 +1567,25 @@ oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr) oberon_error(ctx, "procedure requires expression on result"); } - oberon_autocast_to(ctx, expr, ctx -> result_type); + oberon_autocast_to(ctx, expr, result_type); } - ctx -> has_return = 1; + proc -> has_return = 1; oberon_generate_return(ctx, expr); } static void -oberon_proc_decl(oberon_context_t * ctx) +oberon_proc_decl_body(oberon_context_t * ctx, oberon_object_t * proc) { - oberon_assert_token(ctx, PROCEDURE); - - char * name; - name = oberon_assert_ident(ctx); - - oberon_scope_t * this_proc_def_scope = ctx -> decl; - oberon_open_scope(ctx); - - oberon_type_t * signature; - signature = oberon_new_type_ptr(OBERON_TYPE_VOID); - oberon_opt_formal_pars(ctx, &signature); - - oberon_object_t * proc; - proc = oberon_define_proc(this_proc_def_scope, name, signature); + oberon_assert_token(ctx, SEMICOLON); - ctx -> result_type = signature -> base; - ctx -> has_return = 0; + ctx -> decl = proc -> scope; - oberon_assert_token(ctx, SEMICOLON); + oberon_decl_seq(ctx); oberon_generate_begin_proc(ctx, proc); - // TODO declarations - if(ctx -> token == BEGIN) { oberon_assert_token(ctx, BEGIN); @@ -1386,27 +1593,90 @@ oberon_proc_decl(oberon_context_t * ctx) } oberon_assert_token(ctx, END); - char * name2 = oberon_assert_ident(ctx); - if(strcmp(name2, name) != 0) + char * name = oberon_assert_ident(ctx); + if(strcmp(name, proc -> name) != 0) { oberon_error(ctx, "procedure name not matched"); } - if(signature -> base -> class == OBERON_TYPE_VOID) + if(proc -> type -> base -> class == OBERON_TYPE_VOID + && proc -> has_return == 0) { oberon_make_return(ctx, NULL); } - if(ctx -> has_return == 0) + if(proc -> has_return == 0) { oberon_error(ctx, "procedure requires return"); } - ctx -> result_type = NULL; oberon_generate_end_proc(ctx); oberon_close_scope(ctx -> decl); } +static void +oberon_proc_decl(oberon_context_t * ctx) +{ + oberon_assert_token(ctx, PROCEDURE); + + int forward = 0; + if(ctx -> token == UPARROW) + { + oberon_assert_token(ctx, UPARROW); + forward = 1; + } + + char * name; + name = oberon_assert_ident(ctx); + + oberon_scope_t * proc_scope; + proc_scope = oberon_open_scope(ctx); + ctx -> decl -> local = 1; + + oberon_type_t * signature; + signature = oberon_new_type_ptr(OBERON_TYPE_VOID); + oberon_opt_formal_pars(ctx, &signature); + + oberon_initialize_decl(ctx); + oberon_generator_init_type(ctx, signature); + oberon_close_scope(ctx -> decl); + + oberon_object_t * proc; + proc = oberon_find_object(ctx -> decl, name, 0); + if(proc != NULL) + { + if(proc -> class != OBERON_CLASS_PROC) + { + oberon_error(ctx, "mult definition"); + } + + if(forward == 0) + { + if(proc -> linked) + { + oberon_error(ctx, "mult procedure definition"); + } + } + + oberon_compare_signatures(ctx, proc -> type, signature); + } + else + { + proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC); + proc -> type = signature; + proc -> scope = proc_scope; + oberon_generator_init_proc(ctx, proc); + } + + proc -> scope -> parent = proc; + + if(forward == 0) + { + proc -> linked = 1; + oberon_proc_decl_body(ctx, proc); + } +} + static void oberon_const_decl(oberon_context_t * ctx) { @@ -1423,9 +1693,14 @@ oberon_const_decl(oberon_context_t * ctx) } static void -oberon_make_array_type(oberon_context_t * ctx, oberon_item_t * size, oberon_type_t * base, oberon_type_t ** type) +oberon_make_array_type(oberon_context_t * ctx, oberon_expr_t * size, oberon_type_t * base, oberon_type_t ** type) { - if(size -> mode != MODE_INTEGER) + if(size -> is_item == 0) + { + oberon_error(ctx, "requires constant"); + } + + if(size -> item.mode != MODE_INTEGER) { oberon_error(ctx, "requires integer constant"); } @@ -1433,7 +1708,7 @@ oberon_make_array_type(oberon_context_t * ctx, oberon_item_t * size, oberon_type oberon_type_t * arr; arr = *type; arr -> class = OBERON_TYPE_ARRAY; - arr -> size = size -> integer; + arr -> size = size -> item.integer; arr -> base = base; } @@ -1484,6 +1759,23 @@ static void oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type * Правило граматики "type". Указатель type должен указывать на существующий объект! */ +static void +oberon_make_multiarray(oberon_context_t * ctx, oberon_expr_t * sizes, oberon_type_t * base, oberon_type_t ** type) +{ + if(sizes == NULL) + { + *type = base; + return; + } + + oberon_type_t * dim; + dim = oberon_new_type_ptr(OBERON_TYPE_VOID); + + oberon_make_multiarray(ctx, sizes -> next, base, &dim); + + oberon_make_array_type(ctx, sizes, dim, type); +} + static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type) { @@ -1495,8 +1787,9 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type) { oberon_assert_token(ctx, ARRAY); - oberon_item_t * size; - size = oberon_const_expr(ctx); + int num_sizes = 0; + oberon_expr_t * sizes; + oberon_expr_list(ctx, &num_sizes, &sizes, 1); oberon_assert_token(ctx, OF); @@ -1504,7 +1797,7 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type) base = oberon_new_type_ptr(OBERON_TYPE_VOID); oberon_type(ctx, &base); - oberon_make_array_type(ctx, size, base, type); + oberon_make_multiarray(ctx, sizes, base, type); } else if(ctx -> token == RECORD) { @@ -1831,7 +2124,13 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type) static void oberon_initialize_object(oberon_context_t * ctx, oberon_object_t * x) { - printf("oberon_initialize_object: name %s class %i\n", x -> name, x -> class); + if(x -> initialized) + { + return; + } + + x -> initialized = 1; + switch(x -> class) { case OBERON_CLASS_TYPE: @@ -1865,6 +2164,24 @@ oberon_initialize_decl(oberon_context_t * ctx) } } +static void +oberon_prevent_undeclarated_procedures(oberon_context_t * ctx) +{ + oberon_object_t * x = ctx -> decl -> list; + + while(x -> next) + { + if(x -> next -> class == OBERON_CLASS_PROC) + { + if(x -> next -> linked == 0) + { + oberon_error(ctx, "unresolved forward declaration"); + } + } + x = x -> next; + } +} + static void oberon_decl_seq(oberon_context_t * ctx) { @@ -1906,6 +2223,8 @@ oberon_decl_seq(oberon_context_t * ctx) oberon_proc_decl(ctx); oberon_assert_token(ctx, SEMICOLON); } + + oberon_prevent_undeclarated_procedures(ctx); } static void @@ -1915,13 +2234,6 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst) oberon_generate_assign(ctx, src, dst); } -static void -oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig) -{ - oberon_autocast_call(ctx, desig); - oberon_generate_call_proc(ctx, desig); -} - static void oberon_statement(oberon_context_t * ctx) { @@ -1939,8 +2251,7 @@ oberon_statement(oberon_context_t * ctx) } else { - item1 = oberon_opt_proc_parens(ctx, item1); - oberon_make_call(ctx, item1); + oberon_opt_proc_parens(ctx, item1); } } else if(ctx -> token == RETURN) @@ -2022,6 +2333,58 @@ register_default_types(oberon_context_t * ctx) oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type); } +static void +oberon_new_intrinsic_function(oberon_context_t * ctx, char * name, GenerateFuncCallback generate) +{ + oberon_object_t * proc; + proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC); + proc -> sysproc = 1; + proc -> genfunc = generate; + proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE); +} + +/* +static void +oberon_new_intrinsic_procedure(oberon_context_t * ctx, char * name, GenerateProcCallback generate) +{ + oberon_object_t * proc; + proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC); + proc -> sysproc = 1; + proc -> genproc = generate; + proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE); +} +*/ + +static oberon_expr_t * +oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args) +{ + if(num_args < 1) + { + oberon_error(ctx, "too few arguments"); + } + + if(num_args > 1) + { + oberon_error(ctx, "too mach arguments"); + } + + oberon_expr_t * arg; + arg = list_args; + + oberon_type_t * result_type; + result_type = arg -> result; + + if(result_type -> class != OBERON_TYPE_INTEGER) + { + oberon_error(ctx, "ABS accepts only integers"); + } + + + oberon_expr_t * expr; + expr = oberon_new_operator(OP_ABS, result_type, arg, NULL); + return expr; +} + oberon_context_t * oberon_create_context() { @@ -2034,7 +2397,8 @@ oberon_create_context() oberon_generator_init_context(ctx); - register_default_types(ctx); + register_default_types(ctx); + oberon_new_intrinsic_function(ctx, "ABS", oberon_make_abs_call); return ctx; }