f4a711f5da3156912e43afb4bc8887dd076936a3
56 // =======================================================================
58 // =======================================================================
61 oberon_error(oberon_context_t
* ctx
, const char * fmt
, ...)
65 fprintf(stderr
, "error: ");
66 vfprintf(stderr
, fmt
, ptr
);
67 fprintf(stderr
, "\n");
68 fprintf(stderr
, " code_index = %i\n", ctx
-> code_index
);
69 fprintf(stderr
, " c = %c\n", ctx
-> c
);
70 fprintf(stderr
, " token = %i\n", ctx
-> token
);
75 static oberon_type_t
*
76 oberon_new_type_ptr(int class)
78 oberon_type_t
* x
= malloc(sizeof *x
);
79 memset(x
, 0, sizeof *x
);
84 static oberon_type_t
*
85 oberon_new_type_integer(int size
)
88 x
= oberon_new_type_ptr(OBERON_TYPE_INTEGER
);
93 static oberon_type_t
*
94 oberon_new_type_boolean(int size
)
97 x
= oberon_new_type_ptr(OBERON_TYPE_BOOLEAN
);
102 // =======================================================================
104 // =======================================================================
106 static oberon_scope_t
*
107 oberon_open_scope(oberon_context_t
* ctx
)
109 oberon_scope_t
* scope
= malloc(sizeof *scope
);
110 memset(scope
, 0, sizeof *scope
);
112 oberon_object_t
* list
= malloc(sizeof *list
);
113 memset(list
, 0, sizeof *list
);
116 scope
-> list
= list
;
117 scope
-> up
= ctx
-> decl
;
124 oberon_close_scope(oberon_scope_t
* scope
)
126 oberon_context_t
* ctx
= scope
-> ctx
;
127 ctx
-> decl
= scope
-> up
;
130 static oberon_object_t
*
131 oberon_define_object(oberon_scope_t
* scope
, char * name
, int class)
133 oberon_object_t
* x
= scope
-> list
;
134 while(x
-> next
&& strcmp(x
-> next
-> name
, name
) != 0)
141 oberon_error(scope
-> ctx
, "already defined");
144 oberon_object_t
* newvar
= malloc(sizeof *newvar
);
145 memset(newvar
, 0, sizeof *newvar
);
146 newvar
-> name
= name
;
147 newvar
-> class = class;
155 oberon_define_field(oberon_context_t
* ctx
, oberon_type_t
* rec
, char * name
, oberon_type_t
* type
)
157 oberon_object_t
* x
= rec
-> decl
;
158 while(x
-> next
&& strcmp(x
-> next
-> name
, name
) != 0)
165 oberon_error(ctx
, "multiple definition");
168 oberon_object_t
* field
= malloc(sizeof *field
);
169 memset(field
, 0, sizeof *field
);
170 field
-> name
= name
;
171 field
-> class = OBERON_CLASS_FIELD
;
172 field
-> type
= type
;
174 rec
-> num_decl
+= 1;
178 static oberon_object_t
*
179 oberon_find_object_in_list(oberon_object_t
* list
, char * name
)
181 oberon_object_t
* x
= list
;
182 while(x
-> next
&& strcmp(x
-> next
-> name
, name
) != 0)
189 static oberon_object_t
*
190 oberon_find_object(oberon_scope_t
* scope
, char * name
, int check_it
)
192 oberon_object_t
* result
= NULL
;
194 oberon_scope_t
* s
= scope
;
195 while(result
== NULL
&& s
!= NULL
)
197 result
= oberon_find_object_in_list(s
-> list
, name
);
201 if(check_it
&& result
== NULL
)
203 oberon_error(scope
-> ctx
, "undefined ident %s", name
);
209 static oberon_object_t
*
210 oberon_find_field(oberon_context_t
* ctx
, oberon_type_t
* rec
, char * name
)
212 oberon_object_t
* x
= rec
-> decl
;
213 for(int i
= 0; i
< rec
-> num_decl
; i
++)
215 if(strcmp(x
-> name
, name
) == 0)
222 oberon_error(ctx
, "field not defined");
227 static oberon_object_t
*
228 oberon_define_type(oberon_scope_t
* scope
, char * name
, oberon_type_t
* type
)
230 oberon_object_t
* id
;
231 id
= oberon_define_object(scope
, name
, OBERON_CLASS_TYPE
);
233 oberon_generator_init_type(scope
-> ctx
, type
);
238 static oberon_type_t *
239 oberon_find_type(oberon_scope_t * scope, char * name)
241 oberon_object_t * x = oberon_find_object(scope, name);
242 if(x -> class != OBERON_CLASS_TYPE)
244 oberon_error(scope -> ctx, "%s not a type", name);
251 static oberon_object_t
*
252 oberon_define_var(oberon_scope_t
* scope
, int class, char * name
, oberon_type_t
* type
)
254 oberon_object_t
* var
;
255 var
= oberon_define_object(scope
, name
, class);
261 static oberon_object_t *
262 oberon_find_var(oberon_scope_t * scope, char * name)
264 oberon_object_t * x = oberon_find_object(scope, name);
266 if(x -> class != OBERON_CLASS_VAR)
268 oberon_error(scope -> ctx, "%s not a var", name);
275 static oberon_object_t
*
276 oberon_define_proc(oberon_scope_t
* scope
, char * name
, oberon_type_t
* signature
)
278 oberon_object_t
* proc
;
279 proc
= oberon_define_object(scope
, name
, OBERON_CLASS_PROC
);
280 proc
-> type
= signature
;
284 // =======================================================================
286 // =======================================================================
289 oberon_get_char(oberon_context_t
* ctx
)
291 ctx
-> code_index
+= 1;
292 ctx
-> c
= ctx
-> code
[ctx
-> code_index
];
296 oberon_init_scaner(oberon_context_t
* ctx
, const char * code
)
299 ctx
-> code_index
= 0;
300 ctx
-> c
= ctx
-> code
[ctx
-> code_index
];
304 oberon_read_ident(oberon_context_t
* ctx
)
307 int i
= ctx
-> code_index
;
309 int c
= ctx
-> code
[i
];
317 char * ident
= malloc(len
+ 1);
318 memcpy(ident
, &ctx
->code
[ctx
->code_index
], len
);
321 ctx
-> code_index
= i
;
322 ctx
-> c
= ctx
-> code
[i
];
323 ctx
-> string
= ident
;
324 ctx
-> token
= IDENT
;
326 if(strcmp(ident
, "MODULE") == 0)
328 ctx
-> token
= MODULE
;
330 else if(strcmp(ident
, "END") == 0)
334 else if(strcmp(ident
, "VAR") == 0)
338 else if(strcmp(ident
, "BEGIN") == 0)
340 ctx
-> token
= BEGIN
;
342 else if(strcmp(ident
, "TRUE") == 0)
346 else if(strcmp(ident
, "FALSE") == 0)
348 ctx
-> token
= FALSE
;
350 else if(strcmp(ident
, "OR") == 0)
354 else if(strcmp(ident
, "DIV") == 0)
358 else if(strcmp(ident
, "MOD") == 0)
362 else if(strcmp(ident
, "PROCEDURE") == 0)
364 ctx
-> token
= PROCEDURE
;
366 else if(strcmp(ident
, "RETURN") == 0)
368 ctx
-> token
= RETURN
;
370 else if(strcmp(ident
, "CONST") == 0)
372 ctx
-> token
= CONST
;
374 else if(strcmp(ident
, "TYPE") == 0)
378 else if(strcmp(ident
, "ARRAY") == 0)
380 ctx
-> token
= ARRAY
;
382 else if(strcmp(ident
, "OF") == 0)
386 else if(strcmp(ident
, "RECORD") == 0)
388 ctx
-> token
= RECORD
;
390 else if(strcmp(ident
, "POINTER") == 0)
392 ctx
-> token
= POINTER
;
394 else if(strcmp(ident
, "TO") == 0)
401 oberon_read_integer(oberon_context_t
* ctx
)
404 int i
= ctx
-> code_index
;
406 int c
= ctx
-> code
[i
];
414 char * ident
= malloc(len
+ 2);
415 memcpy(ident
, &ctx
->code
[ctx
->code_index
], len
);
418 ctx
-> code_index
= i
;
419 ctx
-> c
= ctx
-> code
[i
];
420 ctx
-> string
= ident
;
421 ctx
-> integer
= atoi(ident
);
422 ctx
-> token
= INTEGER
;
426 oberon_skip_space(oberon_context_t
* ctx
)
428 while(isspace(ctx
-> c
))
430 oberon_get_char(ctx
);
435 oberon_read_symbol(oberon_context_t
* ctx
)
444 ctx
-> token
= SEMICOLON
;
445 oberon_get_char(ctx
);
448 ctx
-> token
= COLON
;
449 oberon_get_char(ctx
);
452 ctx
-> token
= ASSIGN
;
453 oberon_get_char(ctx
);
458 oberon_get_char(ctx
);
461 ctx
-> token
= LPAREN
;
462 oberon_get_char(ctx
);
465 ctx
-> token
= RPAREN
;
466 oberon_get_char(ctx
);
469 ctx
-> token
= EQUAL
;
470 oberon_get_char(ctx
);
474 oberon_get_char(ctx
);
478 oberon_get_char(ctx
);
482 oberon_get_char(ctx
);
486 ctx
-> token
= GREAT
;
487 oberon_get_char(ctx
);
491 oberon_get_char(ctx
);
496 oberon_get_char(ctx
);
499 ctx
-> token
= MINUS
;
500 oberon_get_char(ctx
);
504 oberon_get_char(ctx
);
507 ctx
-> token
= SLASH
;
508 oberon_get_char(ctx
);
512 oberon_get_char(ctx
);
516 oberon_get_char(ctx
);
519 ctx
-> token
= COMMA
;
520 oberon_get_char(ctx
);
523 ctx
-> token
= LBRACE
;
524 oberon_get_char(ctx
);
527 ctx
-> token
= RBRACE
;
528 oberon_get_char(ctx
);
531 oberon_error(ctx
, "invalid char");
537 oberon_read_token(oberon_context_t
* ctx
)
539 oberon_skip_space(ctx
);
544 oberon_read_ident(ctx
);
548 oberon_read_integer(ctx
);
552 oberon_read_symbol(ctx
);
556 // =======================================================================
558 // =======================================================================
560 static void oberon_expect_token(oberon_context_t
* ctx
, int token
);
561 static oberon_expr_t
* oberon_expr(oberon_context_t
* ctx
);
562 static void oberon_assert_token(oberon_context_t
* ctx
, int token
);
563 static char * oberon_assert_ident(oberon_context_t
* ctx
);
564 static void oberon_type(oberon_context_t
* ctx
, oberon_type_t
** type
);
566 static oberon_expr_t
*
567 oberon_new_operator(int op
, oberon_type_t
* result
, oberon_expr_t
* left
, oberon_expr_t
* right
)
569 oberon_oper_t
* operator;
570 operator = malloc(sizeof *operator);
571 memset(operator, 0, sizeof *operator);
573 operator -> is_item
= 0;
574 operator -> result
= result
;
576 operator -> left
= left
;
577 operator -> right
= right
;
579 return (oberon_expr_t
*) operator;
582 static oberon_expr_t
*
583 oberon_new_item(int mode
, oberon_type_t
* result
)
585 oberon_item_t
* item
;
586 item
= malloc(sizeof *item
);
587 memset(item
, 0, sizeof *item
);
590 item
-> result
= result
;
593 return (oberon_expr_t
*)item
;
596 static oberon_expr_t
*
597 oberon_make_unary_op(oberon_context_t
* ctx
, int token
, oberon_expr_t
* a
)
599 oberon_expr_t
* expr
;
600 oberon_type_t
* result
;
602 result
= a
-> result
;
606 if(result
-> class != OBERON_TYPE_INTEGER
)
608 oberon_error(ctx
, "incompatible operator type");
611 expr
= oberon_new_operator(OP_UNARY_MINUS
, result
, a
, NULL
);
613 else if(token
== NOT
)
615 if(result
-> class != OBERON_TYPE_BOOLEAN
)
617 oberon_error(ctx
, "incompatible operator type");
620 expr
= oberon_new_operator(OP_LOGIC_NOT
, result
, a
, NULL
);
624 oberon_error(ctx
, "oberon_make_unary_op: wat");
631 oberon_expr_list(oberon_context_t
* ctx
, int * num_expr
, oberon_expr_t
** first
)
633 oberon_expr_t
* last
;
636 *first
= last
= oberon_expr(ctx
);
637 while(ctx
-> token
== COMMA
)
639 oberon_assert_token(ctx
, COMMA
);
640 oberon_expr_t
* current
;
641 current
= oberon_expr(ctx
);
642 last
-> next
= current
;
648 static oberon_expr_t
*
649 oberon_autocast_to(oberon_context_t
* ctx
, oberon_expr_t
* expr
, oberon_type_t
* pref
)
651 if(pref
-> class != expr
-> result
-> class)
653 oberon_error(ctx
, "incompatible types");
657 if(pref
-> class == OBERON_TYPE_INTEGER
)
659 if(expr
-> result
-> class > pref
-> class)
661 oberon_error(ctx
, "incompatible size");
664 else if(pref
-> class == OBERON_TYPE_RECORD
)
666 if(expr
-> result
!= pref
)
668 printf("oberon_autocast_to: rec %p != %p\n", expr
-> result
, pref
);
669 oberon_error(ctx
, "incompatible record types");
679 oberon_autocast_call(oberon_context_t
* ctx
, oberon_expr_t
* desig
)
681 if(desig
-> is_item
== 0)
683 oberon_error(ctx
, "expected item");
686 if(desig
-> item
.mode
!= MODE_CALL
)
688 oberon_error(ctx
, "expected mode CALL");
691 if(desig
-> item
.var
-> class != OBERON_CLASS_PROC
)
693 oberon_error(ctx
, "only procedures can be called");
696 oberon_type_t
* fn
= desig
-> item
.var
-> type
;
697 int num_args
= desig
-> item
.num_args
;
698 int num_decl
= fn
-> num_decl
;
700 if(num_args
< num_decl
)
702 oberon_error(ctx
, "too few arguments");
704 else if(num_args
> num_decl
)
706 oberon_error(ctx
, "too many arguments");
709 oberon_expr_t
* arg
= desig
-> item
.args
;
710 oberon_object_t
* param
= fn
-> decl
;
711 for(int i
= 0; i
< num_args
; i
++)
713 oberon_autocast_to(ctx
, arg
, param
-> type
);
715 param
= param
-> next
;
723 || ((x) == INTEGER) \
729 #define ISSELECTOR(x) \
733 static oberon_expr_t
*
734 oberon_make_array_selector(oberon_context_t
* ctx
, oberon_expr_t
* desig
, int num_indexes
, oberon_expr_t
* indexes
)
736 assert(desig
-> is_item
== 1);
738 if(desig
-> item
.mode
!= MODE_VAR
)
740 oberon_error(ctx
, "not MODE_VAR");
743 int class = desig
-> item
.var
-> class;
746 case OBERON_CLASS_VAR
:
747 case OBERON_CLASS_VAR_PARAM
:
748 case OBERON_CLASS_PARAM
:
751 oberon_error(ctx
, "not variable");
755 oberon_type_t
* type
= desig
-> item
.var
-> type
;
756 if(type
-> class != OBERON_TYPE_ARRAY
)
758 oberon_error(ctx
, "not array");
761 // int dim = desig -> item.var -> type -> dim;
762 // if(num_indexes != dim)
764 // oberon_error(ctx, "dimesions not matched");
767 oberon_type_t
* base
= desig
-> item
.var
-> type
-> base
;
769 oberon_expr_t
* selector
;
770 selector
= oberon_new_item(MODE_INDEX
, base
);
771 selector
-> item
.parent
= (oberon_item_t
*) desig
;
772 selector
-> item
.num_args
= num_indexes
;
773 selector
-> item
.args
= indexes
;
778 static oberon_expr_t
*
779 oberon_make_record_selector(oberon_context_t
* ctx
, oberon_expr_t
* expr
, char * name
)
781 assert(expr
-> is_item
== 1);
783 int class = expr
-> result
-> class;
784 if(class != OBERON_TYPE_RECORD
)
786 oberon_error(ctx
, "not record");
789 oberon_type_t
* rec
= expr
-> result
;
791 oberon_object_t
* field
;
792 field
= oberon_find_field(ctx
, rec
, name
);
794 oberon_expr_t
* selector
;
795 selector
= oberon_new_item(MODE_FIELD
, field
-> type
);
796 selector
-> item
.var
= field
;
797 selector
-> item
.parent
= (oberon_item_t
*) expr
;
802 static oberon_expr_t
*
803 oberon_designator(oberon_context_t
* ctx
)
806 oberon_object_t
* var
;
807 oberon_expr_t
* expr
;
809 name
= oberon_assert_ident(ctx
);
810 var
= oberon_find_object(ctx
-> decl
, name
, 1);
814 case OBERON_CLASS_CONST
:
816 expr
= (oberon_expr_t
*) var
-> value
;
818 case OBERON_CLASS_VAR
:
819 case OBERON_CLASS_VAR_PARAM
:
820 case OBERON_CLASS_PARAM
:
821 expr
= oberon_new_item(MODE_VAR
, var
-> type
);
823 case OBERON_CLASS_PROC
:
824 expr
= oberon_new_item(MODE_CALL
, var
-> type
);
827 oberon_error(ctx
, "invalid designator");
830 expr
-> item
.var
= var
;
832 while(ISSELECTOR(ctx
-> token
))
837 oberon_assert_token(ctx
, DOT
);
838 name
= oberon_assert_ident(ctx
);
839 expr
= oberon_make_record_selector(ctx
, expr
, name
);
842 oberon_assert_token(ctx
, LBRACE
);
844 oberon_expr_t
* indexes
= NULL
;
845 oberon_expr_list(ctx
, &num_indexes
, &indexes
);
846 oberon_assert_token(ctx
, RBRACE
);
847 expr
= oberon_make_array_selector(ctx
, expr
, num_indexes
, indexes
);
850 oberon_error(ctx
, "oberon_designator: wat");
857 static oberon_expr_t
*
858 oberon_opt_proc_parens(oberon_context_t
* ctx
, oberon_expr_t
* expr
)
860 assert(expr
-> is_item
== 1);
862 if(ctx
-> token
== LPAREN
)
864 if(expr
-> result
-> class != OBERON_TYPE_PROCEDURE
)
866 oberon_error(ctx
, "not a procedure");
869 oberon_assert_token(ctx
, LPAREN
);
872 oberon_expr_t
* arguments
= NULL
;
874 if(ISEXPR(ctx
-> token
))
876 oberon_expr_list(ctx
, &num_args
, &arguments
);
879 expr
-> result
= expr
-> item
.var
-> type
-> base
;
880 expr
-> item
.mode
= MODE_CALL
;
881 expr
-> item
.num_args
= num_args
;
882 expr
-> item
.args
= arguments
;
883 oberon_assert_token(ctx
, RPAREN
);
885 oberon_autocast_call(ctx
, expr
);
891 static oberon_expr_t
*
892 oberon_factor(oberon_context_t
* ctx
)
894 oberon_expr_t
* expr
;
899 expr
= oberon_designator(ctx
);
900 expr
= oberon_opt_proc_parens(ctx
, expr
);
903 expr
= oberon_new_item(MODE_INTEGER
, ctx
-> int_type
);
904 expr
-> item
.integer
= ctx
-> integer
;
905 oberon_assert_token(ctx
, INTEGER
);
908 expr
= oberon_new_item(MODE_BOOLEAN
, ctx
-> bool_type
);
909 expr
-> item
.boolean
= 1;
910 oberon_assert_token(ctx
, TRUE
);
913 expr
= oberon_new_item(MODE_BOOLEAN
, ctx
-> bool_type
);
914 expr
-> item
.boolean
= 0;
915 oberon_assert_token(ctx
, FALSE
);
918 oberon_assert_token(ctx
, LPAREN
);
919 expr
= oberon_expr(ctx
);
920 oberon_assert_token(ctx
, RPAREN
);
923 oberon_assert_token(ctx
, NOT
);
924 expr
= oberon_factor(ctx
);
925 expr
= oberon_make_unary_op(ctx
, NOT
, expr
);
928 oberon_error(ctx
, "invalid expression");
935 * oberon_autocast_binary_op автоматически переобразовывеат тип по след. правилам:
936 * 1. Классы обоих типов должны быть одинаковы
937 * 2. В качестве результата должен быть выбран больший тип.
938 * 3. Если размер результат не должен быть меньше чем базовый int
942 oberon_autocast_binary_op(oberon_context_t
* ctx
, oberon_type_t
* a
, oberon_type_t
* b
, oberon_type_t
** result
)
944 if((a
-> class) != (b
-> class))
946 oberon_error(ctx
, "incompatible types");
949 if((a
-> size
) > (b
-> size
))
958 if(((*result
) -> class) == OBERON_TYPE_INTEGER
)
960 if(((*result
) -> size
) < (ctx
-> int_type
-> size
))
962 *result
= ctx
-> int_type
;
966 /* TODO: cast types */
969 #define ITMAKESBOOLEAN(x) \
970 (((x) >= EQUAL && (x) <= GEQ) || ((x) == OR) || ((x) == AND))
972 #define ITUSEONLYINTEGER(x) \
973 ((x) >= LESS && (x) <= GEQ)
975 #define ITUSEONLYBOOLEAN(x) \
976 (((x) == OR) || ((x) == AND))
978 static oberon_expr_t
*
979 oberon_make_bin_op(oberon_context_t
* ctx
, int token
, oberon_expr_t
* a
, oberon_expr_t
* b
)
981 oberon_expr_t
* expr
;
982 oberon_type_t
* result
;
984 if(ITMAKESBOOLEAN(token
))
986 if(ITUSEONLYINTEGER(token
))
988 if(a
-> result
-> class != OBERON_TYPE_INTEGER
989 || b
-> result
-> class != OBERON_TYPE_INTEGER
)
991 oberon_error(ctx
, "used only with integer types");
994 else if(ITUSEONLYBOOLEAN(token
))
996 if(a
-> result
-> class != OBERON_TYPE_BOOLEAN
997 || b
-> result
-> class != OBERON_TYPE_BOOLEAN
)
999 oberon_error(ctx
, "used only with boolean type");
1003 result
= ctx
-> bool_type
;
1007 expr
= oberon_new_operator(OP_EQ
, result
, a
, b
);
1009 else if(token
== NEQ
)
1011 expr
= oberon_new_operator(OP_NEQ
, result
, a
, b
);
1013 else if(token
== LESS
)
1015 expr
= oberon_new_operator(OP_LSS
, result
, a
, b
);
1017 else if(token
== LEQ
)
1019 expr
= oberon_new_operator(OP_LEQ
, result
, a
, b
);
1021 else if(token
== GREAT
)
1023 expr
= oberon_new_operator(OP_GRT
, result
, a
, b
);
1025 else if(token
== GEQ
)
1027 expr
= oberon_new_operator(OP_GEQ
, result
, a
, b
);
1029 else if(token
== OR
)
1031 expr
= oberon_new_operator(OP_LOGIC_OR
, result
, a
, b
);
1033 else if(token
== AND
)
1035 expr
= oberon_new_operator(OP_LOGIC_AND
, result
, a
, b
);
1039 oberon_error(ctx
, "oberon_make_bin_op: bool wat");
1044 oberon_autocast_binary_op(ctx
, a
-> result
, b
-> result
, &result
);
1048 expr
= oberon_new_operator(OP_ADD
, result
, a
, b
);
1050 else if(token
== MINUS
)
1052 expr
= oberon_new_operator(OP_SUB
, result
, a
, b
);
1054 else if(token
== STAR
)
1056 expr
= oberon_new_operator(OP_MUL
, result
, a
, b
);
1058 else if(token
== SLASH
)
1060 expr
= oberon_new_operator(OP_DIV
, result
, a
, b
);
1062 else if(token
== DIV
)
1064 expr
= oberon_new_operator(OP_DIV
, result
, a
, b
);
1066 else if(token
== MOD
)
1068 expr
= oberon_new_operator(OP_MOD
, result
, a
, b
);
1072 oberon_error(ctx
, "oberon_make_bin_op: bin wat");
1079 #define ISMULOP(x) \
1080 ((x) >= STAR && (x) <= AND)
1082 static oberon_expr_t
*
1083 oberon_term_expr(oberon_context_t
* ctx
)
1085 oberon_expr_t
* expr
;
1087 expr
= oberon_factor(ctx
);
1088 while(ISMULOP(ctx
-> token
))
1090 int token
= ctx
-> token
;
1091 oberon_read_token(ctx
);
1093 oberon_expr_t
* inter
= oberon_factor(ctx
);
1094 expr
= oberon_make_bin_op(ctx
, token
, expr
, inter
);
1100 #define ISADDOP(x) \
1101 ((x) >= PLUS && (x) <= OR)
1103 static oberon_expr_t
*
1104 oberon_simple_expr(oberon_context_t
* ctx
)
1106 oberon_expr_t
* expr
;
1109 if(ctx
-> token
== PLUS
)
1112 oberon_assert_token(ctx
, PLUS
);
1114 else if(ctx
-> token
== MINUS
)
1117 oberon_assert_token(ctx
, MINUS
);
1120 expr
= oberon_term_expr(ctx
);
1121 while(ISADDOP(ctx
-> token
))
1123 int token
= ctx
-> token
;
1124 oberon_read_token(ctx
);
1126 oberon_expr_t
* inter
= oberon_term_expr(ctx
);
1127 expr
= oberon_make_bin_op(ctx
, token
, expr
, inter
);
1132 expr
= oberon_make_unary_op(ctx
, MINUS
, expr
);
1138 #define ISRELATION(x) \
1139 ((x) >= EQUAL && (x) <= GEQ)
1141 static oberon_expr_t
*
1142 oberon_expr(oberon_context_t
* ctx
)
1144 oberon_expr_t
* expr
;
1146 expr
= oberon_simple_expr(ctx
);
1147 while(ISRELATION(ctx
-> token
))
1149 int token
= ctx
-> token
;
1150 oberon_read_token(ctx
);
1152 oberon_expr_t
* inter
= oberon_simple_expr(ctx
);
1153 expr
= oberon_make_bin_op(ctx
, token
, expr
, inter
);
1159 static oberon_item_t
*
1160 oberon_const_expr(oberon_context_t
* ctx
)
1162 oberon_expr_t
* expr
;
1163 expr
= oberon_expr(ctx
);
1165 if(expr
-> is_item
== 0)
1167 oberon_error(ctx
, "const expression are required");
1170 return (oberon_item_t
*) expr
;
1173 // =======================================================================
1175 // =======================================================================
1177 static void oberon_statement_seq(oberon_context_t
* ctx
);
1180 oberon_expect_token(oberon_context_t
* ctx
, int token
)
1182 if(ctx
-> token
!= token
)
1184 oberon_error(ctx
, "unexpected token %i (%i)", ctx
-> token
, token
);
1189 oberon_assert_token(oberon_context_t
* ctx
, int token
)
1191 oberon_expect_token(ctx
, token
);
1192 oberon_read_token(ctx
);
1196 oberon_assert_ident(oberon_context_t
* ctx
)
1198 oberon_expect_token(ctx
, IDENT
);
1199 char * ident
= ctx
-> string
;
1200 oberon_read_token(ctx
);
1205 oberon_var_decl(oberon_context_t
* ctx
)
1208 oberon_type_t
* type
;
1209 type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1211 name
= oberon_assert_ident(ctx
);
1212 oberon_assert_token(ctx
, COLON
);
1213 oberon_type(ctx
, &type
);
1214 oberon_define_var(ctx
-> decl
, OBERON_CLASS_VAR
, name
, type
);
1217 static oberon_object_t
*
1218 oberon_make_param(oberon_context_t
* ctx
, int token
, char * name
, oberon_type_t
* type
)
1220 oberon_object_t
* param
;
1224 param
= oberon_define_var(ctx
-> decl
, OBERON_CLASS_VAR_PARAM
, name
, type
);
1226 else if(token
== IDENT
)
1228 param
= oberon_define_var(ctx
-> decl
, OBERON_CLASS_PARAM
, name
, type
);
1232 oberon_error(ctx
, "oberon_make_param: wat");
1238 static oberon_object_t
*
1239 oberon_fp_section(oberon_context_t
* ctx
, int * num_decl
)
1241 int modifer_token
= ctx
-> token
;
1242 if(ctx
-> token
== VAR
)
1244 oberon_read_token(ctx
);
1248 name
= oberon_assert_ident(ctx
);
1250 oberon_assert_token(ctx
, COLON
);
1252 oberon_type_t
* type
;
1253 type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1254 oberon_type(ctx
, &type
);
1256 oberon_object_t
* first
;
1257 first
= oberon_make_param(ctx
, modifer_token
, name
, type
);
1263 #define ISFPSECTION \
1264 ((ctx -> token == VAR) || (ctx -> token == IDENT))
1267 oberon_formal_pars(oberon_context_t
* ctx
, oberon_type_t
* signature
)
1269 oberon_assert_token(ctx
, LPAREN
);
1273 signature
-> decl
= oberon_fp_section(ctx
, &signature
-> num_decl
);
1274 while(ctx
-> token
== SEMICOLON
)
1276 oberon_assert_token(ctx
, SEMICOLON
);
1277 oberon_fp_section(ctx
, &signature
-> num_decl
);
1281 oberon_assert_token(ctx
, RPAREN
);
1283 if(ctx
-> token
== COLON
)
1285 oberon_assert_token(ctx
, COLON
);
1286 oberon_type(ctx
, &signature
-> base
);
1291 oberon_opt_formal_pars(oberon_context_t
* ctx
, oberon_type_t
** type
)
1293 oberon_type_t
* signature
;
1295 signature
-> class = OBERON_TYPE_PROCEDURE
;
1296 signature
-> num_decl
= 0;
1297 signature
-> base
= ctx
-> void_type
;
1298 signature
-> decl
= NULL
;
1300 if(ctx
-> token
== LPAREN
)
1302 oberon_formal_pars(ctx
, signature
);
1307 oberon_make_return(oberon_context_t
* ctx
, oberon_expr_t
* expr
)
1309 if(ctx
-> result_type
-> class == OBERON_TYPE_VOID
)
1313 oberon_error(ctx
, "procedure has no result type");
1320 oberon_error(ctx
, "procedure requires expression on result");
1323 oberon_autocast_to(ctx
, expr
, ctx
-> result_type
);
1326 ctx
-> has_return
= 1;
1328 oberon_generate_return(ctx
, expr
);
1332 oberon_proc_decl(oberon_context_t
* ctx
)
1334 oberon_assert_token(ctx
, PROCEDURE
);
1337 name
= oberon_assert_ident(ctx
);
1339 oberon_scope_t
* this_proc_def_scope
= ctx
-> decl
;
1340 oberon_open_scope(ctx
);
1342 oberon_type_t
* signature
;
1343 signature
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1344 oberon_opt_formal_pars(ctx
, &signature
);
1346 oberon_object_t
* proc
;
1347 proc
= oberon_define_proc(this_proc_def_scope
, name
, signature
);
1349 ctx
-> result_type
= signature
-> base
;
1350 ctx
-> has_return
= 0;
1352 oberon_assert_token(ctx
, SEMICOLON
);
1354 oberon_generate_begin_proc(ctx
, proc
);
1356 // TODO declarations
1358 if(ctx
-> token
== BEGIN
)
1360 oberon_assert_token(ctx
, BEGIN
);
1361 oberon_statement_seq(ctx
);
1364 oberon_assert_token(ctx
, END
);
1365 char * name2
= oberon_assert_ident(ctx
);
1366 if(strcmp(name2
, name
) != 0)
1368 oberon_error(ctx
, "procedure name not matched");
1371 if(signature
-> base
-> class == OBERON_TYPE_VOID
)
1373 oberon_make_return(ctx
, NULL
);
1376 if(ctx
-> has_return
== 0)
1378 oberon_error(ctx
, "procedure requires return");
1380 ctx
-> result_type
= NULL
;
1382 oberon_generate_end_proc(ctx
);
1383 oberon_close_scope(ctx
-> decl
);
1387 oberon_const_decl(oberon_context_t
* ctx
)
1390 oberon_item_t
* value
;
1391 oberon_object_t
* constant
;
1393 name
= oberon_assert_ident(ctx
);
1394 oberon_assert_token(ctx
, EQUAL
);
1395 value
= oberon_const_expr(ctx
);
1397 constant
= oberon_define_object(ctx
-> decl
, name
, OBERON_CLASS_CONST
);
1398 constant
-> value
= value
;
1402 oberon_make_array_type(oberon_context_t
* ctx
, oberon_item_t
* size
, oberon_type_t
* base
, oberon_type_t
** type
)
1404 if(size
-> mode
!= MODE_INTEGER
)
1406 oberon_error(ctx
, "requires integer constant");
1409 oberon_type_t
* arr
;
1411 arr
-> class = OBERON_TYPE_ARRAY
;
1412 arr
-> size
= size
-> integer
;
1417 oberon_field_list(oberon_context_t
* ctx
, oberon_type_t
* rec
)
1419 if(ctx
-> token
== IDENT
)
1422 oberon_type_t
* type
;
1423 type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1425 name
= oberon_assert_ident(ctx
);
1426 oberon_assert_token(ctx
, COLON
);
1427 oberon_type(ctx
, &type
);
1428 oberon_define_field(ctx
, rec
, name
, type
);
1433 oberon_qualident_type(oberon_context_t
* ctx
, oberon_type_t
** type
)
1436 oberon_object_t
* to
;
1438 name
= oberon_assert_ident(ctx
);
1439 to
= oberon_find_object(ctx
-> decl
, name
, 0);
1443 if(to
-> class != OBERON_CLASS_TYPE
)
1445 oberon_error(ctx
, "not a type");
1450 to
= oberon_define_object(ctx
-> decl
, name
, OBERON_CLASS_TYPE
);
1451 to
-> type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1457 static void oberon_opt_formal_pars(oberon_context_t
* ctx
, oberon_type_t
** type
);
1460 * Правило граматики "type". Указатель type должен указывать на существующий объект!
1464 oberon_type(oberon_context_t
* ctx
, oberon_type_t
** type
)
1466 if(ctx
-> token
== IDENT
)
1468 oberon_qualident_type(ctx
, type
);
1470 else if(ctx
-> token
== ARRAY
)
1472 oberon_assert_token(ctx
, ARRAY
);
1474 oberon_item_t
* size
;
1475 size
= oberon_const_expr(ctx
);
1477 oberon_assert_token(ctx
, OF
);
1479 oberon_type_t
* base
;
1480 base
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1481 oberon_type(ctx
, &base
);
1483 oberon_make_array_type(ctx
, size
, base
, type
);
1485 else if(ctx
-> token
== RECORD
)
1487 oberon_type_t
* rec
;
1489 rec
-> class = OBERON_TYPE_RECORD
;
1490 oberon_object_t
* list
= malloc(sizeof *list
);
1491 memset(list
, 0, sizeof *list
);
1492 rec
-> num_decl
= 0;
1496 oberon_assert_token(ctx
, RECORD
);
1497 oberon_field_list(ctx
, rec
);
1498 while(ctx
-> token
== SEMICOLON
)
1500 oberon_assert_token(ctx
, SEMICOLON
);
1501 oberon_field_list(ctx
, rec
);
1503 oberon_assert_token(ctx
, END
);
1505 rec
-> decl
= rec
-> decl
-> next
;
1508 else if(ctx
-> token
== POINTER
)
1510 oberon_assert_token(ctx
, POINTER
);
1511 oberon_assert_token(ctx
, TO
);
1513 oberon_type_t
* base
;
1514 base
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1515 oberon_type(ctx
, &base
);
1517 oberon_type_t
* ptr
;
1519 ptr
-> class = OBERON_TYPE_POINTER
;
1522 else if(ctx
-> token
== PROCEDURE
)
1524 oberon_open_scope(ctx
);
1525 oberon_assert_token(ctx
, PROCEDURE
);
1526 oberon_opt_formal_pars(ctx
, type
);
1527 oberon_close_scope(ctx
-> decl
);
1531 oberon_error(ctx
, "invalid type declaration");
1536 oberon_type_decl(oberon_context_t
* ctx
)
1539 oberon_object_t
* newtype
;
1540 oberon_type_t
* type
;
1542 name
= oberon_assert_ident(ctx
);
1544 newtype
= oberon_find_object(ctx
-> decl
, name
, 0);
1547 newtype
= oberon_define_object(ctx
-> decl
, name
, OBERON_CLASS_TYPE
);
1548 newtype
-> type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1549 assert(newtype
-> type
);
1553 if(newtype
-> class != OBERON_CLASS_TYPE
)
1555 oberon_error(ctx
, "mult definition");
1558 if(newtype
-> linked
)
1560 oberon_error(ctx
, "mult definition - already linked");
1564 oberon_assert_token(ctx
, EQUAL
);
1566 type
= newtype
-> type
;
1567 oberon_type(ctx
, &type
);
1569 if(type
-> class == OBERON_TYPE_VOID
)
1571 oberon_error(ctx
, "recursive alias declaration");
1574 newtype
-> type
= type
;
1575 newtype
-> linked
= 1;
1578 static void oberon_prevent_recursive_object(oberon_context_t
* ctx
, oberon_object_t
* x
);
1579 static void oberon_prevent_recursive_type(oberon_context_t
* ctx
, oberon_type_t
* type
);
1582 oberon_prevent_recursive_pointer(oberon_context_t
* ctx
, oberon_type_t
* type
)
1584 if(type
-> class != OBERON_TYPE_POINTER
1585 && type
-> class != OBERON_TYPE_ARRAY
)
1590 if(type
-> recursive
)
1592 oberon_error(ctx
, "recursive pointer declaration");
1595 if(type
-> base
-> class == OBERON_TYPE_POINTER
)
1597 oberon_error(ctx
, "attempt to make pointer to pointer");
1600 type
-> recursive
= 1;
1602 oberon_prevent_recursive_pointer(ctx
, type
-> base
);
1604 type
-> recursive
= 0;
1608 oberon_prevent_recursive_record(oberon_context_t
* ctx
, oberon_type_t
* type
)
1610 if(type
-> class != OBERON_TYPE_RECORD
)
1615 if(type
-> recursive
)
1617 oberon_error(ctx
, "recursive record declaration");
1620 type
-> recursive
= 1;
1622 int num_fields
= type
-> num_decl
;
1623 oberon_object_t
* field
= type
-> decl
;
1624 for(int i
= 0; i
< num_fields
; i
++)
1626 oberon_prevent_recursive_object(ctx
, field
);
1627 field
= field
-> next
;
1630 type
-> recursive
= 0;
1633 oberon_prevent_recursive_procedure(oberon_context_t
* ctx
, oberon_type_t
* type
)
1635 if(type
-> class != OBERON_TYPE_PROCEDURE
)
1640 if(type
-> recursive
)
1642 oberon_error(ctx
, "recursive procedure declaration");
1645 type
-> recursive
= 1;
1647 int num_fields
= type
-> num_decl
;
1648 oberon_object_t
* field
= type
-> decl
;
1649 for(int i
= 0; i
< num_fields
; i
++)
1651 oberon_prevent_recursive_object(ctx
, field
);
1652 field
= field
-> next
;
1655 type
-> recursive
= 0;
1659 oberon_prevent_recursive_array(oberon_context_t
* ctx
, oberon_type_t
* type
)
1661 if(type
-> class != OBERON_TYPE_ARRAY
)
1666 if(type
-> recursive
)
1668 oberon_error(ctx
, "recursive array declaration");
1671 type
-> recursive
= 1;
1673 oberon_prevent_recursive_type(ctx
, type
-> base
);
1675 type
-> recursive
= 0;
1679 oberon_prevent_recursive_type(oberon_context_t
* ctx
, oberon_type_t
* type
)
1681 if(type
-> class == OBERON_TYPE_POINTER
)
1683 oberon_prevent_recursive_pointer(ctx
, type
);
1685 else if(type
-> class == OBERON_TYPE_RECORD
)
1687 oberon_prevent_recursive_record(ctx
, type
);
1689 else if(type
-> class == OBERON_TYPE_ARRAY
)
1691 oberon_prevent_recursive_array(ctx
, type
);
1693 else if(type
-> class == OBERON_TYPE_PROCEDURE
)
1695 oberon_prevent_recursive_procedure(ctx
, type
);
1700 oberon_prevent_recursive_object(oberon_context_t
* ctx
, oberon_object_t
* x
)
1704 case OBERON_CLASS_VAR
:
1705 case OBERON_CLASS_TYPE
:
1706 case OBERON_CLASS_PARAM
:
1707 case OBERON_CLASS_VAR_PARAM
:
1708 case OBERON_CLASS_FIELD
:
1709 oberon_prevent_recursive_type(ctx
, x
-> type
);
1711 case OBERON_CLASS_CONST
:
1712 case OBERON_CLASS_PROC
:
1715 oberon_error(ctx
, "oberon_prevent_recursive_object: wat");
1721 oberon_prevent_recursive_decl(oberon_context_t
* ctx
)
1723 oberon_object_t
* x
= ctx
-> decl
-> list
-> next
;
1727 oberon_prevent_recursive_object(ctx
, x
);
1732 static void oberon_initialize_object(oberon_context_t
* ctx
, oberon_object_t
* x
);
1733 static void oberon_initialize_type(oberon_context_t
* ctx
, oberon_type_t
* type
);
1736 oberon_initialize_record_fields(oberon_context_t
* ctx
, oberon_type_t
* type
)
1738 if(type
-> class != OBERON_TYPE_RECORD
)
1743 int num_fields
= type
-> num_decl
;
1744 oberon_object_t
* field
= type
-> decl
;
1745 for(int i
= 0; i
< num_fields
; i
++)
1747 if(field
-> type
-> class == OBERON_TYPE_POINTER
)
1749 oberon_initialize_type(ctx
, field
-> type
);
1752 oberon_initialize_object(ctx
, field
);
1753 field
= field
-> next
;
1756 oberon_generator_init_record(ctx
, type
);
1760 oberon_initialize_type(oberon_context_t
* ctx
, oberon_type_t
* type
)
1762 if(type
-> class == OBERON_TYPE_VOID
)
1764 oberon_error(ctx
, "undeclarated type");
1767 if(type
-> initialized
)
1772 type
-> initialized
= 1;
1774 if(type
-> class == OBERON_TYPE_POINTER
)
1776 if(type
-> base
-> class == OBERON_TYPE_RECORD
)
1778 oberon_generator_init_type(ctx
, type
-> base
);
1779 oberon_generator_init_type(ctx
, type
);
1783 oberon_initialize_type(ctx
, type
-> base
);
1784 oberon_generator_init_type(ctx
, type
);
1787 else if(type
-> class == OBERON_TYPE_ARRAY
)
1789 oberon_initialize_type(ctx
, type
-> base
);
1790 oberon_generator_init_type(ctx
, type
);
1792 else if(type
-> class == OBERON_TYPE_RECORD
)
1794 oberon_generator_init_type(ctx
, type
);
1795 oberon_initialize_record_fields(ctx
, type
);
1797 else if(type
-> class == OBERON_TYPE_PROCEDURE
)
1799 int num_fields
= type
-> num_decl
;
1800 oberon_object_t
* field
= type
-> decl
;
1801 for(int i
= 0; i
< num_fields
; i
++)
1803 oberon_initialize_object(ctx
, field
);
1804 field
= field
-> next
;
1807 oberon_generator_init_type(ctx
, type
);
1811 oberon_generator_init_type(ctx
, type
);
1816 oberon_initialize_object(oberon_context_t
* ctx
, oberon_object_t
* x
)
1818 printf("oberon_initialize_object: name %s class %i\n", x
-> name
, x
-> class);
1821 case OBERON_CLASS_TYPE
:
1822 oberon_initialize_type(ctx
, x
-> type
);
1824 case OBERON_CLASS_VAR
:
1825 case OBERON_CLASS_PARAM
:
1826 case OBERON_CLASS_VAR_PARAM
:
1827 case OBERON_CLASS_FIELD
:
1828 oberon_initialize_type(ctx
, x
-> type
);
1829 oberon_generator_init_var(ctx
, x
);
1831 case OBERON_CLASS_CONST
:
1832 case OBERON_CLASS_PROC
:
1835 oberon_error(ctx
, "oberon_prevent_recursive_object: wat");
1841 oberon_initialize_decl(oberon_context_t
* ctx
)
1843 oberon_object_t
* x
= ctx
-> decl
-> list
;
1847 oberon_initialize_object(ctx
, x
-> next
);
1853 oberon_decl_seq(oberon_context_t
* ctx
)
1855 if(ctx
-> token
== CONST
)
1857 oberon_assert_token(ctx
, CONST
);
1858 while(ctx
-> token
== IDENT
)
1860 oberon_const_decl(ctx
);
1861 oberon_assert_token(ctx
, SEMICOLON
);
1865 if(ctx
-> token
== TYPE
)
1867 oberon_assert_token(ctx
, TYPE
);
1868 while(ctx
-> token
== IDENT
)
1870 oberon_type_decl(ctx
);
1871 oberon_assert_token(ctx
, SEMICOLON
);
1875 if(ctx
-> token
== VAR
)
1877 oberon_assert_token(ctx
, VAR
);
1878 while(ctx
-> token
== IDENT
)
1880 oberon_var_decl(ctx
);
1881 oberon_assert_token(ctx
, SEMICOLON
);
1885 oberon_prevent_recursive_decl(ctx
);
1886 oberon_initialize_decl(ctx
);
1888 while(ctx
-> token
== PROCEDURE
)
1890 oberon_proc_decl(ctx
);
1891 oberon_assert_token(ctx
, SEMICOLON
);
1896 oberon_assign(oberon_context_t
* ctx
, oberon_expr_t
* src
, oberon_expr_t
* dst
)
1898 oberon_autocast_to(ctx
, src
, dst
-> result
);
1899 oberon_generate_assign(ctx
, src
, dst
);
1903 oberon_make_call(oberon_context_t
* ctx
, oberon_expr_t
* desig
)
1905 oberon_autocast_call(ctx
, desig
);
1906 oberon_generate_call_proc(ctx
, desig
);
1910 oberon_statement(oberon_context_t
* ctx
)
1912 oberon_expr_t
* item1
;
1913 oberon_expr_t
* item2
;
1915 if(ctx
-> token
== IDENT
)
1917 item1
= oberon_designator(ctx
);
1918 if(ctx
-> token
== ASSIGN
)
1920 oberon_assert_token(ctx
, ASSIGN
);
1921 item2
= oberon_expr(ctx
);
1922 oberon_assign(ctx
, item2
, item1
);
1926 item1
= oberon_opt_proc_parens(ctx
, item1
);
1927 oberon_make_call(ctx
, item1
);
1930 else if(ctx
-> token
== RETURN
)
1932 oberon_assert_token(ctx
, RETURN
);
1933 if(ISEXPR(ctx
-> token
))
1935 oberon_expr_t
* expr
;
1936 expr
= oberon_expr(ctx
);
1937 oberon_make_return(ctx
, expr
);
1941 oberon_make_return(ctx
, NULL
);
1947 oberon_statement_seq(oberon_context_t
* ctx
)
1949 oberon_statement(ctx
);
1950 while(ctx
-> token
== SEMICOLON
)
1952 oberon_assert_token(ctx
, SEMICOLON
);
1953 oberon_statement(ctx
);
1958 oberon_parse_module(oberon_context_t
* ctx
)
1960 char *name1
, *name2
;
1961 oberon_read_token(ctx
);
1963 oberon_assert_token(ctx
, MODULE
);
1964 name1
= oberon_assert_ident(ctx
);
1965 oberon_assert_token(ctx
, SEMICOLON
);
1966 ctx
-> mod
-> name
= name1
;
1968 oberon_decl_seq(ctx
);
1970 if(ctx
-> token
== BEGIN
)
1972 oberon_assert_token(ctx
, BEGIN
);
1973 oberon_generate_begin_module(ctx
);
1974 oberon_statement_seq(ctx
);
1975 oberon_generate_end_module(ctx
);
1978 oberon_assert_token(ctx
, END
);
1979 name2
= oberon_assert_ident(ctx
);
1980 oberon_assert_token(ctx
, DOT
);
1982 if(strcmp(name1
, name2
) != 0)
1984 oberon_error(ctx
, "module name not matched");
1988 // =======================================================================
1990 // =======================================================================
1993 register_default_types(oberon_context_t
* ctx
)
1995 ctx
-> void_type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1996 oberon_generator_init_type(ctx
, ctx
-> void_type
);
1998 ctx
-> int_type
= oberon_new_type_integer(sizeof(int));
1999 oberon_define_type(ctx
-> world_scope
, "INTEGER", ctx
-> int_type
);
2001 ctx
-> bool_type
= oberon_new_type_boolean(sizeof(int));
2002 oberon_define_type(ctx
-> world_scope
, "BOOLEAN", ctx
-> bool_type
);
2006 oberon_create_context()
2008 oberon_context_t
* ctx
= malloc(sizeof *ctx
);
2009 memset(ctx
, 0, sizeof *ctx
);
2011 oberon_scope_t
* world_scope
;
2012 world_scope
= oberon_open_scope(ctx
);
2013 ctx
-> world_scope
= world_scope
;
2015 oberon_generator_init_context(ctx
);
2017 register_default_types(ctx
);
2023 oberon_destroy_context(oberon_context_t
* ctx
)
2025 oberon_generator_destroy_context(ctx
);
2030 oberon_compile_module(oberon_context_t
* ctx
, const char * code
)
2032 oberon_module_t
* mod
= malloc(sizeof *mod
);
2033 memset(mod
, 0, sizeof *mod
);
2036 oberon_scope_t
* module_scope
;
2037 module_scope
= oberon_open_scope(ctx
);
2038 mod
-> decl
= module_scope
;
2040 oberon_init_scaner(ctx
, code
);
2041 oberon_parse_module(ctx
);
2043 oberon_generate_code(ctx
);