long str2long();
struct token dot, aside;
+struct string string;
static
SkipComment()
}
}
-static char *
+static
GetString(upto)
{
/* Read a Modula-2 string, delimited by the character "upto".
*/
register int ch;
- int str_size;
- char *str = Malloc(str_size = 32);
- register int pos = 0;
+ register struct string *str = &string;
+ register char *p;
+ str->s_str = p = Malloc(str->s_length = 32);
LoadChar(ch);
while (ch != upto) {
if (class(ch) == STNL) {
lexerror("end-of-file in string");
break;
}
- str[pos++] = ch;
- if (pos == str_size) {
- str = Srealloc(str, str_size += 8);
+ *p++ = ch;
+ if (p - str->s_str == str->s_length) {
+ str->s_str = Srealloc(str->s_str, str->s_length += 8);
+ p = str->s_str + (str->s_length - 8);
}
LoadChar(ch);
}
- str[pos] = '\0';
- return str;
+ *p = '\0';
+ str->s_length = p - str->s_str;
}
int
return tk->tk_symb;
}
tk->tk_lineno = LineNumber;
+ tk->tk_filename = FileName;
again:
LoadChar(ch);
if ((ch & 0200) && ch != EOI) {
fatal("non-ascii '\\%03o' read", ch & 0377);
}
-
+
switch (class(ch)) {
case STSKIP:
}
case STSTR:
- tk->TOK_STR = GetString(ch);
+ GetString(ch);
+ tk->tk_data.tk_str = string;
return tk->tk_symb = STRING;
case STNUM:
/* $Header$ */
+struct string {
+ int s_length; /* length of a string */
+ char *s_str; /* the string itself */
+};
+
struct token {
int tk_symb; /* token itself */
+ char *tk_filename; /* filename in which it occurred */
int tk_lineno; /* linenumber on which it occurred */
union {
struct idf *tk_idf; /* IDENT */
- char *tk_str; /* STRING */
- struct { /* INTEGER */
- struct type *tk_type; /* type */
- arith tk_value; /* value */
- } tk_int;
+ struct string tk_str; /* STRING */
+ arith tk_int; /* INTEGER */
char *tk_real; /* REAL */
} tk_data;
};
#define TOK_IDF tk_data.tk_idf
-#define TOK_STR tk_data.tk_str
-#define TOK_ITP tk_data.tk_int.tk_type
-#define TOK_INT tk_data.tk_int.tk_value
+#define TOK_STR tk_data.tk_str.s_str
+#define TOK_SLE tk_data.tk_str.s_length
+#define TOK_INT tk_data.tk_int
#define TOK_REL tk_data.tk_real
extern struct token dot, aside;
dot.TOK_IDF = gen_anon_idf();
break;
case STRING:
+ dot.TOK_SLE = 1;
dot.TOK_STR = Salloc("", 1);
break;
case INTEGER:
-/* dot.TOK_ITP = INT; */
dot.TOK_INT = 1;
break;
case REAL:
LOBJ = tokenfile.o program.o declar.o expression.o statement.o
COBJ = LLlex.o LLmessage.o char.o error.o main.o \
symbol2str.o tokenname.o idf.o input.o type.o def.o \
- scope.o misc.o enter.o defmodule.o
+ scope.o misc.o enter.o defmodule.o typequiv.o
OBJ = $(COBJ) $(LOBJ) Lpars.o
GENFILES= tokenfile.c \
program.c declar.c expression.c statement.c \
misc.o: LLlex.h f_info.h idf.h misc.h
enter.o: def.h idf.h misc.h scope.h type.h
defmodule.o: LLlex.h def.h f_info.h idf.h input.h scope.h
+typequiv.o: Lpars.h def.h type.h
tokenfile.o: Lpars.h
program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h misc.h scope.h type.h
declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h
ProcedureHeading(&df, D_PROCEDURE)
';' block IDENT
{ match_id(dot.TOK_IDF, df->df_idf);
+ df->prc_scope = CurrentScope->sc_scope;
close_scope();
}
;
ProcedureHeading(struct def **pdf; int type;)
{
struct type *tp;
+ struct type *tp1 = 0;
struct paramlist *params = 0;
+ register struct def *df;
} :
PROCEDURE IDENT
{ assert(type & (D_PROCEDURE | D_PROCHEAD));
- *pdf = define(dot.TOK_IDF, CurrentScope, type);
- if (type == D_PROCEDURE) {
+ if (type == D_PROCHEAD) {
+ df = define(dot.TOK_IDF, CurrentScope, type);
+ }
+ else {
+ df = lookup(dot.TOK_IDF,
+ CurrentScope->sc_scope);
+ if (df && df->df_kind == D_PROCHEAD) {
+ df->df_kind = type;
+ tp1 = df->df_type;
+ }
+ else {
+ df = define(dot.TOK_IDF,
+ CurrentScope, type);
+ }
open_scope(OPENSCOPE, 0);
}
}
FormalParameters(type == D_PROCEDURE, ¶ms, &tp)?
{
- (*pdf)->df_type = tp = construct_type(PROCEDURE, tp);
+ df->df_type = tp = construct_type(PROCEDURE, tp);
tp->prc_params = params;
+ if (tp1 && !TstTypeEquiv(tp, tp1)) {
+error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text);
+ }
+ *pdf = df;
}
;
} :
[
IdentList(&FldList) ':' type(&tp)
+ { EnterIdList(FldList, D_FIELD, 0, tp, scope);
+ FreeIdList(FldList);
+ }
|
CASE
[
struct type *tp = 0;
} :
PROCEDURE FormalTypeList(&pr, &tp)?
- { *ptp = construct_type(PROCEDURE, tp);
+ { *ptp = construct_type(PROCVAR, tp);
(*ptp)->prc_params = pr;
}
;
/* $Header$ */
struct module {
- int mo_priority; /* Priority of a module */
- int mo_scope; /* Scope of this module */
+ int mo_priority; /* priority of a module */
+ int mo_scope; /* scope of this module */
#define mod_priority df_value.df_module.mo_priority
#define mod_scope df_value.df_module.mo_scope
};
struct variable {
- arith va_off; /* Address or offset of variable */
+ arith va_off; /* address or offset of variable */
#define var_off df_value.df_variable.va_off
};
};
struct enumval {
- unsigned int en_val; /* Value of this enumeration literal */
- struct def *en_next; /* Next enumeration literal */
+ unsigned int en_val; /* value of this enumeration literal */
+ struct def *en_next; /* next enumeration literal */
#define enm_val df_value.df_enum.en_val
#define enm_next df_value.df_enum.en_next
};
#define fld_variant df_value.df_field.fd_variant
};
+struct dfproc {
+ int pr_scope; /* scope number of procedure */
+#define prc_scope df_value.df_proc.pr_scope
+};
+
struct import {
- struct def *im_def; /* Scope number from which imported */
+ struct def *im_def; /* imported definition */
#define imp_def df_value.df_import.im_def
};
struct def *df_nextinscope;
/* link all definitions in a scope */
struct idf *df_idf; /* link back to the name */
- int df_scope; /* Scope in which this definition resides */
- short df_kind; /* The kind of this definition: */
-#define D_MODULE 0x0001 /* A module */
-#define D_PROCEDURE 0x0002 /* Procedure of function */
-#define D_VARIABLE 0x0004 /* A variable */
-#define D_FIELD 0x0008 /* A field in a record */
-#define D_TYPE 0x0010 /* A type */
-#define D_ENUM 0x0020 /* An enumeration literal */
-#define D_CONST 0x0040 /* A constant */
-#define D_IMPORT 0x0080 /* An imported definition */
-#define D_PROCHEAD 0x0100 /* A procedure heading in a definition module */
-#define D_HIDDEN 0x0200 /* A hidden type */
-#define D_HTYPE 0x0400 /* Definition of a hidden type seen */
-#define D_STDPROC 0x0800 /* A standard procedure */
-#define D_STDFUNC 0x1000 /* A standard function */
-#define D_ERROR 0x2000 /* A compiler generated definition for an
+ int df_scope; /* scope in which this definition resides */
+ short df_kind; /* the kind of this definition: */
+#define D_MODULE 0x0001 /* a module */
+#define D_PROCEDURE 0x0002 /* procedure of function */
+#define D_VARIABLE 0x0004 /* a variable */
+#define D_FIELD 0x0008 /* a field in a record */
+#define D_TYPE 0x0010 /* a type */
+#define D_ENUM 0x0020 /* an enumeration literal */
+#define D_CONST 0x0040 /* a constant */
+#define D_IMPORT 0x0080 /* an imported definition */
+#define D_PROCHEAD 0x0100 /* a procedure heading in a definition module */
+#define D_HIDDEN 0x0200 /* a hidden type */
+#define D_HTYPE 0x0400 /* definition of a hidden type seen */
+#define D_STDPROC 0x0800 /* a standard procedure */
+#define D_STDFUNC 0x1000 /* a standard function */
+#define D_ERROR 0x2000 /* a compiler generated definition for an
undefined variable
*/
-#define D_ISEXPORTED 0x4000 /* Not yet defined */
+#define D_ISEXPORTED 0x4000 /* not yet defined */
char df_flags;
-#define D_ADDRESS 0x01 /* Set if address was taken */
-#define D_USED 0x02 /* Set if used */
-#define D_DEFINED 0x04 /* Set if it is assigned a value */
-#define D_VARPAR 0x08 /* Set if it is a VAR parameter */
-#define D_EXPORTED 0x40 /* Set if exported */
-#define D_QEXPORTED 0x80 /* Set if qualified exported */
+#define D_ADDRESS 0x01 /* set if address was taken */
+#define D_USED 0x02 /* set if used */
+#define D_DEFINED 0x04 /* set if it is assigned a value */
+#define D_VARPAR 0x08 /* set if it is a VAR parameter */
+#define D_VALPAR 0x10 /* set if it is a value parameter */
+#define D_EXPORTED 0x40 /* set if exported */
+#define D_QEXPORTED 0x80 /* set if qualified exported */
struct type *df_type;
union {
struct module df_module;
struct enumval df_enum;
struct field df_field;
struct import df_import;
- int df_stdname; /* Define for standard name */
+ struct dfproc df_proc;
+ int df_stdname; /* define for standard name */
} df_value;
};
/* D E F I N I T I O N M O D U L E S */
+static char *RcsId = "$Header$";
+
#include <assert.h>
#include <em_arith.h>
#include <em_label.h>
struct tokenname tkinternal[] = { /* internal keywords */
{PROGRAM, ""},
+ {SUBRANGE, ""},
+ {ENUMERATION, ""},
+ {ERRONEOUS, ""},
+ {PROCVAR, ""},
{0, "0"}
};
{LONGINT, ""},
{CARDINAL, ""},
{LONGREAL, ""},
- {SUBRANGE, ""},
- {ENUMERATION, ""},
- {ERRONEOUS, ""},
{WORD, ""},
{ADDRESS, ""},
{0, ""}
--- /dev/null
+/* T Y P E E Q U I V A L E N C E */
+
+static char *RcsId = "$Header$";
+
+#include <em_arith.h>
+#include <em_label.h>
+#include "type.h"
+#include "def.h"
+#include "Lpars.h"
+
+int
+TstTypeEquiv(tp1, tp2)
+ register struct type *tp1, *tp2;
+{
+ /* test if two types are equivalent. The only complication comes
+ from the fact that for some procedures two declarations may
+ be given: one in the specification module and one in the
+ definition module.
+ */
+
+ return tp1 == tp2
+ ||
+ (
+ tp1 && tp1->tp_fund == PROCEDURE
+ &&
+ tp2 && tp2->tp_fund == PROCEDURE
+ &&
+ TstProcEquiv(tp1, tp2)
+ );
+
+}
+
+int
+TstProcEquiv(tp1, tp2)
+ register struct type *tp1, *tp2;
+{
+ /* Test if two procedure types are equivalent. This routine
+ may also be used for the testing of assignment compatibility
+ between procedure variables and procedures.
+ */
+ register struct paramlist *p1, *p2;
+
+ if (!TstTypeEquiv(tp1->next, tp2->next)) return 0;
+ p1 = tp1->prc_params;
+ p2 = tp2->prc_params;
+ while (p1 && p2) {
+ if (p1->par_var != p2->par_var ||
+ !TstTypeEquiv(p1->par_type, p2->par_type)) return 0;
+ p1 = p1->next;
+ p2 = p2->next;
+ }
+ if (p1 != p2) return 0;
+ return 1;
+}
public / ack.git / commitdiff