d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

A newer version

Browse source
This commit is contained in:
ceriel 1986-04-04 13:47:04 +00:00
parent b5e1097890
commit 0e4311490c
9 changed files with 152 additions and 58 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
lang/m2/comp/LLlex.c
View file

@ -18,6 +18,7 @@ static char *RcsId = "$Header$";
long str2long();
struct token dot, aside;
struct string string;
static
SkipComment()
@ -59,16 +60,16 @@ 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) {
@ -80,14 +81,15 @@ GetString(upto)
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
@ -106,13 +108,14 @@ LLlex()
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:
@ -205,7 +208,8 @@ again:
}
case STSTR:
tk->TOK_STR = GetString(ch);
GetString(ch);
tk->tk_data.tk_str = string;
return tk->tk_symb = STRING;
case STNUM:

19
lang/m2/comp/LLlex.h
View file

@ -2,24 +2,27 @@
/* $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;

2
lang/m2/comp/LLmessage.c
View file

@ -37,10 +37,10 @@ insert_token(tk)
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:

3
lang/m2/comp/Makefile
View file

@ -17,7 +17,7 @@ LFLAGS = $(PROFILE)
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 \
@ -83,6 +83,7 @@ scope.o: LLlex.h debug.h def.h idf.h scope.h type.h
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

30
lang/m2/comp/declar.g
View file

@ -21,6 +21,7 @@ ProcedureDeclaration
ProcedureHeading(&df, D_PROCEDURE)
';' block IDENT
{ match_id(dot.TOK_IDF, df->df_idf);
df->prc_scope = CurrentScope->sc_scope;
close_scope();
}
;
@ -28,19 +29,37 @@ ProcedureDeclaration
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, &params, &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;
}
;
@ -283,6 +302,9 @@ FieldList(struct scope *scope;)
} :
[
IdentList(&FldList) ':' type(&tp)
{ EnterIdList(FldList, D_FIELD, 0, tp, scope);
FreeIdList(FldList);
}
|
CASE
[
@ -370,7 +392,7 @@ ProcedureType(struct type **ptp;)
struct type *tp = 0;
} :
PROCEDURE FormalTypeList(&pr, &tp)?
{ *ptp = construct_type(PROCEDURE, tp);
{ *ptp = construct_type(PROCVAR, tp);
(*ptp)->prc_params = pr;
}
;

67
lang/m2/comp/def.H
View file

@ -3,14 +3,14 @@
/* $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
};
@ -20,8 +20,8 @@ struct constant {
};
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
};
@ -37,8 +37,13 @@ struct field {
#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
};
@ -47,32 +52,33 @@ struct def { /* list of definitions for a name */
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;
@ -81,7 +87,8 @@ struct def { /* list of definitions for a name */
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;
};

2
lang/m2/comp/defmodule.c
View file

@ -1,5 +1,7 @@
/* 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>

7
lang/m2/comp/tokenname.c
View file

@ -76,6 +76,10 @@ struct tokenname tkidf[] = { /* names of the identifier tokens */
struct tokenname tkinternal[] = { /* internal keywords */
{PROGRAM, ""},
{SUBRANGE, ""},
{ENUMERATION, ""},
{ERRONEOUS, ""},
{PROCVAR, ""},
{0, "0"}
};
@ -85,9 +89,6 @@ struct tokenname tkstandard[] = { /* standard identifiers */
{LONGINT, ""},
{CARDINAL, ""},
{LONGREAL, ""},
{SUBRANGE, ""},
{ENUMERATION, ""},
{ERRONEOUS, ""},
{WORD, ""},
{ADDRESS, ""},
{0, ""}

54
lang/m2/comp/typequiv.c Normal file
View file

@ -0,0 +1,54 @@
/* 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;
}