diff --git a/oberon.c b/oberon.c
index e12ee36174e9fd9cfd9a870225dea8528d46e8f8..817da1ae02b4f417f9c005f902bd2d26b0f5f3a1 100644 (file)
--- a/oberon.c
+++ b/oberon.c
}
static oberon_object_t *
-oberon_define_object(oberon_scope_t * scope, char * name, int class)
+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)
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;
}
static oberon_object_t *
-oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type)
+oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type, int export, int read_only)
{
oberon_object_t * id;
- id = oberon_define_object(scope, name, OBERON_CLASS_TYPE);
+ id = oberon_define_object(scope, name, OBERON_CLASS_TYPE, export, read_only);
id -> type = type;
oberon_generator_init_type(scope -> ctx, type);
return id;
}
-/*
-static oberon_type_t *
-oberon_find_type(oberon_scope_t * scope, char * name)
-{
- oberon_object_t * x = oberon_find_object(scope, name);
- if(x -> class != OBERON_CLASS_TYPE)
- {
- oberon_error(scope -> ctx, "%s not a type", name);
- }
-
- return x -> type;
-}
-*/
-
static oberon_object_t *
-oberon_define_var(oberon_scope_t * scope, int class, char * name, oberon_type_t * type)
+oberon_define_var(oberon_scope_t * scope, int class, char * name, oberon_type_t * type, int export, int read_only)
{
oberon_object_t * var;
- var = oberon_define_object(scope, name, class);
+ var = oberon_define_object(scope, name, class, export, read_only);
var -> type = type;
return var;
}
-/*
-static oberon_object_t *
-oberon_find_var(oberon_scope_t * scope, char * name)
-{
- oberon_object_t * x = oberon_find_object(scope, name);
-
- if(x -> class != OBERON_CLASS_VAR)
- {
- oberon_error(scope -> ctx, "%s not a var", name);
- }
-
- return x;
-}
-*/
-
-/*
-static oberon_object_t *
-oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signature)
-{
- oberon_object_t * proc;
- proc = oberon_define_object(scope, name, OBERON_CLASS_PROC);
- proc -> type = signature;
- return proc;
-}
-*/
-
// =======================================================================
// SCANER
// =======================================================================
name = oberon_assert_ident(ctx);
/* Наличие объектов в левых модулях всегда проверяется */
x = oberon_find_object(x -> module -> decl, name, 1);
+
+ if(x -> export == 0)
+ {
+ oberon_error(ctx, "not exported");
+ }
}
}
}
static void
-oberon_var_decl(oberon_context_t * ctx)
+oberon_def(oberon_context_t * ctx, int * export, int * read_only)
+{
+ switch(ctx -> token)
+ {
+ case STAR:
+ oberon_assert_token(ctx, STAR);
+ *export = 1;
+ *read_only = 0;
+ break;
+ case MINUS:
+ oberon_assert_token(ctx, MINUS);
+ *export = 1;
+ *read_only = 1;
+ break;
+ default:
+ *export = 0;
+ *read_only = 0;
+ break;
+ }
+}
+
+static oberon_object_t *
+oberon_ident_def(oberon_context_t * ctx, int class)
{
char * name;
+ int export;
+ int read_only;
+ oberon_object_t * x;
+
+ name = oberon_assert_ident(ctx);
+ oberon_def(ctx, &export, &read_only);
+
+ x = oberon_define_object(ctx -> decl, name, class, export, read_only);
+ return x;
+}
+
+static void
+oberon_var_decl(oberon_context_t * ctx)
+{
+ oberon_object_t * var;
oberon_type_t * type;
type = oberon_new_type_ptr(OBERON_TYPE_VOID);
- name = oberon_assert_ident(ctx);
+ var = oberon_ident_def(ctx, OBERON_CLASS_VAR);
oberon_assert_token(ctx, COLON);
oberon_type(ctx, &type);
- oberon_define_var(ctx -> decl, OBERON_CLASS_VAR, name, type);
+ var -> type = type;
}
static oberon_object_t *
@@ -1465,11 +1469,11 @@ oberon_make_param(oberon_context_t * ctx, int token, char * name, oberon_type_t
if(token == VAR)
{
- param = oberon_define_var(ctx -> decl, OBERON_CLASS_VAR_PARAM, name, type);
+ param = oberon_define_var(ctx -> decl, OBERON_CLASS_VAR_PARAM, name, type, 0, 0);
}
else if(token == IDENT)
{
- param = oberon_define_var(ctx -> decl, OBERON_CLASS_PARAM, name, type);
+ param = oberon_define_var(ctx -> decl, OBERON_CLASS_PARAM, name, type, 0, 0);
}
else
{
}
char * name;
+ int export;
+ int read_only;
name = oberon_assert_ident(ctx);
+ oberon_def(ctx, &export, &read_only);
oberon_scope_t * proc_scope;
proc_scope = oberon_open_scope(ctx);
}
}
+ if(proc -> export != export || proc -> read_only != read_only)
+ {
+ oberon_error(ctx, "export type not matched");
+ }
+
oberon_compare_signatures(ctx, proc -> type, signature);
}
else
{
- proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC);
+ proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, export, read_only);
proc -> type = signature;
proc -> scope = proc_scope;
oberon_generator_init_proc(ctx, proc);
static void
oberon_const_decl(oberon_context_t * ctx)
{
- char * name;
oberon_item_t * value;
oberon_object_t * constant;
- name = oberon_assert_ident(ctx);
+ constant = oberon_ident_def(ctx, OBERON_CLASS_CONST);
oberon_assert_token(ctx, EQUAL);
value = oberon_const_expr(ctx);
-
- constant = oberon_define_object(ctx -> decl, name, OBERON_CLASS_CONST);
constant -> value = value;
}
}
else
{
- to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE);
+ to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, 0, 0);
to -> type = oberon_new_type_ptr(OBERON_TYPE_VOID);
}
char * name;
oberon_object_t * newtype;
oberon_type_t * type;
+ int export;
+ int read_only;
name = oberon_assert_ident(ctx);
+ oberon_def(ctx, &export, &read_only);
newtype = oberon_find_object(ctx -> decl, name, 0);
if(newtype == NULL)
{
- newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE);
+ newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, export, read_only);
newtype -> type = oberon_new_type_ptr(OBERON_TYPE_VOID);
assert(newtype -> type);
}
{
oberon_error(ctx, "mult definition - already linked");
}
+
+ newtype -> export = export;
+ newtype -> read_only = read_only;
}
oberon_assert_token(ctx, EQUAL);
}
oberon_object_t * ident;
- ident = oberon_define_object(ctx -> decl, alias, OBERON_CLASS_MODULE);
+ ident = oberon_define_object(ctx -> decl, alias, OBERON_CLASS_MODULE, 0, 0);
ident -> module = m;
}
ctx -> mod -> name = name1;
oberon_object_t * this_module;
- this_module = oberon_define_object(ctx -> decl, name1, OBERON_CLASS_MODULE);
+ this_module = oberon_define_object(ctx -> decl, name1, OBERON_CLASS_MODULE, 0, 0);
this_module -> module = ctx -> mod;
if(ctx -> token == IMPORT)
oberon_decl_seq(ctx);
oberon_generate_begin_module(ctx);
-
if(ctx -> token == BEGIN)
{
oberon_assert_token(ctx, BEGIN);
oberon_statement_seq(ctx);
- oberon_generate_end_module(ctx);
}
+ oberon_generate_end_module(ctx);
oberon_assert_token(ctx, END);
name2 = oberon_assert_ident(ctx);
oberon_generator_init_type(ctx, ctx -> void_ptr_type);
ctx -> int_type = oberon_new_type_integer(sizeof(int));
- oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type);
+ oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type, 1, 0);
ctx -> bool_type = oberon_new_type_boolean(sizeof(int));
- oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type);
+ oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type, 1, 0);
}
static void
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);
+ proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, 1, 0);
proc -> sysproc = 1;
proc -> genfunc = f;
proc -> genproc = p;