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

newer version, safety commit

Browse source
This commit is contained in:
ceriel 1986-03-26 17:53:13 +00:00
parent e8505e4434
commit 4a91a6bf4b
13 changed files with 163 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
lang/m2/comp/Makefile
View file

@ -14,7 +14,7 @@ LFLAGS = -p
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 print.o
scope.o misc.o print.o enter.o
OBJ = $(COBJ) $(LOBJ) Lpars.o
GENFILES= tokenfile.c \
program.c declar.c expression.c statement.c \
@ -69,17 +69,18 @@ LLlex.o: LLlex.h Lpars.h class.h f_info.h idf.h input.h
LLmessage.o: LLlex.h Lpars.h idf.h
char.o: class.h
error.o: LLlex.h f_info.h input.h
main.o: LLlex.h Lpars.h debug.h f_info.h idf.h input.h main.h
main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h main.h standards.h type.h
symbol2str.o: Lpars.h
tokenname.o: Lpars.h idf.h tokenname.h
idf.o: idf.h
input.o: f_info.h input.h
type.o: Lpars.h def.h def_sizes.h idf.h type.h
def.o: Lpars.h def.h idf.h main.h scope.h
scope.o: scope.h
scope.o: debug.h scope.h
misc.o: LLlex.h f_info.h idf.h misc.h
enter.o: def.h idf.h scope.h type.h
tokenfile.o: Lpars.h
program.o: LLlex.h Lpars.h idf.h main.h misc.h
program.o: LLlex.h Lpars.h idf.h main.h misc.h scope.h
declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h
expression.o: Lpars.h
statement.o: Lpars.h

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

@ -49,6 +49,8 @@ struct def { /* list of definitions for a name */
#define D_PROCHEAD 0x08 /* A procedure heading in a definition module */
#define D_HIDDEN 0x09 /* A hidden type */
#define D_HTYPE 0x0A /* Definition of a hidden type seen */
#define D_STDPROC 0x0B /* A standard procedure */
#define D_STDFUNC 0x0C /* A standard function */
#define D_ISEXPORTED 0xFF /* Not yet defined */
char df_flags;
#define D_ADDRESS 0x01 /* Set if address was taken */
@ -65,6 +67,7 @@ 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 */
} df_value;
};

13
lang/m2/comp/def.c
View file

@ -16,14 +16,18 @@ struct def *h_def; /* Pointer to free list of def structures */
struct def *
define(id, scope, kind)
register struct idf *id;
struct scope *scope;
register struct scope *scope;
{
/* Declare an identifier in a scope, but first check if it
already has been defined. If so, error message.
*/
register struct def *df = lookup(id, scope);
register struct def *df = lookup(id, scope->sc_scope);
if (df) {
if ( /* Already in this scope */
df
|| /* A closed scope, and id defined in the pervasive scope */
(scopeclosed(scope) && (df = lookup(id, 0)))
) {
switch(df->df_kind) {
case D_PROCHEAD:
if (kind == D_PROCEDURE) {
@ -57,7 +61,6 @@ define(id, scope, kind)
struct def *
lookup(id, scope)
register struct idf *id;
struct scope *scope;
{
/* Look up a definition of an identifier in scope "scope".
Make the "def" list self-organizing.
@ -69,7 +72,7 @@ lookup(id, scope)
df1 = 0;
df = id->id_def;
while (df) {
if (df->df_scope == scope->sc_scope) {
if (df->df_scope == scope) {
if (df1) {
df1->next = df->next;
df->next = id->id_def;

29
lang/m2/comp/enter.c Normal file
View file

@ -0,0 +1,29 @@
/* H I G H L E V E L S Y M B O L E N T R Y A N D L O O K U P */
static char *RcsId = "$Header$";
#include <em_arith.h>
#include <em_label.h>
#include "idf.h"
#include "def.h"
#include "type.h"
#include "scope.h"
extern struct idf *str2idf();
extern struct def *define();
Enter(name, kind, type, pnam)
char *name;
struct type *type;
{
struct idf *id;
struct def *df;
id = str2idf(name, 0);
if (!id) fatal("Out of core");
df = define(id, CurrentScope, kind);
df->df_type = type;
if (kind == D_STDPROC || kind == D_STDFUNC) {
df->df_value.df_stdname = pnam;
}
}

18
lang/m2/comp/error.c
View file

@ -170,6 +170,9 @@ _error(class, expr, fmt, argv)
case LEXERROR:
case CRASH:
case FATAL:
#ifdef DEBUG
case VDEBUG:
#endif DEBUG
ln = LineNumber;
break;
}
@ -180,8 +183,7 @@ _error(class, expr, fmt, argv)
if (ln == last_ln) {
/* we've seen this place before */
e_seen++;
if (e_seen == MAXERR_LINE)
fmt = "etc ...";
if (e_seen == MAXERR_LINE) fmt = "etc ...";
else
if (e_seen > MAXERR_LINE)
/* and too often, I'd say ! */
@ -192,14 +194,14 @@ _error(class, expr, fmt, argv)
last_ln = ln;
e_seen = 0;
}
if (FileName)
fprintf(ERROUT, "\"%s\", line %u: ", FileName, ln);
if (remark)
fprintf(ERROUT, "%s ", remark);
#ifdef DEBUG
}
#endif
#endif DEBUG
if (FileName) fprintf(ERROUT, "\"%s\", line %u: ", FileName, ln);
if (remark) fprintf(ERROUT, "%s ", remark);
doprnt(ERROUT, fmt, argv); /* contents of error */
fprintf(ERROUT, "\n");
}

62
lang/m2/comp/main.c
View file

@ -4,6 +4,7 @@ static char *RcsId = "$Header$";
#include <system.h>
#include <em_arith.h>
#include <em_label.h>
#include "input.h"
#include "f_info.h"
#include "idf.h"
@ -11,6 +12,9 @@ static char *RcsId = "$Header$";
#include "Lpars.h"
#include "main.h"
#include "debug.h"
#include "type.h"
#include "def.h"
#include "standards.h"
char options[128];
char *ProgName;
@ -48,9 +52,7 @@ Compile(src)
{
extern struct tokenname tkidf[];
#ifdef DEBUG
printf("%s\n", src);
#endif DEBUG
DO_DEBUG(debug(1,"Filename : %s", src));
if (! InsertFile(src, (char **) 0)) {
fprintf(STDERR,"%s: cannot open %s\n", ProgName, src);
return 0;
@ -61,6 +63,7 @@ Compile(src)
reserve(tkidf);
init_scope();
init_types();
add_standards();
#ifdef DEBUG
if (options['L'])
LexScan();
@ -117,3 +120,56 @@ Option(str)
{
options[str[1]]++; /* switch option on */
}
#define NULLTYPE ((struct type *) 0)
add_standards()
{
register struct def *df;
register struct type *tp;
struct def *Enter();
(void) Enter("ABS", D_STDFUNC, NULLTYPE, S_ABS);
(void) Enter("CAP", D_STDFUNC, NULLTYPE, S_CAP);
(void) Enter("CHR", D_STDFUNC, NULLTYPE, S_CHR);
(void) Enter("FLOAT", D_STDFUNC, NULLTYPE, S_FLOAT);
(void) Enter("HIGH", D_STDFUNC, NULLTYPE, S_HIGH);
(void) Enter("HALT", D_STDPROC, NULLTYPE, S_HALT);
(void) Enter("EXCL", D_STDPROC, NULLTYPE, S_EXCL);
(void) Enter("DEC", D_STDPROC, NULLTYPE, S_DEC);
(void) Enter("INC", D_STDPROC, NULLTYPE, S_INC);
(void) Enter("VAL", D_STDFUNC, NULLTYPE, S_VAL);
(void) Enter("TRUNC", D_STDFUNC, NULLTYPE, S_TRUNC);
(void) Enter("SIZE", D_STDFUNC, NULLTYPE, S_SIZE);
(void) Enter("ORD", D_STDFUNC, NULLTYPE, S_ORD);
(void) Enter("ODD", D_STDFUNC, NULLTYPE, S_ODD);
(void) Enter("MAX", D_STDFUNC, NULLTYPE, S_MAX);
(void) Enter("MIN", D_STDFUNC, NULLTYPE, S_MIN);
(void) Enter("INCL", D_STDPROC, NULLTYPE, S_INCL);
(void) Enter("CHAR", D_TYPE, char_type, 0);
(void) Enter("INTEGER", D_TYPE, int_type, 0);
(void) Enter("LONGINT", D_TYPE, longint_type, 0);
(void) Enter("REAL", D_TYPE, real_type, 0);
(void) Enter("LONGREAL", D_TYPE, longreal_type, 0);
(void) Enter("BOOLEAN", D_TYPE, bool_type, 0);
(void) Enter("CARDINAL", D_TYPE, card_type, 0);
(void) Enter("NIL", D_CONST, nil_type, 0);
(void) Enter("PROC",
D_TYPE,
construct_type(PROCEDURE, NULLTYPE, (arith) 0),
0);
tp = construct_type(SUBRANGE, int_type, (arith) 0);
tp->tp_value.tp_subrange.su_lb = 0;
tp->tp_value.tp_subrange.su_ub = wrd_size * 8 - 1;
(void) Enter("BITSET",
D_TYPE,
construct_type(SET, tp, wrd_size),
0);
df = Enter("FALSE", D_ENUM, bool_type, 0);
df->df_value.df_enum.en_val = 0;
df->df_value.df_enum.en_next = Enter("TRUE", D_ENUM, bool_type, 0);
df = df->df_value.df_enum.en_next;
df->df_value.df_enum.en_val = 1;
df->df_value.df_enum.en_next = 0;
}

14
lang/m2/comp/program.g
View file

@ -9,6 +9,7 @@ static char *RcsId = "$Header$";
#include "misc.h"
#include "main.h"
#include "LLlex.h"
#include "scope.h"
}
/*
The grammar as given by Wirth is already almost LL(1); the
@ -68,7 +69,7 @@ import(int local;)
DefinitionModule:
DEFINITION { state = DEFINITION; }
MODULE IDENT
MODULE IDENT { open_scope(CLOSEDSCOPE, 0); }
';'
import(0)*
/* export?
@ -76,6 +77,7 @@ DefinitionModule:
New Modula-2 does not have export lists in definition modules.
*/
definition* END IDENT '.'
{ close_scope(); }
;
definition:
@ -101,7 +103,15 @@ definition:
ProgramModule:
MODULE { if (state != IMPLEMENTATION) state = PROGRAM; }
IDENT priority? ';' import(0)* block IDENT '.'
IDENT { if (state == IMPLEMENTATION) {
/* Re-open scope ??? */
open_scope(CLOSEDSCOPE, 0);
}
else open_scope(CLOSEDSCOPE, 0);
}
priority? ';' import(0)* block IDENT
{ close_scope(); }
'.'
;
Module:

3
lang/m2/comp/scope.C
View file

@ -5,6 +5,7 @@ static char *RcsId = "$Header$";
#include <assert.h>
#include <alloc.h>
#include "scope.h"
#include "debug.h"
static int maxscope; /* maximum assigned scope number */
@ -27,6 +28,7 @@ open_scope(scopetype, scopenr)
sc->sc_scope = scopenr == 0 ? ++maxscope : scopenr;
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
DO_DEBUG(debug(1, "Opening a %s scope", scopetype == OPENSCOPE ? "open" : "closed"));
sc1 = CurrentScope;
if (scopetype == CLOSEDSCOPE) {
sc1 = new_scope();
@ -42,6 +44,7 @@ close_scope()
register struct scope *sc = CurrentScope;
assert(sc != 0);
DO_DEBUG(debug(1, "Closing a scope"));
if (sc->next && (sc->next->sc_scope == 0)) {
struct scope *sc1 = sc;

1
lang/m2/comp/scope.h
View file

@ -17,3 +17,4 @@ extern struct scope
*CurrentScope;
#define nextvisible(x) ((x)->sc_scope ? (x)->next : (struct scope *) 0)
#define scopeclosed(x) ((x)->next->sc_scope == 0)

24
lang/m2/comp/standards.h Normal file
View file

@ -0,0 +1,24 @@
/* S T A N D A R D P R O C E D U R E S A N D F U N C T I O N S */
/* $Header$ */
#define S_ABS 1
#define S_CAP 2
#define S_CHR 3
#define S_DEC 4
#define S_EXCL 5
#define S_FLOAT 6
#define S_HALT 7
#define S_HIGH 8
#define S_INC 9
#define S_INCL 10
#define S_MAX 11
#define S_MIN 12
#define S_ODD 13
#define S_ORD 14
#define S_SIZE 15
#define S_TRUNC 16
#define S_VAL 17
/* Standard procedures and functions defined in the SYSTEM module ... */
/* PM ??? */

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

@ -80,11 +80,11 @@ struct tokenname tkinternal[] = { /* internal keywords */
};
struct tokenname tkstandard[] = { /* standard identifiers */
{CHAR, "CHAR"},
{BOOLEAN, "BOOLEAN"},
{LONGINT, "LONGINT"},
{CARDINAL, "CARDINAL"},
{LONGREAL, "LONGREAL"},
{CHAR, ""},
{BOOLEAN, ""},
{LONGINT, ""},
{CARDINAL, ""},
{LONGREAL, ""},
{SUBRANGE, ""},
{ERRONEOUS, ""},
{0, ""}

2
lang/m2/comp/type.H
View file

@ -56,12 +56,14 @@ struct type {
/* ALLOCDEF "type" */
extern struct type
*bool_type,
*char_type,
*int_type,
*card_type,
*longint_type,
*real_type,
*longreal_type,
*nil_type,
*error_type;
extern int

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

@ -40,6 +40,7 @@ struct type
*longint_type,
*real_type,
*longreal_type,
*nil_type,
*error_type;
struct paramlist *h_paramlist;
@ -130,5 +131,6 @@ init_types()
card_type = standard_type(CARDINAL, int_align, int_size);
real_type = standard_type(REAL, real_align, real_size);
longreal_type = standard_type(LONGREAL, lreal_align, lreal_size);
nil_type = standard_type(POINTER, ptr_align, ptr_size);
error_type = standard_type(ERRONEOUS, 1, (arith) 1);
}