summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: b224b07)
raw | patch | inline | side by side (parent: b224b07)
author | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
Tue, 1 Aug 2017 13:12:51 +0000 (16:12 +0300) | ||
committer | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
Tue, 1 Aug 2017 13:12:51 +0000 (16:12 +0300) |
index 7092150dcbbcf53b3179614ba6ea19146adad7ac..b5807454b9f6849b23ed85054ec25bf24ce27f26 100644 (file)
--- a/notes
+++ b/notes
-- Какие-то проблемы с определением типов наперёд:
- (*
- TYPE
- R2 = RECORD r : R1 END;
- R1 = RECORD END;
- *)
+- Нет оператора IS
+- Нет ручного каста записей
+- Нет автокаста записей
- Нужно изменить передачу информации о вызываемой процедуре в MODE_CALL
На данный момент конкретная процедура передаётся в поле var, вместо parent
Что не позволяет делать процедуры-переменные в полях записей, массивах и т.д.
- нет символов и строк
-- не реализовано расширение типа record
- нету типа set
- нету операторов if, while и т.д.
index 581faf92c302bab84ce601e5087eeb39e480d4ef..d99d1da62349514679fb9c298011c6c9fce099d1 100644 (file)
fprintf(class -> fp, ".source %s\n", rec -> module -> name);
fprintf(class -> fp, ".class public %s\n", cname);
- fprintf(class -> fp, ".super java/lang/Object\n\n");
+
+ if(rec -> base == NULL)
+ {
+ fprintf(class -> fp, ".super java/lang/Object\n\n");
+ }
+ else
+ {
+ class -> base = rec -> base -> gen_type -> class;
+ fprintf(class -> fp, ".super %s\n\n", class -> base -> full_name);
+ }
rec -> gen_type -> class = class;
}
jvm_generate_function_header(p, "public", "<init>", "()V");
jvm_alloc_register_untyped(p -> rf, false);
jvm_generate(p, 0, 1, "aload_0");
- jvm_generate(p, 1, 0, "invokespecial java/lang/Object/<init>()V");
+ if(class -> base)
+ {
+ jvm_generate(p, 1, 0, "invokespecial %s/<init>()V", class -> base -> full_name);
+ }
+ else
+ {
+ jvm_generate(p, 1, 0, "invokespecial java/lang/Object/<init>()V");
+ }
num = rec -> num_decl;
field = rec -> decl;
for(int i = 0; i < num; i++)
index ad1b982a328113ba8a7a130db22c5a9389d6eaef..67abe236f652824352f3311ed9b27b50bbfe1fca 100644 (file)
char * full_name;
FILE * fp;
gen_proc_t * p;
+ struct gen_class * base;
};
enum gen_storage
diff --git a/src/oberon-internals.h b/src/oberon-internals.h
index 5cfaa1313777e98eb45f8fac7a14406ac67cd6c5..1e92de1763923d410e342e0d21cb29ab68c2961e 100644 (file)
--- a/src/oberon-internals.h
+++ b/src/oberon-internals.h
int num_decl;
oberon_type_t * base;
oberon_object_t * decl;
+ oberon_scope_t * scope;
oberon_module_t * module;
diff --git a/src/oberon.c b/src/oberon.c
index 6a74f92c0aad16f6a3b13a6053e3e5b58e145fcc..0118ff9bfceded3989c464ed1a6f9fb59645a6be 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
ctx -> decl = scope -> up;
}
-static oberon_object_t *
-oberon_define_object(oberon_scope_t * scope, char * name, int class, int export, int read_only)
-{
- oberon_object_t * x = scope -> list;
- while(x -> next && strcmp(x -> next -> name, name) != 0)
- {
- x = x -> next;
- }
-
- if(x -> next)
- {
- oberon_error(scope -> ctx, "already defined");
- }
-
- oberon_object_t * newvar = malloc(sizeof *newvar);
- memset(newvar, 0, sizeof *newvar);
- newvar -> name = name;
- newvar -> class = class;
- newvar -> export = export;
- newvar -> read_only = read_only;
- newvar -> local = scope -> local;
- newvar -> parent = scope -> parent;
- newvar -> parent_type = scope -> parent_type;
- newvar -> module = scope -> ctx -> mod;
-
- x -> next = newvar;
-
- return newvar;
-}
-
static oberon_object_t *
oberon_find_object_in_list(oberon_object_t * list, char * name)
{
}
static oberon_object_t *
-oberon_find_object(oberon_scope_t * scope, char * name, int check_it)
+oberon_find_object(oberon_scope_t * scope, char * name, bool check_it)
{
oberon_object_t * result = NULL;
}
static oberon_object_t *
-oberon_find_field(oberon_context_t * ctx, oberon_type_t * rec, char * name)
+oberon_define_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only, bool check_upscope)
{
- oberon_object_t * x = rec -> decl;
- for(int i = 0; i < rec -> num_decl; i++)
+ if(check_upscope)
{
- if(strcmp(x -> name, name) == 0)
+ if(oberon_find_object(scope -> up, name, false))
{
- return x;
+ oberon_error(scope -> ctx, "already defined");
}
+ }
+
+ oberon_object_t * x = scope -> list;
+ while(x -> next && strcmp(x -> next -> name, name) != 0)
+ {
x = x -> next;
}
- oberon_error(ctx, "field not defined");
+ if(x -> next)
+ {
+ oberon_error(scope -> ctx, "already defined");
+ }
+
+ oberon_object_t * newvar = malloc(sizeof *newvar);
+ memset(newvar, 0, sizeof *newvar);
+ newvar -> name = name;
+ newvar -> class = class;
+ newvar -> export = export;
+ newvar -> read_only = read_only;
+ newvar -> local = scope -> local;
+ newvar -> parent = scope -> parent;
+ newvar -> parent_type = scope -> parent_type;
+ newvar -> module = scope -> ctx -> mod;
+
+ x -> next = newvar;
- return NULL;
+ return newvar;
}
static oberon_object_t *
oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type, int export)
{
oberon_object_t * id;
- id = oberon_define_object(scope, name, OBERON_CLASS_TYPE, export, 0);
+ id = oberon_define_object(scope, name, OBERON_CLASS_TYPE, export, false, false);
id -> type = type;
oberon_generator_init_type(scope -> ctx, type);
return id;
@@ -1139,7 +1129,7 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
oberon_type_t * rec = expr -> result;
oberon_object_t * field;
- field = oberon_find_field(ctx, rec, name);
+ field = oberon_find_object(rec -> scope, name, true);
if(field -> export == 0)
{
}
static oberon_object_t *
-oberon_ident_def(oberon_context_t * ctx, int class)
+oberon_ident_def(oberon_context_t * ctx, int class, bool check_upscope)
{
char * name;
int export;
name = oberon_assert_ident(ctx);
oberon_def(ctx, &export, &read_only);
- x = oberon_define_object(ctx -> decl, name, class, export, read_only);
+ x = oberon_define_object(ctx -> decl, name, class, export, read_only, check_upscope);
return x;
}
static void
-oberon_ident_list(oberon_context_t * ctx, int class, int * num, oberon_object_t ** list)
+oberon_ident_list(oberon_context_t * ctx, int class, bool check_upscope, int * num, oberon_object_t ** list)
{
*num = 1;
- *list = oberon_ident_def(ctx, class);
+ *list = oberon_ident_def(ctx, class, check_upscope);
while(ctx -> token == COMMA)
{
oberon_assert_token(ctx, COMMA);
- oberon_ident_def(ctx, class);
+ oberon_ident_def(ctx, class, check_upscope);
*num += 1;
}
}
oberon_type_t * type;
type = oberon_new_type_ptr(OBERON_TYPE_VOID);
- oberon_ident_list(ctx, OBERON_CLASS_VAR, &num, &list);
+ oberon_ident_list(ctx, OBERON_CLASS_VAR, false, &num, &list);
oberon_assert_token(ctx, COLON);
oberon_type(ctx, &type);
int num;
oberon_object_t * list;
- oberon_ident_list(ctx, class, &num, &list);
+ oberon_ident_list(ctx, class, false, &num, &list);
oberon_assert_token(ctx, COLON);
}
else
{
- proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, export, read_only);
+ proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, export, read_only, false);
proc -> type = signature;
proc -> scope = proc_scope;
oberon_generator_init_proc(ctx, proc);
oberon_item_t * value;
oberon_object_t * constant;
- constant = oberon_ident_def(ctx, OBERON_CLASS_CONST);
+ constant = oberon_ident_def(ctx, OBERON_CLASS_CONST, false);
oberon_assert_token(ctx, EQUAL);
value = oberon_const_expr(ctx);
constant -> value = value;
@@ -2023,31 +2013,6 @@ oberon_make_array_type(oberon_context_t * ctx, oberon_expr_t * size, oberon_type
arr -> base = base;
}
-static void
-oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec)
-{
- if(ctx -> token == IDENT)
- {
- int num;
- oberon_object_t * list;
- oberon_type_t * type;
- type = oberon_new_type_ptr(OBERON_TYPE_VOID);
-
- oberon_ident_list(ctx, OBERON_CLASS_FIELD, &num, &list);
- oberon_assert_token(ctx, COLON);
- oberon_type(ctx, &type);
-
- oberon_object_t * field = list;
- for(int i = 0; i < num; i++)
- {
- field -> type = type;
- field = field -> next;
- }
-
- rec -> num_decl += num;
- }
-}
-
static void
oberon_qualident_type(oberon_context_t * ctx, oberon_type_t ** type)
{
}
else
{
- to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, 0, 0);
+ to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, false, false, false);
to -> type = oberon_new_type_ptr(OBERON_TYPE_VOID);
}
@@ -2106,6 +2071,87 @@ oberon_make_open_array(oberon_context_t * ctx, oberon_type_t * base, oberon_type
type -> base = base;
}
+static void
+oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec, oberon_scope_t * modscope)
+{
+ if(ctx -> token == IDENT)
+ {
+ int num;
+ oberon_object_t * list;
+ oberon_type_t * type;
+ type = oberon_new_type_ptr(OBERON_TYPE_VOID);
+
+ oberon_ident_list(ctx, OBERON_CLASS_FIELD, true, &num, &list);
+ oberon_assert_token(ctx, COLON);
+
+ oberon_scope_t * current = ctx -> decl;
+ ctx -> decl = modscope;
+ oberon_type(ctx, &type);
+ ctx -> decl = current;
+
+ oberon_object_t * field = list;
+ for(int i = 0; i < num; i++)
+ {
+ field -> type = type;
+ field = field -> next;
+ }
+
+ rec -> num_decl += num;
+ }
+}
+
+static void
+oberon_type_record_body(oberon_context_t * ctx, oberon_type_t * rec)
+{
+ oberon_scope_t * modscope = ctx -> mod -> decl;
+ oberon_scope_t * oldscope = ctx -> decl;
+ ctx -> decl = modscope;
+
+ if(ctx -> token == LPAREN)
+ {
+ oberon_assert_token(ctx, LPAREN);
+
+ oberon_object_t * typeobj;
+ typeobj = oberon_qualident(ctx, NULL, true);
+
+ if(typeobj -> class != OBERON_CLASS_TYPE)
+ {
+ oberon_error(ctx, "base must be type");
+ }
+
+ if(typeobj -> type -> class != OBERON_TYPE_RECORD)
+ {
+ oberon_error(ctx, "base must be record type");
+ }
+
+ rec -> base = typeobj -> type;
+ ctx -> decl = rec -> base -> scope;
+
+ oberon_assert_token(ctx, RPAREN);
+ }
+ else
+ {
+ ctx -> decl = NULL;
+ }
+
+ oberon_scope_t * this_scope;
+ this_scope = oberon_open_scope(ctx);
+ this_scope -> local = true;
+ this_scope -> parent = NULL;
+ this_scope -> parent_type = rec;
+
+ oberon_field_list(ctx, rec, modscope);
+ while(ctx -> token == SEMICOLON)
+ {
+ oberon_assert_token(ctx, SEMICOLON);
+ oberon_field_list(ctx, rec, modscope);
+ }
+
+ rec -> scope = this_scope;
+ rec -> decl = this_scope -> list -> next;
+ ctx -> decl = oldscope;
+}
+
static void
oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
{
rec -> class = OBERON_TYPE_RECORD;
rec -> module = ctx -> mod;
- oberon_scope_t * record_scope;
- record_scope = oberon_open_scope(ctx);
- record_scope -> local = 1;
- record_scope -> parent = NULL;
- record_scope -> parent_type = rec;
-
oberon_assert_token(ctx, RECORD);
- oberon_field_list(ctx, rec);
- while(ctx -> token == SEMICOLON)
- {
- oberon_assert_token(ctx, SEMICOLON);
- oberon_field_list(ctx, rec);
- }
+ oberon_type_record_body(ctx, rec);
oberon_assert_token(ctx, END);
- rec -> decl = record_scope -> list -> next;
- oberon_close_scope(record_scope);
-
*type = rec;
}
else if(ctx -> token == POINTER)
newtype = oberon_find_object(ctx -> decl, name, 0);
if(newtype == NULL)
{
- newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, export, read_only);
+ newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, export, read_only, false);
newtype -> type = oberon_new_type_ptr(OBERON_TYPE_VOID);
assert(newtype -> type);
}
}
oberon_object_t * ident;
- ident = oberon_define_object(ctx -> decl, alias, OBERON_CLASS_MODULE, 0, 0);
+ ident = oberon_define_object(ctx -> decl, alias, OBERON_CLASS_MODULE, false, false, false);
ident -> module = m;
}
oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f, GenerateProcCallback p)
{
oberon_object_t * proc;
- proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, 1, 0);
+ proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, true, false, false);
proc -> sysproc = 1;
proc -> genfunc = f;
proc -> genproc = p;
diff --git a/src/test.c b/src/test.c
index 9fad93d4461223fcc752d5a79e48261711e9709d..6a08bce11b82d1454ec2538a53e6e63d426debfa 100644 (file)
--- a/src/test.c
+++ b/src/test.c
"(* Main module *)"
"MODULE Test;"
"IMPORT Out;"
+ "TYPE"
+ " Baser = RECORD a : INTEGER; END;"
+ " R1 = RECORD (Baser)"
+ " b : R2;"
+ " END;"
+ " "
+ " R2 = RECORD"
+ " a : POINTER TO R1;"
+ " END;"
""
"VAR"
- " byte : BYTE;"
- " short : SHORTINT;"
- " int : INTEGER;"
- " long : LONGINT;"
- " real : REAL;"
- " longreal : LONGREAL;"
+ " r : R1;"
""
"BEGIN"
- " Out.Open;"
- " byte := 127;"
- " int := 666 DIV 2;"
- " long := int;"
- " real := (4 / 1) - (4 / 3) + (4 / 5) - (4 / 7) + (4 / 9) - (4 / 11) + (4 / 13) - (4 / 15) + (4 / 17);"
- " longreal := (4 / 1) - (4 / 3) + (4 / 5) - (4 / 7) + (4 / 9) - (4 / 11) + (4 / 13) - (4 / 15) + (4 / 17);"
- " Out.Int(666, 0); Out.Ln;"
- " Out.Int(byte, 0); Out.Ln;"
- " Out.Real(real, 0); Out.Ln;"
- " Out.LongReal(longreal, 0); Out.Ln;"
+ " r.a := 1;"
"END Test."
;