9 #include "../include/oberon.h"
11 #include "oberon-internals.h"
12 #include "generator.h"
63 // =======================================================================
65 // =======================================================================
68 oberon_error(oberon_context_t
* ctx
, const char * fmt
, ...)
72 fprintf(stderr
, "error: ");
73 vfprintf(stderr
, fmt
, ptr
);
74 fprintf(stderr
, "\n");
75 fprintf(stderr
, " code_index = %i\n", ctx
-> code_index
);
76 fprintf(stderr
, " c = %c\n", ctx
-> c
);
77 fprintf(stderr
, " token = %i\n", ctx
-> token
);
82 static oberon_type_t
*
83 oberon_new_type_ptr(int class)
85 oberon_type_t
* x
= malloc(sizeof *x
);
86 memset(x
, 0, sizeof *x
);
91 static oberon_type_t
*
92 oberon_new_type_integer(int size
)
95 x
= oberon_new_type_ptr(OBERON_TYPE_INTEGER
);
100 static oberon_type_t
*
101 oberon_new_type_boolean()
104 x
= oberon_new_type_ptr(OBERON_TYPE_BOOLEAN
);
108 static oberon_type_t
*
109 oberon_new_type_real(int size
)
112 x
= oberon_new_type_ptr(OBERON_TYPE_REAL
);
117 // =======================================================================
119 // =======================================================================
121 static oberon_scope_t
*
122 oberon_open_scope(oberon_context_t
* ctx
)
124 oberon_scope_t
* scope
= calloc(1, sizeof *scope
);
125 oberon_object_t
* list
= calloc(1, sizeof *list
);
128 scope
-> list
= list
;
129 scope
-> up
= ctx
-> decl
;
133 scope
-> local
= scope
-> up
-> local
;
134 scope
-> parent
= scope
-> up
-> parent
;
135 scope
-> parent_type
= scope
-> up
-> parent_type
;
143 oberon_close_scope(oberon_scope_t
* scope
)
145 oberon_context_t
* ctx
= scope
-> ctx
;
146 ctx
-> decl
= scope
-> up
;
149 static oberon_object_t
*
150 oberon_define_object(oberon_scope_t
* scope
, char * name
, int class, int export
, int read_only
)
152 oberon_object_t
* x
= scope
-> list
;
153 while(x
-> next
&& strcmp(x
-> next
-> name
, name
) != 0)
160 oberon_error(scope
-> ctx
, "already defined");
163 oberon_object_t
* newvar
= malloc(sizeof *newvar
);
164 memset(newvar
, 0, sizeof *newvar
);
165 newvar
-> name
= name
;
166 newvar
-> class = class;
167 newvar
-> export
= export
;
168 newvar
-> read_only
= read_only
;
169 newvar
-> local
= scope
-> local
;
170 newvar
-> parent
= scope
-> parent
;
171 newvar
-> parent_type
= scope
-> parent_type
;
172 newvar
-> module
= scope
-> ctx
-> mod
;
179 static oberon_object_t
*
180 oberon_find_object_in_list(oberon_object_t
* list
, char * name
)
182 oberon_object_t
* x
= list
;
183 while(x
-> next
&& strcmp(x
-> next
-> name
, name
) != 0)
190 static oberon_object_t
*
191 oberon_find_object(oberon_scope_t
* scope
, char * name
, int check_it
)
193 oberon_object_t
* result
= NULL
;
195 oberon_scope_t
* s
= scope
;
196 while(result
== NULL
&& s
!= NULL
)
198 result
= oberon_find_object_in_list(s
-> list
, name
);
202 if(check_it
&& result
== NULL
)
204 oberon_error(scope
-> ctx
, "undefined ident %s", name
);
210 static oberon_object_t
*
211 oberon_find_field(oberon_context_t
* ctx
, oberon_type_t
* rec
, char * name
)
213 oberon_object_t
* x
= rec
-> decl
;
214 for(int i
= 0; i
< rec
-> num_decl
; i
++)
216 if(strcmp(x
-> name
, name
) == 0)
223 oberon_error(ctx
, "field not defined");
228 static oberon_object_t
*
229 oberon_define_type(oberon_scope_t
* scope
, char * name
, oberon_type_t
* type
, int export
)
231 oberon_object_t
* id
;
232 id
= oberon_define_object(scope
, name
, OBERON_CLASS_TYPE
, export
, 0);
234 oberon_generator_init_type(scope
-> ctx
, type
);
238 // =======================================================================
240 // =======================================================================
243 oberon_get_char(oberon_context_t
* ctx
)
245 if(ctx
-> code
[ctx
-> code_index
])
247 ctx
-> code_index
+= 1;
248 ctx
-> c
= ctx
-> code
[ctx
-> code_index
];
253 oberon_init_scaner(oberon_context_t
* ctx
, const char * code
)
256 ctx
-> code_index
= 0;
257 ctx
-> c
= ctx
-> code
[ctx
-> code_index
];
261 oberon_read_ident(oberon_context_t
* ctx
)
264 int i
= ctx
-> code_index
;
266 int c
= ctx
-> code
[i
];
274 char * ident
= malloc(len
+ 1);
275 memcpy(ident
, &ctx
->code
[ctx
->code_index
], len
);
278 ctx
-> code_index
= i
;
279 ctx
-> c
= ctx
-> code
[i
];
280 ctx
-> string
= ident
;
281 ctx
-> token
= IDENT
;
283 if(strcmp(ident
, "MODULE") == 0)
285 ctx
-> token
= MODULE
;
287 else if(strcmp(ident
, "END") == 0)
291 else if(strcmp(ident
, "VAR") == 0)
295 else if(strcmp(ident
, "BEGIN") == 0)
297 ctx
-> token
= BEGIN
;
299 else if(strcmp(ident
, "TRUE") == 0)
303 else if(strcmp(ident
, "FALSE") == 0)
305 ctx
-> token
= FALSE
;
307 else if(strcmp(ident
, "OR") == 0)
311 else if(strcmp(ident
, "DIV") == 0)
315 else if(strcmp(ident
, "MOD") == 0)
319 else if(strcmp(ident
, "PROCEDURE") == 0)
321 ctx
-> token
= PROCEDURE
;
323 else if(strcmp(ident
, "RETURN") == 0)
325 ctx
-> token
= RETURN
;
327 else if(strcmp(ident
, "CONST") == 0)
329 ctx
-> token
= CONST
;
331 else if(strcmp(ident
, "TYPE") == 0)
335 else if(strcmp(ident
, "ARRAY") == 0)
337 ctx
-> token
= ARRAY
;
339 else if(strcmp(ident
, "OF") == 0)
343 else if(strcmp(ident
, "RECORD") == 0)
345 ctx
-> token
= RECORD
;
347 else if(strcmp(ident
, "POINTER") == 0)
349 ctx
-> token
= POINTER
;
351 else if(strcmp(ident
, "TO") == 0)
355 else if(strcmp(ident
, "NIL") == 0)
359 else if(strcmp(ident
, "IMPORT") == 0)
361 ctx
-> token
= IMPORT
;
366 oberon_read_number(oberon_context_t
* ctx
)
379 * mode = 3 == LONGREAL
382 start_i
= ctx
-> code_index
;
384 while(isdigit(ctx
-> c
))
386 oberon_get_char(ctx
);
389 end_i
= ctx
-> code_index
;
391 if(isxdigit(ctx
-> c
))
394 while(isxdigit(ctx
-> c
))
396 oberon_get_char(ctx
);
399 end_i
= ctx
-> code_index
;
403 oberon_error(ctx
, "invalid hex number");
405 oberon_get_char(ctx
);
407 else if(ctx
-> c
== '.')
410 oberon_get_char(ctx
);
412 while(isdigit(ctx
-> c
))
414 oberon_get_char(ctx
);
417 if(ctx
-> c
== 'E' || ctx
-> c
== 'D')
419 exp_i
= ctx
-> code_index
;
426 oberon_get_char(ctx
);
428 if(ctx
-> c
== '+' || ctx
-> c
== '-')
430 oberon_get_char(ctx
);
433 while(isdigit(ctx
-> c
))
435 oberon_get_char(ctx
);
440 end_i
= ctx
-> code_index
;
443 int len
= end_i
- start_i
;
444 ident
= malloc(len
+ 1);
445 memcpy(ident
, &ctx
-> code
[start_i
], len
);
448 ctx
-> longmode
= false;
451 int i
= exp_i
- start_i
;
453 ctx
-> longmode
= true;
459 integer
= atol(ident
);
461 ctx
-> token
= INTEGER
;
464 sscanf(ident
, "%lx", &integer
);
466 ctx
-> token
= INTEGER
;
470 sscanf(ident
, "%lf", &real
);
474 oberon_error(ctx
, "oberon_read_number: wat");
478 ctx
-> string
= ident
;
479 ctx
-> integer
= integer
;
484 oberon_skip_space(oberon_context_t
* ctx
)
486 while(isspace(ctx
-> c
))
488 oberon_get_char(ctx
);
493 oberon_read_comment(oberon_context_t
* ctx
)
500 oberon_get_char(ctx
);
503 oberon_get_char(ctx
);
507 else if(ctx
-> c
== '*')
509 oberon_get_char(ctx
);
512 oberon_get_char(ctx
);
516 else if(ctx
-> c
== 0)
518 oberon_error(ctx
, "unterminated comment");
522 oberon_get_char(ctx
);
527 static void oberon_read_token(oberon_context_t
* ctx
);
530 oberon_read_symbol(oberon_context_t
* ctx
)
539 ctx
-> token
= SEMICOLON
;
540 oberon_get_char(ctx
);
543 ctx
-> token
= COLON
;
544 oberon_get_char(ctx
);
547 ctx
-> token
= ASSIGN
;
548 oberon_get_char(ctx
);
553 oberon_get_char(ctx
);
556 ctx
-> token
= LPAREN
;
557 oberon_get_char(ctx
);
560 oberon_get_char(ctx
);
561 oberon_read_comment(ctx
);
562 oberon_read_token(ctx
);
566 ctx
-> token
= RPAREN
;
567 oberon_get_char(ctx
);
570 ctx
-> token
= EQUAL
;
571 oberon_get_char(ctx
);
575 oberon_get_char(ctx
);
579 oberon_get_char(ctx
);
583 oberon_get_char(ctx
);
587 ctx
-> token
= GREAT
;
588 oberon_get_char(ctx
);
592 oberon_get_char(ctx
);
597 oberon_get_char(ctx
);
600 ctx
-> token
= MINUS
;
601 oberon_get_char(ctx
);
605 oberon_get_char(ctx
);
608 oberon_get_char(ctx
);
609 oberon_error(ctx
, "unstarted comment");
613 ctx
-> token
= SLASH
;
614 oberon_get_char(ctx
);
618 oberon_get_char(ctx
);
622 oberon_get_char(ctx
);
625 ctx
-> token
= COMMA
;
626 oberon_get_char(ctx
);
629 ctx
-> token
= LBRACE
;
630 oberon_get_char(ctx
);
633 ctx
-> token
= RBRACE
;
634 oberon_get_char(ctx
);
637 ctx
-> token
= UPARROW
;
638 oberon_get_char(ctx
);
641 oberon_error(ctx
, "invalid char %c", ctx
-> c
);
647 oberon_read_token(oberon_context_t
* ctx
)
649 oberon_skip_space(ctx
);
654 oberon_read_ident(ctx
);
658 oberon_read_number(ctx
);
662 oberon_read_symbol(ctx
);
666 // =======================================================================
668 // =======================================================================
670 static void oberon_expect_token(oberon_context_t
* ctx
, int token
);
671 static oberon_expr_t
* oberon_expr(oberon_context_t
* ctx
);
672 static void oberon_assert_token(oberon_context_t
* ctx
, int token
);
673 static char * oberon_assert_ident(oberon_context_t
* ctx
);
674 static void oberon_type(oberon_context_t
* ctx
, oberon_type_t
** type
);
675 static oberon_item_t
* oberon_const_expr(oberon_context_t
* ctx
);
677 static oberon_expr_t
*
678 oberon_new_operator(int op
, oberon_type_t
* result
, oberon_expr_t
* left
, oberon_expr_t
* right
)
680 oberon_oper_t
* operator;
681 operator = malloc(sizeof *operator);
682 memset(operator, 0, sizeof *operator);
684 operator -> is_item
= 0;
685 operator -> result
= result
;
686 operator -> read_only
= 1;
688 operator -> left
= left
;
689 operator -> right
= right
;
691 return (oberon_expr_t
*) operator;
694 static oberon_expr_t
*
695 oberon_new_item(int mode
, oberon_type_t
* result
, int read_only
)
697 oberon_item_t
* item
;
698 item
= malloc(sizeof *item
);
699 memset(item
, 0, sizeof *item
);
702 item
-> result
= result
;
703 item
-> read_only
= read_only
;
706 return (oberon_expr_t
*)item
;
709 static oberon_expr_t
*
710 oberon_make_unary_op(oberon_context_t
* ctx
, int token
, oberon_expr_t
* a
)
712 oberon_expr_t
* expr
;
713 oberon_type_t
* result
;
715 result
= a
-> result
;
719 if(result
-> class != OBERON_TYPE_INTEGER
)
721 oberon_error(ctx
, "incompatible operator type");
724 expr
= oberon_new_operator(OP_UNARY_MINUS
, result
, a
, NULL
);
726 else if(token
== NOT
)
728 if(result
-> class != OBERON_TYPE_BOOLEAN
)
730 oberon_error(ctx
, "incompatible operator type");
733 expr
= oberon_new_operator(OP_LOGIC_NOT
, result
, a
, NULL
);
737 oberon_error(ctx
, "oberon_make_unary_op: wat");
744 oberon_expr_list(oberon_context_t
* ctx
, int * num_expr
, oberon_expr_t
** first
, int const_expr
)
746 oberon_expr_t
* last
;
749 *first
= last
= oberon_expr(ctx
);
750 while(ctx
-> token
== COMMA
)
752 oberon_assert_token(ctx
, COMMA
);
753 oberon_expr_t
* current
;
757 current
= (oberon_expr_t
*) oberon_const_expr(ctx
);
761 current
= oberon_expr(ctx
);
764 last
-> next
= current
;
770 static oberon_expr_t
*
771 oberon_cast_expr(oberon_context_t
* ctx
, oberon_expr_t
* expr
, oberon_type_t
* pref
)
773 oberon_expr_t
* cast
;
774 cast
= oberon_new_item(MODE_CAST
, pref
, expr
-> read_only
);
775 cast
-> item
.parent
= expr
;
776 cast
-> next
= expr
-> next
;
780 static oberon_type_t
*
781 oberon_get_equal_expr_type(oberon_context_t
* ctx
, oberon_type_t
* a
, oberon_type_t
* b
)
783 oberon_type_t
* result
;
784 if(a
-> class == OBERON_TYPE_REAL
&& b
-> class == OBERON_TYPE_INTEGER
)
788 else if(b
-> class == OBERON_TYPE_REAL
&& a
-> class == OBERON_TYPE_INTEGER
)
792 else if(a
-> class != b
-> class)
794 oberon_error(ctx
, "oberon_get_equal_expr_type: incompatible types");
796 else if(a
-> size
> b
-> size
)
808 static oberon_expr_t
*
809 oberon_autocast_to(oberon_context_t
* ctx
, oberon_expr_t
* expr
, oberon_type_t
* pref
)
811 if(pref
-> class != expr
-> result
-> class)
813 if(pref
-> class == OBERON_TYPE_POINTER
)
815 if(expr
-> result
-> class == OBERON_TYPE_POINTER
)
821 oberon_error(ctx
, "incompatible types");
824 else if(pref
-> class == OBERON_TYPE_REAL
)
826 if(expr
-> result
-> class == OBERON_TYPE_INTEGER
)
832 oberon_error(ctx
, "incompatible types");
837 oberon_error(ctx
, "incompatible types");
841 if(pref
-> class == OBERON_TYPE_INTEGER
|| pref
-> class == OBERON_TYPE_REAL
)
843 if(expr
-> result
-> size
> pref
-> size
)
845 oberon_error(ctx
, "incompatible size");
849 expr
= oberon_cast_expr(ctx
, expr
, pref
);
852 else if(pref
-> class == OBERON_TYPE_RECORD
)
854 if(expr
-> result
!= pref
)
856 printf("oberon_autocast_to: rec %p != %p\n", expr
-> result
, pref
);
857 oberon_error(ctx
, "incompatible record types");
860 else if(pref
-> class == OBERON_TYPE_POINTER
)
862 if(expr
-> result
-> base
!= pref
-> base
)
864 if(expr
-> result
-> base
-> class != OBERON_TYPE_VOID
)
866 oberon_error(ctx
, "incompatible pointer types");
875 oberon_autocast_binary_op(oberon_context_t
* ctx
, oberon_expr_t
** ea
, oberon_expr_t
** eb
)
877 oberon_type_t
* a
= (*ea
) -> result
;
878 oberon_type_t
* b
= (*eb
) -> result
;
879 oberon_type_t
* preq
= oberon_get_equal_expr_type(ctx
, a
, b
);
880 *ea
= oberon_autocast_to(ctx
, *ea
, preq
);
881 *eb
= oberon_autocast_to(ctx
, *eb
, preq
);
885 oberon_autocast_call(oberon_context_t
* ctx
, oberon_expr_t
* desig
)
887 if(desig
-> is_item
== 0)
889 oberon_error(ctx
, "expected item");
892 if(desig
-> item
.mode
!= MODE_CALL
)
894 oberon_error(ctx
, "expected mode CALL");
897 if(desig
-> item
.var
-> type
-> class != OBERON_TYPE_PROCEDURE
)
899 oberon_error(ctx
, "only procedures can be called");
902 oberon_type_t
* fn
= desig
-> item
.var
-> type
;
903 int num_args
= desig
-> item
.num_args
;
904 int num_decl
= fn
-> num_decl
;
906 if(num_args
< num_decl
)
908 oberon_error(ctx
, "too few arguments");
910 else if(num_args
> num_decl
)
912 oberon_error(ctx
, "too many arguments");
915 /* Делаем проверку на запись и делаем автокаст */
916 oberon_expr_t
* casted
[num_args
];
917 oberon_expr_t
* arg
= desig
-> item
.args
;
918 oberon_object_t
* param
= fn
-> decl
;
919 for(int i
= 0; i
< num_args
; i
++)
921 if(param
-> class == OBERON_CLASS_VAR_PARAM
)
925 oberon_error(ctx
, "assign to read-only var");
929 casted
[i
] = oberon_autocast_to(ctx
, arg
, param
-> type
);
931 param
= param
-> next
;
934 /* Создаём новый список выражений */
938 for(int i
= 0; i
< num_args
- 1; i
++)
940 casted
[i
] -> next
= casted
[i
+ 1];
942 desig
-> item
.args
= arg
;
946 static oberon_expr_t
*
947 oberon_make_call_func(oberon_context_t
* ctx
, oberon_object_t
* proc
, int num_args
, oberon_expr_t
* list_args
)
949 switch(proc
-> class)
951 case OBERON_CLASS_PROC
:
952 if(proc
-> class != OBERON_CLASS_PROC
)
954 oberon_error(ctx
, "not a procedure");
957 case OBERON_CLASS_VAR
:
958 case OBERON_CLASS_VAR_PARAM
:
959 case OBERON_CLASS_PARAM
:
960 if(proc
-> type
-> class != OBERON_TYPE_PROCEDURE
)
962 oberon_error(ctx
, "not a procedure");
966 oberon_error(ctx
, "not a procedure");
970 oberon_expr_t
* call
;
974 if(proc
-> genfunc
== NULL
)
976 oberon_error(ctx
, "not a function-procedure");
979 call
= proc
-> genfunc(ctx
, num_args
, list_args
);
983 if(proc
-> type
-> base
-> class == OBERON_TYPE_VOID
)
985 oberon_error(ctx
, "attempt to call procedure in expression");
988 call
= oberon_new_item(MODE_CALL
, proc
-> type
-> base
, 1);
989 call
-> item
.var
= proc
;
990 call
-> item
.num_args
= num_args
;
991 call
-> item
.args
= list_args
;
992 oberon_autocast_call(ctx
, call
);
999 oberon_make_call_proc(oberon_context_t
* ctx
, oberon_object_t
* proc
, int num_args
, oberon_expr_t
* list_args
)
1001 switch(proc
-> class)
1003 case OBERON_CLASS_PROC
:
1004 if(proc
-> class != OBERON_CLASS_PROC
)
1006 oberon_error(ctx
, "not a procedure");
1009 case OBERON_CLASS_VAR
:
1010 case OBERON_CLASS_VAR_PARAM
:
1011 case OBERON_CLASS_PARAM
:
1012 if(proc
-> type
-> class != OBERON_TYPE_PROCEDURE
)
1014 oberon_error(ctx
, "not a procedure");
1018 oberon_error(ctx
, "not a procedure");
1024 if(proc
-> genproc
== NULL
)
1026 oberon_error(ctx
, "requres non-typed procedure");
1029 proc
-> genproc(ctx
, num_args
, list_args
);
1033 if(proc
-> type
-> base
-> class != OBERON_TYPE_VOID
)
1035 oberon_error(ctx
, "attempt to call function as non-typed procedure");
1038 oberon_expr_t
* call
;
1039 call
= oberon_new_item(MODE_CALL
, proc
-> type
-> base
, 1);
1040 call
-> item
.var
= proc
;
1041 call
-> item
.num_args
= num_args
;
1042 call
-> item
.args
= list_args
;
1043 oberon_autocast_call(ctx
, call
);
1044 oberon_generate_call_proc(ctx
, call
);
1052 || ((x) == INTEGER) \
1053 || ((x) == LPAREN) \
1058 static oberon_expr_t
*
1059 oberno_make_dereferencing(oberon_context_t
* ctx
, oberon_expr_t
* expr
)
1061 if(expr
-> result
-> class != OBERON_TYPE_POINTER
)
1063 oberon_error(ctx
, "not a pointer");
1066 assert(expr
-> is_item
);
1068 oberon_expr_t
* selector
;
1069 selector
= oberon_new_item(MODE_DEREF
, expr
-> result
-> base
, expr
-> read_only
);
1070 selector
-> item
.parent
= expr
;
1075 static oberon_expr_t
*
1076 oberon_make_array_selector(oberon_context_t
* ctx
, oberon_expr_t
* desig
, oberon_expr_t
* index
)
1078 if(desig
-> result
-> class == OBERON_TYPE_POINTER
)
1080 desig
= oberno_make_dereferencing(ctx
, desig
);
1083 assert(desig
-> is_item
);
1085 if(desig
-> result
-> class != OBERON_TYPE_ARRAY
)
1087 oberon_error(ctx
, "not array");
1090 oberon_type_t
* base
;
1091 base
= desig
-> result
-> base
;
1093 if(index
-> result
-> class != OBERON_TYPE_INTEGER
)
1095 oberon_error(ctx
, "index must be integer");
1098 // Статическая проверка границ массива
1099 if(desig
-> result
-> size
!= 0)
1101 if(index
-> is_item
)
1103 if(index
-> item
.mode
== MODE_INTEGER
)
1105 int arr_size
= desig
-> result
-> size
;
1106 int index_int
= index
-> item
.integer
;
1107 if(index_int
< 0 || index_int
> arr_size
- 1)
1109 oberon_error(ctx
, "not in range (dimension size 0..%i)", arr_size
- 1);
1115 oberon_expr_t
* selector
;
1116 selector
= oberon_new_item(MODE_INDEX
, base
, desig
-> read_only
);
1117 selector
-> item
.parent
= desig
;
1118 selector
-> item
.num_args
= 1;
1119 selector
-> item
.args
= index
;
1124 static oberon_expr_t
*
1125 oberon_make_record_selector(oberon_context_t
* ctx
, oberon_expr_t
* expr
, char * name
)
1127 if(expr
-> result
-> class == OBERON_TYPE_POINTER
)
1129 expr
= oberno_make_dereferencing(ctx
, expr
);
1132 assert(expr
-> is_item
== 1);
1134 if(expr
-> result
-> class != OBERON_TYPE_RECORD
)
1136 oberon_error(ctx
, "not record");
1139 oberon_type_t
* rec
= expr
-> result
;
1141 oberon_object_t
* field
;
1142 field
= oberon_find_field(ctx
, rec
, name
);
1144 if(field
-> export
== 0)
1146 if(field
-> module
!= ctx
-> mod
)
1148 oberon_error(ctx
, "field not exported");
1153 if(field
-> read_only
)
1155 if(field
-> module
!= ctx
-> mod
)
1161 oberon_expr_t
* selector
;
1162 selector
= oberon_new_item(MODE_FIELD
, field
-> type
, read_only
);
1163 selector
-> item
.var
= field
;
1164 selector
-> item
.parent
= expr
;
1169 #define ISSELECTOR(x) \
1172 || ((x) == UPARROW))
1174 static oberon_object_t
*
1175 oberon_qualident(oberon_context_t
* ctx
, char ** xname
, int check
)
1178 oberon_object_t
* x
;
1180 name
= oberon_assert_ident(ctx
);
1181 x
= oberon_find_object(ctx
-> decl
, name
, check
);
1185 if(x
-> class == OBERON_CLASS_MODULE
)
1187 oberon_assert_token(ctx
, DOT
);
1188 name
= oberon_assert_ident(ctx
);
1189 /* Наличие объектов в левых модулях всегда проверяется */
1190 x
= oberon_find_object(x
-> module
-> decl
, name
, 1);
1192 if(x
-> export
== 0)
1194 oberon_error(ctx
, "not exported");
1207 static oberon_expr_t
*
1208 oberon_designator(oberon_context_t
* ctx
)
1211 oberon_object_t
* var
;
1212 oberon_expr_t
* expr
;
1214 var
= oberon_qualident(ctx
, NULL
, 1);
1217 if(var
-> read_only
)
1219 if(var
-> module
!= ctx
-> mod
)
1225 switch(var
-> class)
1227 case OBERON_CLASS_CONST
:
1229 expr
= (oberon_expr_t
*) var
-> value
;
1231 case OBERON_CLASS_VAR
:
1232 case OBERON_CLASS_VAR_PARAM
:
1233 case OBERON_CLASS_PARAM
:
1234 expr
= oberon_new_item(MODE_VAR
, var
-> type
, read_only
);
1236 case OBERON_CLASS_PROC
:
1237 expr
= oberon_new_item(MODE_VAR
, var
-> type
, 1);
1240 oberon_error(ctx
, "invalid designator");
1243 expr
-> item
.var
= var
;
1245 while(ISSELECTOR(ctx
-> token
))
1247 switch(ctx
-> token
)
1250 oberon_assert_token(ctx
, DOT
);
1251 name
= oberon_assert_ident(ctx
);
1252 expr
= oberon_make_record_selector(ctx
, expr
, name
);
1255 oberon_assert_token(ctx
, LBRACE
);
1256 int num_indexes
= 0;
1257 oberon_expr_t
* indexes
= NULL
;
1258 oberon_expr_list(ctx
, &num_indexes
, &indexes
, 0);
1259 oberon_assert_token(ctx
, RBRACE
);
1261 for(int i
= 0; i
< num_indexes
; i
++)
1263 expr
= oberon_make_array_selector(ctx
, expr
, indexes
);
1264 indexes
= indexes
-> next
;
1268 oberon_assert_token(ctx
, UPARROW
);
1269 expr
= oberno_make_dereferencing(ctx
, expr
);
1272 oberon_error(ctx
, "oberon_designator: wat");
1279 static oberon_expr_t
*
1280 oberon_opt_func_parens(oberon_context_t
* ctx
, oberon_expr_t
* expr
)
1282 assert(expr
-> is_item
== 1);
1284 /* Если есть скобки - значит вызов. Если нет, то передаём указатель. */
1285 if(ctx
-> token
== LPAREN
)
1287 oberon_assert_token(ctx
, LPAREN
);
1290 oberon_expr_t
* arguments
= NULL
;
1292 if(ISEXPR(ctx
-> token
))
1294 oberon_expr_list(ctx
, &num_args
, &arguments
, 0);
1297 expr
= oberon_make_call_func(ctx
, expr
-> item
.var
, num_args
, arguments
);
1299 oberon_assert_token(ctx
, RPAREN
);
1306 oberon_opt_proc_parens(oberon_context_t
* ctx
, oberon_expr_t
* expr
)
1308 assert(expr
-> is_item
== 1);
1311 oberon_expr_t
* arguments
= NULL
;
1313 if(ctx
-> token
== LPAREN
)
1315 oberon_assert_token(ctx
, LPAREN
);
1317 if(ISEXPR(ctx
-> token
))
1319 oberon_expr_list(ctx
, &num_args
, &arguments
, 0);
1322 oberon_assert_token(ctx
, RPAREN
);
1325 /* Вызов происходит даже без скобок */
1326 oberon_make_call_proc(ctx
, expr
-> item
.var
, num_args
, arguments
);
1329 static oberon_type_t
*
1330 oberon_get_type_of_int_value(oberon_context_t
* ctx
, int64_t i
)
1332 if(i
>= -128 && i
<= 127)
1334 return ctx
-> byte_type
;
1336 else if(i
>= -32768 && i
<= 32767)
1338 return ctx
-> shortint_type
;
1340 else if(i
>= -2147483648 && i
<= 2147483647)
1342 return ctx
-> int_type
;
1346 return ctx
-> longint_type
;
1350 static oberon_expr_t
*
1351 oberon_factor(oberon_context_t
* ctx
)
1353 oberon_expr_t
* expr
;
1354 oberon_type_t
* result
;
1356 switch(ctx
-> token
)
1359 expr
= oberon_designator(ctx
);
1360 expr
= oberon_opt_func_parens(ctx
, expr
);
1363 result
= oberon_get_type_of_int_value(ctx
, ctx
-> integer
);
1364 expr
= oberon_new_item(MODE_INTEGER
, result
, 1);
1365 expr
-> item
.integer
= ctx
-> integer
;
1366 oberon_assert_token(ctx
, INTEGER
);
1369 result
= (ctx
-> longmode
) ? (ctx
-> longreal_type
) : (ctx
-> real_type
);
1370 expr
= oberon_new_item(MODE_REAL
, result
, 1);
1371 expr
-> item
.real
= ctx
-> real
;
1372 oberon_assert_token(ctx
, REAL
);
1375 expr
= oberon_new_item(MODE_BOOLEAN
, ctx
-> bool_type
, 1);
1376 expr
-> item
.boolean
= true;
1377 oberon_assert_token(ctx
, TRUE
);
1380 expr
= oberon_new_item(MODE_BOOLEAN
, ctx
-> bool_type
, 1);
1381 expr
-> item
.boolean
= false;
1382 oberon_assert_token(ctx
, FALSE
);
1385 oberon_assert_token(ctx
, LPAREN
);
1386 expr
= oberon_expr(ctx
);
1387 oberon_assert_token(ctx
, RPAREN
);
1390 oberon_assert_token(ctx
, NOT
);
1391 expr
= oberon_factor(ctx
);
1392 expr
= oberon_make_unary_op(ctx
, NOT
, expr
);
1395 oberon_assert_token(ctx
, NIL
);
1396 expr
= oberon_new_item(MODE_NIL
, ctx
-> void_ptr_type
, 1);
1399 oberon_error(ctx
, "invalid expression");
1405 #define ITMAKESBOOLEAN(x) \
1406 (((x) >= EQUAL && (x) <= GEQ) || ((x) == OR) || ((x) == AND))
1408 #define ITUSEONLYINTEGER(x) \
1409 ((x) >= LESS && (x) <= GEQ)
1411 #define ITUSEONLYBOOLEAN(x) \
1412 (((x) == OR) || ((x) == AND))
1415 oberon_autocast_to_real(oberon_context_t
* ctx
, oberon_expr_t
** e
)
1417 oberon_expr_t
* expr
= *e
;
1418 if(expr
-> result
-> class == OBERON_TYPE_INTEGER
)
1420 if(expr
-> result
-> size
<= ctx
-> real_type
-> size
)
1422 *e
= oberon_cast_expr(ctx
, expr
, ctx
-> real_type
);
1426 *e
= oberon_cast_expr(ctx
, expr
, ctx
-> longreal_type
);
1429 else if(expr
-> result
-> class != OBERON_TYPE_REAL
)
1431 oberon_error(ctx
, "required numeric type");
1435 static oberon_expr_t
*
1436 oberon_make_bin_op(oberon_context_t
* ctx
, int token
, oberon_expr_t
* a
, oberon_expr_t
* b
)
1438 oberon_expr_t
* expr
;
1439 oberon_type_t
* result
;
1441 if(ITMAKESBOOLEAN(token
))
1443 if(ITUSEONLYINTEGER(token
))
1445 if(a
-> result
-> class == OBERON_TYPE_INTEGER
1446 || b
-> result
-> class == OBERON_TYPE_INTEGER
1447 || a
-> result
-> class == OBERON_TYPE_REAL
1448 || b
-> result
-> class == OBERON_TYPE_REAL
)
1450 oberon_error(ctx
, "used only with numeric types");
1453 else if(ITUSEONLYBOOLEAN(token
))
1455 if(a
-> result
-> class != OBERON_TYPE_BOOLEAN
1456 || b
-> result
-> class != OBERON_TYPE_BOOLEAN
)
1458 oberon_error(ctx
, "used only with boolean type");
1462 oberon_autocast_binary_op(ctx
, &a
, &b
);
1463 result
= ctx
-> bool_type
;
1467 expr
= oberon_new_operator(OP_EQ
, result
, a
, b
);
1469 else if(token
== NEQ
)
1471 expr
= oberon_new_operator(OP_NEQ
, result
, a
, b
);
1473 else if(token
== LESS
)
1475 expr
= oberon_new_operator(OP_LSS
, result
, a
, b
);
1477 else if(token
== LEQ
)
1479 expr
= oberon_new_operator(OP_LEQ
, result
, a
, b
);
1481 else if(token
== GREAT
)
1483 expr
= oberon_new_operator(OP_GRT
, result
, a
, b
);
1485 else if(token
== GEQ
)
1487 expr
= oberon_new_operator(OP_GEQ
, result
, a
, b
);
1489 else if(token
== OR
)
1491 expr
= oberon_new_operator(OP_LOGIC_OR
, result
, a
, b
);
1493 else if(token
== AND
)
1495 expr
= oberon_new_operator(OP_LOGIC_AND
, result
, a
, b
);
1499 oberon_error(ctx
, "oberon_make_bin_op: bool wat");
1502 else if(token
== SLASH
)
1504 oberon_autocast_to_real(ctx
, &a
);
1505 oberon_autocast_to_real(ctx
, &b
);
1506 oberon_autocast_binary_op(ctx
, &a
, &b
);
1507 expr
= oberon_new_operator(OP_DIV
, a
-> result
, a
, b
);
1509 else if(token
== DIV
)
1511 if(a
-> result
-> class != OBERON_TYPE_INTEGER
1512 || b
-> result
-> class != OBERON_TYPE_INTEGER
)
1514 oberon_error(ctx
, "operator DIV requires integer type");
1517 oberon_autocast_binary_op(ctx
, &a
, &b
);
1518 expr
= oberon_new_operator(OP_DIV
, a
-> result
, a
, b
);
1522 oberon_autocast_binary_op(ctx
, &a
, &b
);
1526 expr
= oberon_new_operator(OP_ADD
, a
-> result
, a
, b
);
1528 else if(token
== MINUS
)
1530 expr
= oberon_new_operator(OP_SUB
, a
-> result
, a
, b
);
1532 else if(token
== STAR
)
1534 expr
= oberon_new_operator(OP_MUL
, a
-> result
, a
, b
);
1536 else if(token
== MOD
)
1538 expr
= oberon_new_operator(OP_MOD
, a
-> result
, a
, b
);
1542 oberon_error(ctx
, "oberon_make_bin_op: bin wat");
1549 #define ISMULOP(x) \
1550 ((x) >= STAR && (x) <= AND)
1552 static oberon_expr_t
*
1553 oberon_term_expr(oberon_context_t
* ctx
)
1555 oberon_expr_t
* expr
;
1557 expr
= oberon_factor(ctx
);
1558 while(ISMULOP(ctx
-> token
))
1560 int token
= ctx
-> token
;
1561 oberon_read_token(ctx
);
1563 oberon_expr_t
* inter
= oberon_factor(ctx
);
1564 expr
= oberon_make_bin_op(ctx
, token
, expr
, inter
);
1570 #define ISADDOP(x) \
1571 ((x) >= PLUS && (x) <= OR)
1573 static oberon_expr_t
*
1574 oberon_simple_expr(oberon_context_t
* ctx
)
1576 oberon_expr_t
* expr
;
1579 if(ctx
-> token
== PLUS
)
1582 oberon_assert_token(ctx
, PLUS
);
1584 else if(ctx
-> token
== MINUS
)
1587 oberon_assert_token(ctx
, MINUS
);
1590 expr
= oberon_term_expr(ctx
);
1594 expr
= oberon_make_unary_op(ctx
, MINUS
, expr
);
1597 while(ISADDOP(ctx
-> token
))
1599 int token
= ctx
-> token
;
1600 oberon_read_token(ctx
);
1602 oberon_expr_t
* inter
= oberon_term_expr(ctx
);
1603 expr
= oberon_make_bin_op(ctx
, token
, expr
, inter
);
1609 #define ISRELATION(x) \
1610 ((x) >= EQUAL && (x) <= GEQ)
1612 static oberon_expr_t
*
1613 oberon_expr(oberon_context_t
* ctx
)
1615 oberon_expr_t
* expr
;
1617 expr
= oberon_simple_expr(ctx
);
1618 while(ISRELATION(ctx
-> token
))
1620 int token
= ctx
-> token
;
1621 oberon_read_token(ctx
);
1623 oberon_expr_t
* inter
= oberon_simple_expr(ctx
);
1624 expr
= oberon_make_bin_op(ctx
, token
, expr
, inter
);
1630 static oberon_item_t
*
1631 oberon_const_expr(oberon_context_t
* ctx
)
1633 oberon_expr_t
* expr
;
1634 expr
= oberon_expr(ctx
);
1636 if(expr
-> is_item
== 0)
1638 oberon_error(ctx
, "const expression are required");
1641 return (oberon_item_t
*) expr
;
1644 // =======================================================================
1646 // =======================================================================
1648 static void oberon_decl_seq(oberon_context_t
* ctx
);
1649 static void oberon_statement_seq(oberon_context_t
* ctx
);
1650 static void oberon_initialize_decl(oberon_context_t
* ctx
);
1653 oberon_expect_token(oberon_context_t
* ctx
, int token
)
1655 if(ctx
-> token
!= token
)
1657 oberon_error(ctx
, "unexpected token %i (%i)", ctx
-> token
, token
);
1662 oberon_assert_token(oberon_context_t
* ctx
, int token
)
1664 oberon_expect_token(ctx
, token
);
1665 oberon_read_token(ctx
);
1669 oberon_assert_ident(oberon_context_t
* ctx
)
1671 oberon_expect_token(ctx
, IDENT
);
1672 char * ident
= ctx
-> string
;
1673 oberon_read_token(ctx
);
1678 oberon_def(oberon_context_t
* ctx
, int * export
, int * read_only
)
1680 switch(ctx
-> token
)
1683 oberon_assert_token(ctx
, STAR
);
1688 oberon_assert_token(ctx
, MINUS
);
1699 static oberon_object_t
*
1700 oberon_ident_def(oberon_context_t
* ctx
, int class)
1705 oberon_object_t
* x
;
1707 name
= oberon_assert_ident(ctx
);
1708 oberon_def(ctx
, &export
, &read_only
);
1710 x
= oberon_define_object(ctx
-> decl
, name
, class, export
, read_only
);
1715 oberon_ident_list(oberon_context_t
* ctx
, int class, int * num
, oberon_object_t
** list
)
1718 *list
= oberon_ident_def(ctx
, class);
1719 while(ctx
-> token
== COMMA
)
1721 oberon_assert_token(ctx
, COMMA
);
1722 oberon_ident_def(ctx
, class);
1728 oberon_var_decl(oberon_context_t
* ctx
)
1731 oberon_object_t
* list
;
1732 oberon_type_t
* type
;
1733 type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1735 oberon_ident_list(ctx
, OBERON_CLASS_VAR
, &num
, &list
);
1736 oberon_assert_token(ctx
, COLON
);
1737 oberon_type(ctx
, &type
);
1739 oberon_object_t
* var
= list
;
1740 for(int i
= 0; i
< num
; i
++)
1747 static oberon_object_t
*
1748 oberon_fp_section(oberon_context_t
* ctx
, int * num_decl
)
1750 int class = OBERON_CLASS_PARAM
;
1751 if(ctx
-> token
== VAR
)
1753 oberon_read_token(ctx
);
1754 class = OBERON_CLASS_VAR_PARAM
;
1758 oberon_object_t
* list
;
1759 oberon_ident_list(ctx
, class, &num
, &list
);
1761 oberon_assert_token(ctx
, COLON
);
1763 oberon_type_t
* type
;
1764 type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1765 oberon_type(ctx
, &type
);
1767 oberon_object_t
* param
= list
;
1768 for(int i
= 0; i
< num
; i
++)
1770 param
-> type
= type
;
1771 param
= param
-> next
;
1778 #define ISFPSECTION \
1779 ((ctx -> token == VAR) || (ctx -> token == IDENT))
1782 oberon_formal_pars(oberon_context_t
* ctx
, oberon_type_t
* signature
)
1784 oberon_assert_token(ctx
, LPAREN
);
1788 signature
-> decl
= oberon_fp_section(ctx
, &signature
-> num_decl
);
1789 while(ctx
-> token
== SEMICOLON
)
1791 oberon_assert_token(ctx
, SEMICOLON
);
1792 oberon_fp_section(ctx
, &signature
-> num_decl
);
1796 oberon_assert_token(ctx
, RPAREN
);
1798 if(ctx
-> token
== COLON
)
1800 oberon_assert_token(ctx
, COLON
);
1802 oberon_object_t
* typeobj
;
1803 typeobj
= oberon_qualident(ctx
, NULL
, 1);
1804 if(typeobj
-> class != OBERON_CLASS_TYPE
)
1806 oberon_error(ctx
, "function result is not type");
1808 signature
-> base
= typeobj
-> type
;
1813 oberon_opt_formal_pars(oberon_context_t
* ctx
, oberon_type_t
** type
)
1815 oberon_type_t
* signature
;
1817 signature
-> class = OBERON_TYPE_PROCEDURE
;
1818 signature
-> num_decl
= 0;
1819 signature
-> base
= ctx
-> void_type
;
1820 signature
-> decl
= NULL
;
1822 if(ctx
-> token
== LPAREN
)
1824 oberon_formal_pars(ctx
, signature
);
1829 oberon_compare_signatures(oberon_context_t
* ctx
, oberon_type_t
* a
, oberon_type_t
* b
)
1831 if(a
-> num_decl
!= b
-> num_decl
)
1833 oberon_error(ctx
, "number parameters not matched");
1836 int num_param
= a
-> num_decl
;
1837 oberon_object_t
* param_a
= a
-> decl
;
1838 oberon_object_t
* param_b
= b
-> decl
;
1839 for(int i
= 0; i
< num_param
; i
++)
1841 if(strcmp(param_a
-> name
, param_b
-> name
) != 0)
1843 oberon_error(ctx
, "param %i name not matched", i
+ 1);
1846 if(param_a
-> type
!= param_b
-> type
)
1848 oberon_error(ctx
, "param %i type not matched", i
+ 1);
1851 param_a
= param_a
-> next
;
1852 param_b
= param_b
-> next
;
1857 oberon_make_return(oberon_context_t
* ctx
, oberon_expr_t
* expr
)
1859 oberon_object_t
* proc
= ctx
-> decl
-> parent
;
1860 oberon_type_t
* result_type
= proc
-> type
-> base
;
1862 if(result_type
-> class == OBERON_TYPE_VOID
)
1866 oberon_error(ctx
, "procedure has no result type");
1873 oberon_error(ctx
, "procedure requires expression on result");
1876 expr
= oberon_autocast_to(ctx
, expr
, result_type
);
1879 proc
-> has_return
= 1;
1881 oberon_generate_return(ctx
, expr
);
1885 oberon_proc_decl_body(oberon_context_t
* ctx
, oberon_object_t
* proc
)
1887 oberon_assert_token(ctx
, SEMICOLON
);
1889 ctx
-> decl
= proc
-> scope
;
1891 oberon_decl_seq(ctx
);
1893 oberon_generate_begin_proc(ctx
, proc
);
1895 if(ctx
-> token
== BEGIN
)
1897 oberon_assert_token(ctx
, BEGIN
);
1898 oberon_statement_seq(ctx
);
1901 oberon_assert_token(ctx
, END
);
1902 char * name
= oberon_assert_ident(ctx
);
1903 if(strcmp(name
, proc
-> name
) != 0)
1905 oberon_error(ctx
, "procedure name not matched");
1908 if(proc
-> type
-> base
-> class == OBERON_TYPE_VOID
1909 && proc
-> has_return
== 0)
1911 oberon_make_return(ctx
, NULL
);
1914 if(proc
-> has_return
== 0)
1916 oberon_error(ctx
, "procedure requires return");
1919 oberon_generate_end_proc(ctx
);
1920 oberon_close_scope(ctx
-> decl
);
1924 oberon_proc_decl(oberon_context_t
* ctx
)
1926 oberon_assert_token(ctx
, PROCEDURE
);
1929 if(ctx
-> token
== UPARROW
)
1931 oberon_assert_token(ctx
, UPARROW
);
1938 name
= oberon_assert_ident(ctx
);
1939 oberon_def(ctx
, &export
, &read_only
);
1941 oberon_scope_t
* proc_scope
;
1942 proc_scope
= oberon_open_scope(ctx
);
1943 ctx
-> decl
-> local
= 1;
1945 oberon_type_t
* signature
;
1946 signature
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
1947 oberon_opt_formal_pars(ctx
, &signature
);
1949 oberon_initialize_decl(ctx
);
1950 oberon_generator_init_type(ctx
, signature
);
1951 oberon_close_scope(ctx
-> decl
);
1953 oberon_object_t
* proc
;
1954 proc
= oberon_find_object(ctx
-> decl
, name
, 0);
1957 if(proc
-> class != OBERON_CLASS_PROC
)
1959 oberon_error(ctx
, "mult definition");
1966 oberon_error(ctx
, "mult procedure definition");
1970 if(proc
-> export
!= export
|| proc
-> read_only
!= read_only
)
1972 oberon_error(ctx
, "export type not matched");
1975 oberon_compare_signatures(ctx
, proc
-> type
, signature
);
1979 proc
= oberon_define_object(ctx
-> decl
, name
, OBERON_CLASS_PROC
, export
, read_only
);
1980 proc
-> type
= signature
;
1981 proc
-> scope
= proc_scope
;
1982 oberon_generator_init_proc(ctx
, proc
);
1985 proc
-> scope
-> parent
= proc
;
1990 oberon_proc_decl_body(ctx
, proc
);
1995 oberon_const_decl(oberon_context_t
* ctx
)
1997 oberon_item_t
* value
;
1998 oberon_object_t
* constant
;
2000 constant
= oberon_ident_def(ctx
, OBERON_CLASS_CONST
);
2001 oberon_assert_token(ctx
, EQUAL
);
2002 value
= oberon_const_expr(ctx
);
2003 constant
-> value
= value
;
2007 oberon_make_array_type(oberon_context_t
* ctx
, oberon_expr_t
* size
, oberon_type_t
* base
, oberon_type_t
** type
)
2009 if(size
-> is_item
== 0)
2011 oberon_error(ctx
, "requires constant");
2014 if(size
-> item
.mode
!= MODE_INTEGER
)
2016 oberon_error(ctx
, "requires integer constant");
2019 oberon_type_t
* arr
;
2021 arr
-> class = OBERON_TYPE_ARRAY
;
2022 arr
-> size
= size
-> item
.integer
;
2027 oberon_field_list(oberon_context_t
* ctx
, oberon_type_t
* rec
)
2029 if(ctx
-> token
== IDENT
)
2032 oberon_object_t
* list
;
2033 oberon_type_t
* type
;
2034 type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
2036 oberon_ident_list(ctx
, OBERON_CLASS_FIELD
, &num
, &list
);
2037 oberon_assert_token(ctx
, COLON
);
2038 oberon_type(ctx
, &type
);
2040 oberon_object_t
* field
= list
;
2041 for(int i
= 0; i
< num
; i
++)
2043 field
-> type
= type
;
2044 field
= field
-> next
;
2047 rec
-> num_decl
+= num
;
2052 oberon_qualident_type(oberon_context_t
* ctx
, oberon_type_t
** type
)
2055 oberon_object_t
* to
;
2057 to
= oberon_qualident(ctx
, &name
, 0);
2059 //name = oberon_assert_ident(ctx);
2060 //to = oberon_find_object(ctx -> decl, name, 0);
2064 if(to
-> class != OBERON_CLASS_TYPE
)
2066 oberon_error(ctx
, "not a type");
2071 to
= oberon_define_object(ctx
-> decl
, name
, OBERON_CLASS_TYPE
, 0, 0);
2072 to
-> type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
2078 static void oberon_opt_formal_pars(oberon_context_t
* ctx
, oberon_type_t
** type
);
2081 * Правило граматики "type". Указатель type должен указывать на существующий объект!
2085 oberon_make_multiarray(oberon_context_t
* ctx
, oberon_expr_t
* sizes
, oberon_type_t
* base
, oberon_type_t
** type
)
2093 oberon_type_t
* dim
;
2094 dim
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
2096 oberon_make_multiarray(ctx
, sizes
-> next
, base
, &dim
);
2098 oberon_make_array_type(ctx
, sizes
, dim
, type
);
2102 oberon_make_open_array(oberon_context_t
* ctx
, oberon_type_t
* base
, oberon_type_t
* type
)
2104 type
-> class = OBERON_TYPE_ARRAY
;
2106 type
-> base
= base
;
2110 oberon_type(oberon_context_t
* ctx
, oberon_type_t
** type
)
2112 if(ctx
-> token
== IDENT
)
2114 oberon_qualident_type(ctx
, type
);
2116 else if(ctx
-> token
== ARRAY
)
2118 oberon_assert_token(ctx
, ARRAY
);
2121 oberon_expr_t
* sizes
;
2123 if(ISEXPR(ctx
-> token
))
2125 oberon_expr_list(ctx
, &num_sizes
, &sizes
, 1);
2128 oberon_assert_token(ctx
, OF
);
2130 oberon_type_t
* base
;
2131 base
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
2132 oberon_type(ctx
, &base
);
2136 oberon_make_open_array(ctx
, base
, *type
);
2140 oberon_make_multiarray(ctx
, sizes
, base
, type
);
2143 else if(ctx
-> token
== RECORD
)
2145 oberon_type_t
* rec
;
2147 rec
-> class = OBERON_TYPE_RECORD
;
2148 rec
-> module
= ctx
-> mod
;
2150 oberon_scope_t
* record_scope
;
2151 record_scope
= oberon_open_scope(ctx
);
2152 record_scope
-> local
= 1;
2153 record_scope
-> parent
= NULL
;
2154 record_scope
-> parent_type
= rec
;
2156 oberon_assert_token(ctx
, RECORD
);
2157 oberon_field_list(ctx
, rec
);
2158 while(ctx
-> token
== SEMICOLON
)
2160 oberon_assert_token(ctx
, SEMICOLON
);
2161 oberon_field_list(ctx
, rec
);
2163 oberon_assert_token(ctx
, END
);
2165 rec
-> decl
= record_scope
-> list
-> next
;
2166 oberon_close_scope(record_scope
);
2170 else if(ctx
-> token
== POINTER
)
2172 oberon_assert_token(ctx
, POINTER
);
2173 oberon_assert_token(ctx
, TO
);
2175 oberon_type_t
* base
;
2176 base
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
2177 oberon_type(ctx
, &base
);
2179 oberon_type_t
* ptr
;
2181 ptr
-> class = OBERON_TYPE_POINTER
;
2184 else if(ctx
-> token
== PROCEDURE
)
2186 oberon_open_scope(ctx
);
2187 oberon_assert_token(ctx
, PROCEDURE
);
2188 oberon_opt_formal_pars(ctx
, type
);
2189 oberon_close_scope(ctx
-> decl
);
2193 oberon_error(ctx
, "invalid type declaration");
2198 oberon_type_decl(oberon_context_t
* ctx
)
2201 oberon_object_t
* newtype
;
2202 oberon_type_t
* type
;
2206 name
= oberon_assert_ident(ctx
);
2207 oberon_def(ctx
, &export
, &read_only
);
2209 newtype
= oberon_find_object(ctx
-> decl
, name
, 0);
2212 newtype
= oberon_define_object(ctx
-> decl
, name
, OBERON_CLASS_TYPE
, export
, read_only
);
2213 newtype
-> type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
2214 assert(newtype
-> type
);
2218 if(newtype
-> class != OBERON_CLASS_TYPE
)
2220 oberon_error(ctx
, "mult definition");
2223 if(newtype
-> linked
)
2225 oberon_error(ctx
, "mult definition - already linked");
2228 newtype
-> export
= export
;
2229 newtype
-> read_only
= read_only
;
2232 oberon_assert_token(ctx
, EQUAL
);
2234 type
= newtype
-> type
;
2235 oberon_type(ctx
, &type
);
2237 if(type
-> class == OBERON_TYPE_VOID
)
2239 oberon_error(ctx
, "recursive alias declaration");
2242 newtype
-> type
= type
;
2243 newtype
-> linked
= 1;
2246 static void oberon_prevent_recursive_object(oberon_context_t
* ctx
, oberon_object_t
* x
);
2247 static void oberon_prevent_recursive_type(oberon_context_t
* ctx
, oberon_type_t
* type
);
2250 oberon_prevent_recursive_pointer(oberon_context_t
* ctx
, oberon_type_t
* type
)
2252 if(type
-> class != OBERON_TYPE_POINTER
2253 && type
-> class != OBERON_TYPE_ARRAY
)
2258 if(type
-> recursive
)
2260 oberon_error(ctx
, "recursive pointer declaration");
2263 if(type
-> class == OBERON_TYPE_POINTER
2264 && type
-> base
-> class == OBERON_TYPE_POINTER
)
2266 oberon_error(ctx
, "attempt to make pointer to pointer");
2269 type
-> recursive
= 1;
2271 oberon_prevent_recursive_pointer(ctx
, type
-> base
);
2273 type
-> recursive
= 0;
2277 oberon_prevent_recursive_record(oberon_context_t
* ctx
, oberon_type_t
* type
)
2279 if(type
-> class != OBERON_TYPE_RECORD
)
2284 if(type
-> recursive
)
2286 oberon_error(ctx
, "recursive record declaration");
2289 type
-> recursive
= 1;
2291 int num_fields
= type
-> num_decl
;
2292 oberon_object_t
* field
= type
-> decl
;
2293 for(int i
= 0; i
< num_fields
; i
++)
2295 oberon_prevent_recursive_object(ctx
, field
);
2296 field
= field
-> next
;
2299 type
-> recursive
= 0;
2302 oberon_prevent_recursive_procedure(oberon_context_t
* ctx
, oberon_type_t
* type
)
2304 if(type
-> class != OBERON_TYPE_PROCEDURE
)
2309 if(type
-> recursive
)
2311 oberon_error(ctx
, "recursive procedure declaration");
2314 type
-> recursive
= 1;
2316 int num_fields
= type
-> num_decl
;
2317 oberon_object_t
* field
= type
-> decl
;
2318 for(int i
= 0; i
< num_fields
; i
++)
2320 oberon_prevent_recursive_object(ctx
, field
);
2321 field
= field
-> next
;
2324 type
-> recursive
= 0;
2328 oberon_prevent_recursive_array(oberon_context_t
* ctx
, oberon_type_t
* type
)
2330 if(type
-> class != OBERON_TYPE_ARRAY
)
2335 if(type
-> recursive
)
2337 oberon_error(ctx
, "recursive array declaration");
2340 type
-> recursive
= 1;
2342 oberon_prevent_recursive_type(ctx
, type
-> base
);
2344 type
-> recursive
= 0;
2348 oberon_prevent_recursive_type(oberon_context_t
* ctx
, oberon_type_t
* type
)
2350 if(type
-> class == OBERON_TYPE_POINTER
)
2352 oberon_prevent_recursive_pointer(ctx
, type
);
2354 else if(type
-> class == OBERON_TYPE_RECORD
)
2356 oberon_prevent_recursive_record(ctx
, type
);
2358 else if(type
-> class == OBERON_TYPE_ARRAY
)
2360 oberon_prevent_recursive_array(ctx
, type
);
2362 else if(type
-> class == OBERON_TYPE_PROCEDURE
)
2364 oberon_prevent_recursive_procedure(ctx
, type
);
2369 oberon_prevent_recursive_object(oberon_context_t
* ctx
, oberon_object_t
* x
)
2373 case OBERON_CLASS_VAR
:
2374 case OBERON_CLASS_TYPE
:
2375 case OBERON_CLASS_PARAM
:
2376 case OBERON_CLASS_VAR_PARAM
:
2377 case OBERON_CLASS_FIELD
:
2378 oberon_prevent_recursive_type(ctx
, x
-> type
);
2380 case OBERON_CLASS_CONST
:
2381 case OBERON_CLASS_PROC
:
2382 case OBERON_CLASS_MODULE
:
2385 oberon_error(ctx
, "oberon_prevent_recursive_object: wat");
2391 oberon_prevent_recursive_decl(oberon_context_t
* ctx
)
2393 oberon_object_t
* x
= ctx
-> decl
-> list
-> next
;
2397 oberon_prevent_recursive_object(ctx
, x
);
2402 static void oberon_initialize_object(oberon_context_t
* ctx
, oberon_object_t
* x
);
2403 static void oberon_initialize_type(oberon_context_t
* ctx
, oberon_type_t
* type
);
2406 oberon_initialize_record_fields(oberon_context_t
* ctx
, oberon_type_t
* type
)
2408 if(type
-> class != OBERON_TYPE_RECORD
)
2413 int num_fields
= type
-> num_decl
;
2414 oberon_object_t
* field
= type
-> decl
;
2415 for(int i
= 0; i
< num_fields
; i
++)
2417 if(field
-> type
-> class == OBERON_TYPE_POINTER
)
2419 oberon_initialize_type(ctx
, field
-> type
);
2422 oberon_initialize_object(ctx
, field
);
2423 field
= field
-> next
;
2426 oberon_generator_init_record(ctx
, type
);
2430 oberon_initialize_type(oberon_context_t
* ctx
, oberon_type_t
* type
)
2432 if(type
-> class == OBERON_TYPE_VOID
)
2434 oberon_error(ctx
, "undeclarated type");
2437 if(type
-> initialized
)
2442 type
-> initialized
= 1;
2444 if(type
-> class == OBERON_TYPE_POINTER
)
2446 oberon_initialize_type(ctx
, type
-> base
);
2447 oberon_generator_init_type(ctx
, type
);
2449 else if(type
-> class == OBERON_TYPE_ARRAY
)
2451 if(type
-> size
!= 0)
2453 if(type
-> base
-> class == OBERON_TYPE_ARRAY
)
2455 if(type
-> base
-> size
== 0)
2457 oberon_error(ctx
, "open array not allowed as array element");
2462 oberon_initialize_type(ctx
, type
-> base
);
2463 oberon_generator_init_type(ctx
, type
);
2465 else if(type
-> class == OBERON_TYPE_RECORD
)
2467 oberon_generator_init_type(ctx
, type
);
2468 oberon_initialize_record_fields(ctx
, type
);
2470 else if(type
-> class == OBERON_TYPE_PROCEDURE
)
2472 int num_fields
= type
-> num_decl
;
2473 oberon_object_t
* field
= type
-> decl
;
2474 for(int i
= 0; i
< num_fields
; i
++)
2476 oberon_initialize_object(ctx
, field
);
2477 field
= field
-> next
;
2480 oberon_generator_init_type(ctx
, type
);
2484 oberon_generator_init_type(ctx
, type
);
2489 oberon_initialize_object(oberon_context_t
* ctx
, oberon_object_t
* x
)
2491 if(x
-> initialized
)
2496 x
-> initialized
= 1;
2500 case OBERON_CLASS_TYPE
:
2501 oberon_initialize_type(ctx
, x
-> type
);
2503 case OBERON_CLASS_VAR
:
2504 case OBERON_CLASS_FIELD
:
2505 if(x
-> type
-> class == OBERON_TYPE_ARRAY
)
2507 if(x
-> type
-> size
== 0)
2509 oberon_error(ctx
, "open array not allowed as variable or field");
2512 oberon_initialize_type(ctx
, x
-> type
);
2513 oberon_generator_init_var(ctx
, x
);
2515 case OBERON_CLASS_PARAM
:
2516 case OBERON_CLASS_VAR_PARAM
:
2517 oberon_initialize_type(ctx
, x
-> type
);
2518 oberon_generator_init_var(ctx
, x
);
2520 case OBERON_CLASS_CONST
:
2521 case OBERON_CLASS_PROC
:
2522 case OBERON_CLASS_MODULE
:
2525 oberon_error(ctx
, "oberon_initialize_object: wat");
2531 oberon_initialize_decl(oberon_context_t
* ctx
)
2533 oberon_object_t
* x
= ctx
-> decl
-> list
;
2537 oberon_initialize_object(ctx
, x
-> next
);
2543 oberon_prevent_undeclarated_procedures(oberon_context_t
* ctx
)
2545 oberon_object_t
* x
= ctx
-> decl
-> list
;
2549 if(x
-> next
-> class == OBERON_CLASS_PROC
)
2551 if(x
-> next
-> linked
== 0)
2553 oberon_error(ctx
, "unresolved forward declaration");
2561 oberon_decl_seq(oberon_context_t
* ctx
)
2563 if(ctx
-> token
== CONST
)
2565 oberon_assert_token(ctx
, CONST
);
2566 while(ctx
-> token
== IDENT
)
2568 oberon_const_decl(ctx
);
2569 oberon_assert_token(ctx
, SEMICOLON
);
2573 if(ctx
-> token
== TYPE
)
2575 oberon_assert_token(ctx
, TYPE
);
2576 while(ctx
-> token
== IDENT
)
2578 oberon_type_decl(ctx
);
2579 oberon_assert_token(ctx
, SEMICOLON
);
2583 if(ctx
-> token
== VAR
)
2585 oberon_assert_token(ctx
, VAR
);
2586 while(ctx
-> token
== IDENT
)
2588 oberon_var_decl(ctx
);
2589 oberon_assert_token(ctx
, SEMICOLON
);
2593 oberon_prevent_recursive_decl(ctx
);
2594 oberon_initialize_decl(ctx
);
2596 while(ctx
-> token
== PROCEDURE
)
2598 oberon_proc_decl(ctx
);
2599 oberon_assert_token(ctx
, SEMICOLON
);
2602 oberon_prevent_undeclarated_procedures(ctx
);
2606 oberon_assign(oberon_context_t
* ctx
, oberon_expr_t
* src
, oberon_expr_t
* dst
)
2608 if(dst
-> read_only
)
2610 oberon_error(ctx
, "read-only destination");
2613 src
= oberon_autocast_to(ctx
, src
, dst
-> result
);
2614 oberon_generate_assign(ctx
, src
, dst
);
2618 oberon_statement(oberon_context_t
* ctx
)
2620 oberon_expr_t
* item1
;
2621 oberon_expr_t
* item2
;
2623 if(ctx
-> token
== IDENT
)
2625 item1
= oberon_designator(ctx
);
2626 if(ctx
-> token
== ASSIGN
)
2628 oberon_assert_token(ctx
, ASSIGN
);
2629 item2
= oberon_expr(ctx
);
2630 oberon_assign(ctx
, item2
, item1
);
2634 oberon_opt_proc_parens(ctx
, item1
);
2637 else if(ctx
-> token
== RETURN
)
2639 oberon_assert_token(ctx
, RETURN
);
2640 if(ISEXPR(ctx
-> token
))
2642 oberon_expr_t
* expr
;
2643 expr
= oberon_expr(ctx
);
2644 oberon_make_return(ctx
, expr
);
2648 oberon_make_return(ctx
, NULL
);
2654 oberon_statement_seq(oberon_context_t
* ctx
)
2656 oberon_statement(ctx
);
2657 while(ctx
-> token
== SEMICOLON
)
2659 oberon_assert_token(ctx
, SEMICOLON
);
2660 oberon_statement(ctx
);
2665 oberon_import_module(oberon_context_t
* ctx
, char * alias
, char * name
)
2667 oberon_module_t
* m
= ctx
-> module_list
;
2668 while(m
&& strcmp(m
-> name
, name
) != 0)
2676 code
= ctx
-> import_module(name
);
2679 oberon_error(ctx
, "no such module");
2682 m
= oberon_compile_module(ctx
, code
);
2688 oberon_error(ctx
, "cyclic module import");
2691 oberon_object_t
* ident
;
2692 ident
= oberon_define_object(ctx
-> decl
, alias
, OBERON_CLASS_MODULE
, 0, 0);
2693 ident
-> module
= m
;
2697 oberon_import_decl(oberon_context_t
* ctx
)
2702 alias
= name
= oberon_assert_ident(ctx
);
2703 if(ctx
-> token
== ASSIGN
)
2705 oberon_assert_token(ctx
, ASSIGN
);
2706 name
= oberon_assert_ident(ctx
);
2709 oberon_import_module(ctx
, alias
, name
);
2713 oberon_import_list(oberon_context_t
* ctx
)
2715 oberon_assert_token(ctx
, IMPORT
);
2717 oberon_import_decl(ctx
);
2718 while(ctx
-> token
== COMMA
)
2720 oberon_assert_token(ctx
, COMMA
);
2721 oberon_import_decl(ctx
);
2724 oberon_assert_token(ctx
, SEMICOLON
);
2728 oberon_parse_module(oberon_context_t
* ctx
)
2732 oberon_read_token(ctx
);
2734 oberon_assert_token(ctx
, MODULE
);
2735 name1
= oberon_assert_ident(ctx
);
2736 oberon_assert_token(ctx
, SEMICOLON
);
2737 ctx
-> mod
-> name
= name1
;
2739 oberon_generator_init_module(ctx
, ctx
-> mod
);
2741 if(ctx
-> token
== IMPORT
)
2743 oberon_import_list(ctx
);
2746 oberon_decl_seq(ctx
);
2748 oberon_generate_begin_module(ctx
);
2749 if(ctx
-> token
== BEGIN
)
2751 oberon_assert_token(ctx
, BEGIN
);
2752 oberon_statement_seq(ctx
);
2754 oberon_generate_end_module(ctx
);
2756 oberon_assert_token(ctx
, END
);
2757 name2
= oberon_assert_ident(ctx
);
2758 oberon_assert_token(ctx
, DOT
);
2760 if(strcmp(name1
, name2
) != 0)
2762 oberon_error(ctx
, "module name not matched");
2765 oberon_generator_fini_module(ctx
-> mod
);
2768 // =======================================================================
2770 // =======================================================================
2773 register_default_types(oberon_context_t
* ctx
)
2775 ctx
-> void_type
= oberon_new_type_ptr(OBERON_TYPE_VOID
);
2776 oberon_generator_init_type(ctx
, ctx
-> void_type
);
2778 ctx
-> void_ptr_type
= oberon_new_type_ptr(OBERON_TYPE_POINTER
);
2779 ctx
-> void_ptr_type
-> base
= ctx
-> void_type
;
2780 oberon_generator_init_type(ctx
, ctx
-> void_ptr_type
);
2782 ctx
-> bool_type
= oberon_new_type_boolean();
2783 oberon_define_type(ctx
-> world_scope
, "BOOLEAN", ctx
-> bool_type
, 1);
2785 ctx
-> byte_type
= oberon_new_type_integer(1);
2786 oberon_define_type(ctx
-> world_scope
, "BYTE", ctx
-> byte_type
, 1);
2788 ctx
-> shortint_type
= oberon_new_type_integer(2);
2789 oberon_define_type(ctx
-> world_scope
, "SHORTINT", ctx
-> shortint_type
, 1);
2791 ctx
-> int_type
= oberon_new_type_integer(4);
2792 oberon_define_type(ctx
-> world_scope
, "INTEGER", ctx
-> int_type
, 1);
2794 ctx
-> longint_type
= oberon_new_type_integer(8);
2795 oberon_define_type(ctx
-> world_scope
, "LONGINT", ctx
-> longint_type
, 1);
2797 ctx
-> real_type
= oberon_new_type_real(4);
2798 oberon_define_type(ctx
-> world_scope
, "REAL", ctx
-> real_type
, 1);
2800 ctx
-> longreal_type
= oberon_new_type_real(8);
2801 oberon_define_type(ctx
-> world_scope
, "LONGREAL", ctx
-> longreal_type
, 1);
2805 oberon_new_intrinsic(oberon_context_t
* ctx
, char * name
, GenerateFuncCallback f
, GenerateProcCallback p
)
2807 oberon_object_t
* proc
;
2808 proc
= oberon_define_object(ctx
-> decl
, name
, OBERON_CLASS_PROC
, 1, 0);
2809 proc
-> sysproc
= 1;
2810 proc
-> genfunc
= f
;
2811 proc
-> genproc
= p
;
2812 proc
-> type
= oberon_new_type_ptr(OBERON_TYPE_PROCEDURE
);
2815 static oberon_expr_t
*
2816 oberon_make_abs_call(oberon_context_t
* ctx
, int num_args
, oberon_expr_t
* list_args
)
2820 oberon_error(ctx
, "too few arguments");
2825 oberon_error(ctx
, "too mach arguments");
2828 oberon_expr_t
* arg
;
2831 oberon_type_t
* result_type
;
2832 result_type
= arg
-> result
;
2834 if(result_type
-> class != OBERON_TYPE_INTEGER
)
2836 oberon_error(ctx
, "ABS accepts only integers");
2840 oberon_expr_t
* expr
;
2841 expr
= oberon_new_operator(OP_ABS
, result_type
, arg
, NULL
);
2846 oberon_make_new_call(oberon_context_t
* ctx
, int num_args
, oberon_expr_t
* list_args
)
2850 oberon_error(ctx
, "too few arguments");
2853 oberon_expr_t
* dst
;
2856 oberon_type_t
* type
;
2857 type
= dst
-> result
;
2859 if(type
-> class != OBERON_TYPE_POINTER
)
2861 oberon_error(ctx
, "not a pointer");
2864 type
= type
-> base
;
2866 oberon_expr_t
* src
;
2867 src
= oberon_new_item(MODE_NEW
, dst
-> result
, 0);
2868 src
-> item
.num_args
= 0;
2869 src
-> item
.args
= NULL
;
2872 if(type
-> class == OBERON_TYPE_ARRAY
)
2874 if(type
-> size
== 0)
2876 oberon_type_t
* x
= type
;
2877 while(x
-> class == OBERON_TYPE_ARRAY
)
2887 if(num_args
< max_args
)
2889 oberon_error(ctx
, "too few arguments");
2892 if(num_args
> max_args
)
2894 oberon_error(ctx
, "too mach arguments");
2897 int num_sizes
= max_args
- 1;
2898 oberon_expr_t
* size_list
= list_args
-> next
;
2900 oberon_expr_t
* arg
= size_list
;
2901 for(int i
= 0; i
< max_args
- 1; i
++)
2903 if(arg
-> result
-> class != OBERON_TYPE_INTEGER
)
2905 oberon_error(ctx
, "size must be integer");
2910 src
-> item
.num_args
= num_sizes
;
2911 src
-> item
.args
= size_list
;
2913 else if(type
-> class != OBERON_TYPE_RECORD
)
2915 oberon_error(ctx
, "oberon_make_new_call: wat");
2918 if(num_args
> max_args
)
2920 oberon_error(ctx
, "too mach arguments");
2923 oberon_assign(ctx
, src
, dst
);
2927 oberon_create_context(ModuleImportCallback import_module
)
2929 oberon_context_t
* ctx
= calloc(1, sizeof *ctx
);
2931 oberon_scope_t
* world_scope
;
2932 world_scope
= oberon_open_scope(ctx
);
2933 ctx
-> world_scope
= world_scope
;
2935 ctx
-> import_module
= import_module
;
2937 oberon_generator_init_context(ctx
);
2939 register_default_types(ctx
);
2940 oberon_new_intrinsic(ctx
, "ABS", oberon_make_abs_call
, NULL
);
2941 oberon_new_intrinsic(ctx
, "NEW", NULL
, oberon_make_new_call
);
2947 oberon_destroy_context(oberon_context_t
* ctx
)
2949 oberon_generator_destroy_context(ctx
);
2954 oberon_compile_module(oberon_context_t
* ctx
, const char * newcode
)
2956 const char * code
= ctx
-> code
;
2957 int code_index
= ctx
-> code_index
;
2959 int token
= ctx
-> token
;
2960 char * string
= ctx
-> string
;
2961 int integer
= ctx
-> integer
;
2962 int real
= ctx
-> real
;
2963 bool longmode
= ctx
-> longmode
;
2964 oberon_scope_t
* decl
= ctx
-> decl
;
2965 oberon_module_t
* mod
= ctx
-> mod
;
2967 oberon_scope_t
* module_scope
;
2968 module_scope
= oberon_open_scope(ctx
);
2970 oberon_module_t
* module
;
2971 module
= calloc(1, sizeof *module
);
2972 module
-> decl
= module_scope
;
2973 module
-> next
= ctx
-> module_list
;
2975 ctx
-> mod
= module
;
2976 ctx
-> module_list
= module
;
2978 oberon_init_scaner(ctx
, newcode
);
2979 oberon_parse_module(ctx
);
2981 module
-> ready
= 1;
2984 ctx
-> code_index
= code_index
;
2986 ctx
-> token
= token
;
2987 ctx
-> string
= string
;
2988 ctx
-> integer
= integer
;
2990 ctx
-> longmode
= longmode
;