newer version
This commit is contained in:
ceriel
parent
426c273de8
commit
d3d6e637d6
|
|
@ -6,6 +6,11 @@ static char *RcsId = "$Header$";
|
|||
#include <em_arith.h>
|
||||
#include <em_label.h>
|
||||
#include <assert.h>
|
||||
|
||||
#include "idfsize.h"
|
||||
#include "numsize.h"
|
||||
#include "strsize.h"
|
||||
|
||||
#include "input.h"
|
||||
#include "f_info.h"
|
||||
#include "Lpars.h"
|
||||
|
|
@ -15,14 +20,12 @@ static char *RcsId = "$Header$";
|
|||
#include "LLlex.h"
|
||||
#include "const.h"
|
||||
|
||||
#define IDFSIZE 256 /* Number of significant characters in an identifier */
|
||||
#define NUMSIZE 256 /* maximum number of characters in a number */
|
||||
|
||||
long str2long();
|
||||
|
||||
struct token dot, aside;
|
||||
struct type *numtype;
|
||||
struct string string;
|
||||
int idfsize = IDFSIZE;
|
||||
|
||||
static
|
||||
SkipComment()
|
||||
|
|
@ -73,7 +76,7 @@ GetString(upto)
|
|||
register struct string *str = &string;
|
||||
register char *p;
|
||||
|
||||
str->s_str = p = Malloc(str->s_length = 32);
|
||||
str->s_str = p = Malloc((unsigned) (str->s_length = ISTRSIZE));
|
||||
LoadChar(ch);
|
||||
while (ch != upto) {
|
||||
if (class(ch) == STNL) {
|
||||
|
|
@ -87,8 +90,10 @@ GetString(upto)
|
|||
}
|
||||
*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);
|
||||
str->s_str = Srealloc(str->s_str,
|
||||
str->s_length + RSTRSIZE);
|
||||
p = str->s_str + str->s_length;
|
||||
str->s_length += RSTRSIZE;
|
||||
}
|
||||
LoadChar(ch);
|
||||
}
|
||||
|
|
@ -99,7 +104,7 @@ GetString(upto)
|
|||
int
|
||||
LLlex()
|
||||
{
|
||||
/* LLlex() plays the role of Lexical Analyzer for the parser.
|
||||
/* LLlex() is the Lexical Analyzer.
|
||||
The putting aside of tokens is taken into account.
|
||||
*/
|
||||
register struct token *tk = ˙
|
||||
|
|
@ -199,7 +204,7 @@ again:
|
|||
register struct idf *id;
|
||||
|
||||
do {
|
||||
if (tg - buf < IDFSIZE) *tg++ = ch;
|
||||
if (tg - buf < idfsize) *tg++ = ch;
|
||||
LoadChar(ch);
|
||||
} while(in_idf(ch));
|
||||
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
/* $Header$ */
|
||||
|
||||
struct string {
|
||||
int s_length; /* length of a string */
|
||||
unsigned int s_length; /* length of a string */
|
||||
char *s_str; /* the string itself */
|
||||
};
|
||||
|
||||
|
|
|
|||
|
|
@ -12,19 +12,20 @@ CC = cc
|
|||
GEN = LLgen
|
||||
GENOPTIONS =
|
||||
PROFILE =
|
||||
CFLAGS = -DDEBUG $(PROFILE) $(INCLUDES)
|
||||
CFLAGS = $(PROFILE) $(INCLUDES)
|
||||
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 typequiv.o node.o \
|
||||
cstoper.o chk_expr.o
|
||||
cstoper.o chk_expr.o options.o
|
||||
OBJ = $(COBJ) $(LOBJ) Lpars.o
|
||||
GENFILES= tokenfile.c \
|
||||
program.c declar.c expression.c statement.c \
|
||||
tokenfile.g symbol2str.c char.c Lpars.c Lpars.h
|
||||
|
||||
all:
|
||||
make hfiles
|
||||
make LLfiles
|
||||
make main
|
||||
|
||||
|
|
@ -32,6 +33,10 @@ LLfiles: $(LSRC)
|
|||
$(GEN) $(GENOPTIONS) $(LSRC)
|
||||
@touch LLfiles
|
||||
|
||||
hfiles: Parameters make.hfiles
|
||||
make.hfiles Parameters
|
||||
touch hfiles
|
||||
|
||||
main: $(OBJ) Makefile
|
||||
$(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libcomp.a $(LIBDIR)/malloc.o /user1/erikb/em/lib/libprint.a /user1/erikb/em/lib/libstr.a /user1/erikb/em/lib/libsystem.a -o main
|
||||
size main
|
||||
|
|
@ -73,28 +78,28 @@ depend:
|
|||
make.allocd < $< > $@
|
||||
|
||||
#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
|
||||
LLlex.o: LLlex.h Lpars.h class.h f_info.h idf.h input.h
|
||||
LLlex.o: LLlex.h Lpars.h class.h const.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h
|
||||
LLmessage.o: LLlex.h Lpars.h idf.h
|
||||
char.o: class.h
|
||||
error.o: LLlex.h f_info.h input.h main.h node.h
|
||||
main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h scope.h standards.h tokenname.h type.h
|
||||
error.o: LLlex.h errout.h f_info.h input.h inputtype.h main.h node.h
|
||||
main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h scope.h standards.h tokenname.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: LLlex.h const.h debug.h def.h def_sizes.h idf.h node.h type.h
|
||||
input.o: f_info.h input.h inputtype.h
|
||||
type.o: LLlex.h const.h debug.h def.h idf.h node.h target_sizes.h type.h
|
||||
def.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h
|
||||
scope.o: LLlex.h debug.h def.h idf.h node.h scope.h type.h
|
||||
misc.o: LLlex.h f_info.h idf.h misc.h node.h
|
||||
enter.o: LLlex.h def.h idf.h node.h scope.h type.h
|
||||
defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h scope.h
|
||||
defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h scope.h
|
||||
typequiv.o: def.h type.h
|
||||
node.o: LLlex.h debug.h def.h node.h type.h
|
||||
cstoper.o: LLlex.h Lpars.h def_sizes.h idf.h node.h standards.h type.h
|
||||
cstoper.o: LLlex.h Lpars.h idf.h node.h standards.h target_sizes.h type.h
|
||||
chk_expr.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h
|
||||
tokenfile.o: Lpars.h
|
||||
program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
|
||||
declar.o: LLlex.h Lpars.h def.h idf.h misc.h node.h scope.h type.h
|
||||
expression.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h type.h
|
||||
statement.o: LLlex.h Lpars.h node.h
|
||||
statement.o: LLlex.h Lpars.h node.h type.h
|
||||
Lpars.o: Lpars.h
|
||||
|
|
|
|||
60
lang/m2/comp/Parameters
Normal file
60
lang/m2/comp/Parameters
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
!File: errout.h
|
||||
#define ERROUT STDERR /* file pointer for writing messages */
|
||||
#define MAXERR_LINE 5 /* maximum number of error messages given
|
||||
on the same input line. */
|
||||
|
||||
|
||||
!File: idfsize.h
|
||||
#define IDFSIZE 30 /* maximum significant length of an identifier */
|
||||
|
||||
|
||||
!File: numsize.h
|
||||
#define NUMSIZE 256 /* maximum length of a numeric constant */
|
||||
|
||||
|
||||
!File: strsize.h
|
||||
#define ISTRSIZE 32 /* minimum number of bytes allocated for
|
||||
storing a string */
|
||||
#define RSTRSIZE 8 /* step size in enlarging the memory for
|
||||
the storage of a string */
|
||||
|
||||
|
||||
!File: target_sizes.h
|
||||
#define MAXSIZE 8 /* the maximum of the SZ_* constants */
|
||||
|
||||
/* target machine sizes */
|
||||
#define SZ_CHAR (arith)1
|
||||
#define SZ_SHORT (arith)2
|
||||
#define SZ_WORD (arith)4
|
||||
#define SZ_INT (arith)4
|
||||
#define SZ_LONG (arith)4
|
||||
#define SZ_FLOAT (arith)4
|
||||
#define SZ_DOUBLE (arith)8
|
||||
#define SZ_POINTER (arith)4
|
||||
|
||||
/* target machine alignment requirements */
|
||||
#define AL_CHAR 1
|
||||
#define AL_SHORT SZ_SHORT
|
||||
#define AL_WORD SZ_WORD
|
||||
#define AL_INT SZ_WORD
|
||||
#define AL_LONG SZ_WORD
|
||||
#define AL_FLOAT SZ_WORD
|
||||
#define AL_DOUBLE SZ_WORD
|
||||
#define AL_POINTER SZ_WORD
|
||||
#define AL_STRUCT 1
|
||||
#define AL_UNION 1
|
||||
|
||||
|
||||
!File: debug.h
|
||||
#define DEBUG 1 /* perform various self-tests */
|
||||
extern char options[];
|
||||
#ifdef DEBUG
|
||||
#define DO_DEBUG(n, x) ((n) <= options['D'] && (x))
|
||||
#else
|
||||
#define DO_DEBUG(n, x)
|
||||
#endif DEBUG
|
||||
|
||||
!File: inputtype.h
|
||||
#undef INP_READ_IN_ONE 1 /* read input file in one */
|
||||
|
||||
|
||||
|
|
@ -79,7 +79,7 @@ chk_set(expp)
|
|||
if (expp->nd_left) {
|
||||
/* A type was given. Check it out
|
||||
*/
|
||||
(void) findname(expp->nd_left);
|
||||
findname(expp->nd_left);
|
||||
assert(expp->nd_left->nd_class == Def);
|
||||
df = expp->nd_left->nd_def;
|
||||
if ((df->df_kind != D_TYPE && df->df_kind != D_ERROR) ||
|
||||
|
|
@ -93,7 +93,7 @@ chk_set(expp)
|
|||
|
||||
/* Now check the elements given, and try to compute a constant set.
|
||||
*/
|
||||
set = (arith *) Malloc(tp->tp_size * sizeof(arith) / wrd_size);
|
||||
set = (arith *) Malloc(tp->tp_size * sizeof(arith) / word_size);
|
||||
nd = expp->nd_right;
|
||||
while (nd) {
|
||||
assert(nd->nd_class == Link && nd->nd_symb == ',');
|
||||
|
|
@ -149,7 +149,7 @@ node_error(expp, "Lower bound exceeds upper bound in range");
|
|||
}
|
||||
}
|
||||
else if (*set) {
|
||||
free(*set);
|
||||
free((char *) *set);
|
||||
*set = 0;
|
||||
}
|
||||
return 1;
|
||||
|
|
@ -223,7 +223,7 @@ getname(argp, kinds)
|
|||
return 0;
|
||||
}
|
||||
argp = argp->nd_right;
|
||||
if (!findname(argp->nd_left)) return 0;
|
||||
findname(argp->nd_left);
|
||||
assert(argp->nd_left->nd_class == Def);
|
||||
if (!(argp->nd_left->nd_def->df_kind & kinds)) {
|
||||
node_error(argp, "Unexpected type");
|
||||
|
|
@ -244,8 +244,8 @@ chk_call(expp)
|
|||
register struct node *arg;
|
||||
|
||||
expp->nd_type = error_type;
|
||||
(void) findname(expp->nd_left); /* parser made sure it is a name */
|
||||
left = expp->nd_left;
|
||||
findname(left);
|
||||
|
||||
if (left->nd_type == error_type) return 0;
|
||||
if (left->nd_class == Def &&
|
||||
|
|
@ -451,8 +451,8 @@ findname(expp)
|
|||
scope.
|
||||
*/
|
||||
register struct def *df;
|
||||
struct def *lookfor();
|
||||
register struct type *tp;
|
||||
struct def *lookfor();
|
||||
|
||||
expp->nd_type = error_type;
|
||||
if (expp->nd_class == Name) {
|
||||
|
|
@ -498,18 +498,18 @@ df->df_idf->id_text);
|
|||
}
|
||||
if (expp->nd_class == Oper) {
|
||||
assert(expp->nd_symb == '[');
|
||||
(void) findname(expp->nd_left);
|
||||
if (chk_expr(expp->nd_right, 0) &&
|
||||
findname(expp->nd_left);
|
||||
if (chk_expr(expp->nd_right) &&
|
||||
expp->nd_left->nd_type != error_type &&
|
||||
chk_oper(expp)) /* ??? */ ;
|
||||
return 1;
|
||||
return;
|
||||
}
|
||||
if (expp->nd_class == Uoper && expp->nd_symb == '^') {
|
||||
(void) findname(expp->nd_right);
|
||||
findname(expp->nd_right);
|
||||
if (expp->nd_right->nd_type != error_type &&
|
||||
chk_uoper(expp)) /* ??? */ ;
|
||||
}
|
||||
return 0;
|
||||
return;
|
||||
}
|
||||
|
||||
int
|
||||
|
|
@ -518,7 +518,7 @@ chk_name(expp)
|
|||
{
|
||||
register struct def *df;
|
||||
|
||||
(void) findname(expp);
|
||||
findname(expp);
|
||||
assert(expp->nd_class == Def);
|
||||
df = expp->nd_def;
|
||||
if (df->df_kind == D_ERROR) return 0;
|
||||
|
|
|
|||
|
|
@ -5,7 +5,9 @@ static char *RcsId = "$Header$";
|
|||
#include <em_arith.h>
|
||||
#include <em_label.h>
|
||||
#include <assert.h>
|
||||
#include "def_sizes.h"
|
||||
|
||||
#include "target_sizes.h"
|
||||
|
||||
#include "idf.h"
|
||||
#include "type.h"
|
||||
#include "LLlex.h"
|
||||
|
|
@ -211,7 +213,7 @@ cstset(expp)
|
|||
assert(expp->nd_right->nd_class == Set);
|
||||
assert(expp->nd_symb == IN || expp->nd_left->nd_class == Set);
|
||||
set2 = expp->nd_right->nd_set;
|
||||
setsize = expp->nd_right->nd_type->tp_size / wrd_size;
|
||||
setsize = expp->nd_right->nd_type->tp_size / word_size;
|
||||
|
||||
if (expp->nd_symb == IN) {
|
||||
arith i;
|
||||
|
|
@ -359,7 +361,8 @@ cstcall(expp, call)
|
|||
cut_size(expp);
|
||||
break;
|
||||
case S_SIZE:
|
||||
expp->nd_INT = align(expr->nd_type->tp_size, wrd_size)/wrd_size;
|
||||
expp->nd_INT = align(expr->nd_type->tp_size, (int) word_size) /
|
||||
word_size;
|
||||
break;
|
||||
case S_VAL:
|
||||
expp->nd_INT = expr->nd_INT;
|
||||
|
|
@ -435,12 +438,12 @@ init_cst()
|
|||
}
|
||||
mach_long_size = i;
|
||||
mach_long_sign = 1 << (mach_long_size * 8 - 1);
|
||||
if (lint_size > mach_long_size) {
|
||||
if (long_size > mach_long_size) {
|
||||
fatal("sizeof (long) insufficient on this machine");
|
||||
}
|
||||
|
||||
max_int = full_mask[int_size] & ~(1 << (int_size * 8 - 1));
|
||||
max_unsigned = full_mask[int_size];
|
||||
max_longint = full_mask[lint_size] & ~(1 << (lint_size * 8 - 1));
|
||||
wrd_bits = 8 * wrd_size;
|
||||
max_longint = full_mask[long_size] & ~(1 << (long_size * 8 - 1));
|
||||
wrd_bits = 8 * word_size;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ ProcedureDeclaration
|
|||
ProcedureHeading(&df, D_PROCEDURE)
|
||||
{ df->prc_level = proclevel++;
|
||||
}
|
||||
';' block IDENT
|
||||
';' block(&(df->prc_body)) IDENT
|
||||
{ match_id(dot.TOK_IDF, df->df_idf);
|
||||
df->prc_scope = CurrentScope;
|
||||
close_scope(SC_CHKFORW);
|
||||
|
|
@ -68,11 +68,17 @@ error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text);
|
|||
}
|
||||
;
|
||||
|
||||
block
|
||||
block(struct node **pnd;)
|
||||
{
|
||||
struct node *nd;
|
||||
}:
|
||||
declaration* [ BEGIN StatementSequence(&nd) ]? END
|
||||
declaration*
|
||||
[
|
||||
BEGIN
|
||||
StatementSequence(pnd)
|
||||
|
|
||||
{ *pnd = 0; }
|
||||
]
|
||||
END
|
||||
;
|
||||
|
||||
declaration:
|
||||
|
|
@ -101,7 +107,7 @@ FormalParameters(int doparams;
|
|||
{ pr1 = *pr; }
|
||||
[
|
||||
{ for (; pr1->next; pr1 = pr1->next) ; }
|
||||
';' FPSection(doparams, &(pr1->next), &parmaddr)
|
||||
';' FPSection(doparams, &(pr1->next), parmaddr)
|
||||
]*
|
||||
]?
|
||||
')'
|
||||
|
|
@ -149,8 +155,8 @@ FormalType(struct type **tp;)
|
|||
{ if (ARRAYflag) {
|
||||
*tp = construct_type(T_ARRAY, NULLTYPE);
|
||||
(*tp)->arr_elem = df->df_type;
|
||||
(*tp)->tp_align = lcm(wrd_align, ptr_align);
|
||||
(*tp)->tp_size = align(ptr_size + 3*wrd_size,
|
||||
(*tp)->tp_align = lcm(word_align, pointer_align);
|
||||
(*tp)->tp_size = align(pointer_size + 3*word_size,
|
||||
(*tp)->tp_align);
|
||||
}
|
||||
else *tp = df->df_type;
|
||||
|
|
@ -221,17 +227,17 @@ enumeration(struct type **ptp;)
|
|||
} :
|
||||
'(' IdentList(&EnumList) ')'
|
||||
{
|
||||
*ptp = standard_type(T_ENUMERATION,1,1);
|
||||
*ptp = standard_type(T_ENUMERATION, 1, (arith) 1);
|
||||
EnterIdList(EnumList, D_ENUM, 0, *ptp,
|
||||
CurrentScope, (arith *) 0);
|
||||
FreeNode(EnumList);
|
||||
if ((*ptp)->enm_ncst > 256) {
|
||||
if (wrd_size == 1) {
|
||||
if (word_size == 1) {
|
||||
error("Too many enumeration literals");
|
||||
}
|
||||
else {
|
||||
(*ptp)->tp_size = wrd_size;
|
||||
(*ptp)->tp_align = wrd_align;
|
||||
(*ptp)->tp_size = word_size;
|
||||
(*ptp)->tp_align = word_align;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -291,7 +297,7 @@ RecordType(struct type **ptp;)
|
|||
{
|
||||
struct scope *scope;
|
||||
arith count;
|
||||
int xalign = record_align;
|
||||
int xalign = struct_align;
|
||||
}
|
||||
:
|
||||
RECORD
|
||||
|
|
@ -391,28 +397,43 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
|
|||
variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;)
|
||||
{
|
||||
struct type *tp1 = tp;
|
||||
struct node *nd;
|
||||
} :
|
||||
[
|
||||
CaseLabelList(&tp1) ':' FieldListSequence(scope, cnt, palign)
|
||||
CaseLabelList(&tp1, &nd)
|
||||
{ /* Ignore the cases for the time being.
|
||||
Maybe a checking version will be supplied
|
||||
later ???
|
||||
*/
|
||||
FreeNode(nd);
|
||||
}
|
||||
':' FieldListSequence(scope, cnt, palign)
|
||||
]?
|
||||
/* Changed rule in new modula-2 */
|
||||
;
|
||||
|
||||
CaseLabelList(struct type **ptp;):
|
||||
CaseLabels(ptp) [ ',' CaseLabels(ptp) ]*
|
||||
CaseLabelList(struct type **ptp; struct node **pnd;):
|
||||
CaseLabels(ptp, pnd)
|
||||
[
|
||||
{ *pnd = MkNode(Link, *pnd, NULLNODE, &dot); }
|
||||
',' CaseLabels(ptp, &((*pnd)->nd_right))
|
||||
{ pnd = &((*pnd)->nd_right); }
|
||||
]*
|
||||
;
|
||||
|
||||
CaseLabels(struct type **ptp;)
|
||||
CaseLabels(struct type **ptp; struct node **pnd;)
|
||||
{
|
||||
struct node *nd1, *nd2 = 0;
|
||||
}:
|
||||
ConstExpression(&nd1)
|
||||
ConstExpression(&nd1) { *pnd = nd1; }
|
||||
[
|
||||
UPTO ConstExpression(&nd2)
|
||||
UPTO { *pnd = MkNode(Link,nd1,NULLNODE,&dot); }
|
||||
ConstExpression(&nd2)
|
||||
{ if (!TstCompat(nd1->nd_type, nd2->nd_type)) {
|
||||
node_error(nd2,"type incompatibility in case label");
|
||||
}
|
||||
nd1->nd_type = error_type;
|
||||
(*pnd)->nd_right = nd2;
|
||||
}
|
||||
]?
|
||||
{ if (*ptp != 0 &&
|
||||
|
|
|
|||
|
|
@ -3,10 +3,12 @@
|
|||
/* $Header$ */
|
||||
|
||||
struct module {
|
||||
int mo_priority; /* priority of a module */
|
||||
arith mo_priority; /* priority of a module */
|
||||
struct scope *mo_scope; /* scope of this module */
|
||||
struct node *mo_body; /* body of this module */
|
||||
#define mod_priority df_value.df_module.mo_priority
|
||||
#define mod_scope df_value.df_module.mo_scope
|
||||
#define mod_body df_value.df_module.mo_body
|
||||
};
|
||||
|
||||
struct variable {
|
||||
|
|
@ -43,9 +45,11 @@ struct dfproc {
|
|||
struct scope *pr_scope; /* scope of procedure */
|
||||
int pr_level; /* depth level of this procedure */
|
||||
arith pr_nbpar; /* Number of bytes parameters */
|
||||
struct node *pr_body; /* body of this procedure */
|
||||
#define prc_scope df_value.df_proc.pr_scope
|
||||
#define prc_level df_value.df_proc.pr_level
|
||||
#define prc_nbpar df_value.df_proc.pr_nbpar
|
||||
#define prc_body df_value.df_proc.pr_body
|
||||
};
|
||||
|
||||
struct import {
|
||||
|
|
|
|||
|
|
@ -9,15 +9,15 @@ static char *RcsId = "$Header$";
|
|||
|
||||
#include <system.h>
|
||||
#include <em_arith.h>
|
||||
|
||||
#include "errout.h"
|
||||
|
||||
#include "input.h"
|
||||
#include "f_info.h"
|
||||
#include "LLlex.h"
|
||||
#include "main.h"
|
||||
#include "node.h"
|
||||
|
||||
#define MAXERR_LINE 5 /* Number of error messages on one line ... */
|
||||
#define ERROUT STDERR
|
||||
|
||||
/* error classes */
|
||||
#define ERROR 1
|
||||
#define WARNING 2
|
||||
|
|
|
|||
|
|
@ -2,6 +2,8 @@
|
|||
|
||||
/* $Header$ */
|
||||
|
||||
#include "inputtype.h"
|
||||
|
||||
#define INP_NPUSHBACK 2
|
||||
#define INP_TYPE struct f_info
|
||||
#define INP_VAR file_info
|
||||
|
|
|
|||
|
|
@ -28,14 +28,14 @@ char *getenv();
|
|||
main(argc, argv)
|
||||
char *argv[];
|
||||
{
|
||||
register Nargc = 1;
|
||||
register int Nargc = 1;
|
||||
register char **Nargv = &argv[0];
|
||||
|
||||
ProgName = *argv++;
|
||||
|
||||
while (--argc > 0) {
|
||||
if (**argv == '-')
|
||||
Option(*argv++);
|
||||
do_option((*argv++) + 1);
|
||||
else
|
||||
Nargv[Nargc++] = *argv++;
|
||||
}
|
||||
|
|
@ -71,16 +71,14 @@ Compile(src)
|
|||
init_types();
|
||||
add_standards();
|
||||
#ifdef DEBUG
|
||||
if (options['L']) LexScan();
|
||||
else {
|
||||
if (options['l']) LexScan();
|
||||
else
|
||||
#endif DEBUG
|
||||
{
|
||||
(void) open_scope(CLOSEDSCOPE);
|
||||
GlobalScope = CurrentScope;
|
||||
CompUnit();
|
||||
#ifdef DEBUG
|
||||
}
|
||||
if (options['h']) hash_stat();
|
||||
#endif DEBUG
|
||||
if (err_occurred) return 0;
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -117,12 +115,6 @@ LexScan()
|
|||
}
|
||||
#endif
|
||||
|
||||
Option(str)
|
||||
char *str;
|
||||
{
|
||||
options[str[1]]++; /* switch option on */
|
||||
}
|
||||
|
||||
add_standards()
|
||||
{
|
||||
register struct def *df;
|
||||
|
|
|
|||
35
lang/m2/comp/make.hfiles
Executable file
35
lang/m2/comp/make.hfiles
Executable file
|
|
@ -0,0 +1,35 @@
|
|||
: Update Files from database
|
||||
|
||||
PATH=/bin:/usr/bin
|
||||
|
||||
case $# in
|
||||
1) ;;
|
||||
*) echo use: $0 file >&2
|
||||
exit 1
|
||||
esac
|
||||
|
||||
(
|
||||
IFCOMMAND="if (<\$FN) 2>/dev/null;\
|
||||
then if cmp -s \$FN \$TMP;\
|
||||
then rm \$TMP;\
|
||||
else mv \$TMP \$FN;\
|
||||
echo update \$FN;\
|
||||
fi;\
|
||||
else mv \$TMP \$FN;\
|
||||
echo create \$FN;\
|
||||
fi"
|
||||
echo 'TMP=.uf$$'
|
||||
echo 'FN=$TMP'
|
||||
echo 'cat >$TMP <<\!EOF!'
|
||||
sed -n '/^!File:/,${
|
||||
/^$/d
|
||||
/^!File:[ ]*\(.*\)$/s@@!EOF!\
|
||||
'"$IFCOMMAND"'\
|
||||
FN=\1\
|
||||
cat >$TMP <<\\!EOF!@
|
||||
p
|
||||
}' $1
|
||||
echo '!EOF!'
|
||||
echo $IFCOMMAND
|
||||
) |
|
||||
sh
|
||||
114
lang/m2/comp/options.c
Normal file
114
lang/m2/comp/options.c
Normal file
|
|
@ -0,0 +1,114 @@
|
|||
/* U S E R O P T I O N - H A N D L I N G */
|
||||
|
||||
static char *RcsId = "$Header$";
|
||||
|
||||
#include <em_arith.h>
|
||||
#include <em_label.h>
|
||||
|
||||
#include "idfsize.h"
|
||||
|
||||
#include "type.h"
|
||||
|
||||
extern char options[];
|
||||
extern int idfsize;
|
||||
|
||||
do_option(text)
|
||||
char *text;
|
||||
{
|
||||
switch(*text++) {
|
||||
|
||||
default:
|
||||
options[text[-1]] = 1; /* flags, debug options etc. */
|
||||
break;
|
||||
|
||||
case 'L' :
|
||||
warning("-L: default no EM profiling; use -p for EM profiling");
|
||||
break;
|
||||
|
||||
case 'M': /* maximum identifier length */
|
||||
idfsize = txt2int(&text);
|
||||
if (*text || idfsize <= 0)
|
||||
fatal("malformed -M option");
|
||||
if (idfsize > IDFSIZE)
|
||||
fatal("maximum identifier length is %d", IDFSIZE);
|
||||
break;
|
||||
|
||||
case 'p' : /* generate profiling code (fil/lin) */
|
||||
options['p'] = 1;
|
||||
break;
|
||||
|
||||
case 'V' : /* set object sizes and alignment requirements */
|
||||
{
|
||||
arith size;
|
||||
int align;
|
||||
char c;
|
||||
|
||||
while (c = *text++) {
|
||||
size = txt2int(&text);
|
||||
align = 0;
|
||||
if (*text == '.') {
|
||||
text++;
|
||||
align = txt2int(&text);
|
||||
}
|
||||
switch (c) {
|
||||
|
||||
case 'w': /* word */
|
||||
if (size != (arith)0) word_size = size;
|
||||
if (align != 0) word_align = align;
|
||||
break;
|
||||
case 'i': /* int */
|
||||
if (size != (arith)0) int_size = size;
|
||||
if (align != 0) int_align = align;
|
||||
break;
|
||||
case 'l': /* longint */
|
||||
if (size != (arith)0) long_size = size;
|
||||
if (align != 0) long_align = align;
|
||||
break;
|
||||
case 'f': /* real */
|
||||
if (size != (arith)0) float_size = size;
|
||||
if (align != 0) float_align = align;
|
||||
break;
|
||||
case 'd': /* longreal */
|
||||
if (size != (arith)0) double_size = size;
|
||||
if (align != 0) double_align = align;
|
||||
break;
|
||||
case 'p': /* pointer */
|
||||
if (size != (arith)0) pointer_size = size;
|
||||
if (align != 0) pointer_align = align;
|
||||
break;
|
||||
case 'S': /* initial record alignment */
|
||||
if (align != (arith)0) struct_align = align;
|
||||
break;
|
||||
default:
|
||||
error("-V: bad type indicator %c\n", c);
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
case 'n':
|
||||
options['n'] = 1; /* use no registers */
|
||||
break;
|
||||
|
||||
case 'w':
|
||||
options['w'] = 1; /* no warnings will be given */
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
int
|
||||
txt2int(tp)
|
||||
char **tp;
|
||||
{
|
||||
/* the integer pointed to by *tp is read, while increasing
|
||||
*tp; the resulting value is yielded.
|
||||
*/
|
||||
register int val = 0;
|
||||
register int ch;
|
||||
|
||||
while (ch = **tp, ch >= '0' && ch <= '9') {
|
||||
val = val * 10 + ch - '0';
|
||||
(*tp)++;
|
||||
}
|
||||
return val;
|
||||
}
|
||||
|
|
@ -43,7 +43,7 @@ static int DEFofIMPL = 0; /* Flag indicating that we are currently
|
|||
ModuleDeclaration
|
||||
{
|
||||
struct idf *id;
|
||||
struct def *df;
|
||||
register struct def *df;
|
||||
} :
|
||||
MODULE IDENT {
|
||||
id = dot.TOK_IDF;
|
||||
|
|
@ -57,20 +57,27 @@ ModuleDeclaration
|
|||
standard_type(T_RECORD, 0, (arith) 0);
|
||||
df->df_type->rec_scope = df->mod_scope;
|
||||
}
|
||||
priority? ';'
|
||||
priority(&(df->mod_priority))?
|
||||
';'
|
||||
import(1)*
|
||||
export(0)?
|
||||
block
|
||||
block(&(df->mod_body))
|
||||
IDENT { close_scope(SC_CHKFORW|SC_CHKPROC);
|
||||
match_id(id, dot.TOK_IDF);
|
||||
}
|
||||
;
|
||||
|
||||
priority
|
||||
priority(arith *pprio;)
|
||||
{
|
||||
struct node *nd;
|
||||
}:
|
||||
} :
|
||||
'[' ConstExpression(&nd) ']'
|
||||
{ if (!(nd->nd_type->tp_fund & T_INTORCARD)) {
|
||||
node_error(nd, "Illegal priority");
|
||||
}
|
||||
*pprio = nd->nd_INT;
|
||||
FreeNode(nd);
|
||||
}
|
||||
;
|
||||
|
||||
export(int def;)
|
||||
|
|
@ -161,7 +168,7 @@ definition
|
|||
{
|
||||
struct def *df;
|
||||
} :
|
||||
CONST [ ConstantDeclaration ';' ]*
|
||||
CONST [ ConstantDeclaration Semicolon ]*
|
||||
|
|
||||
TYPE
|
||||
[ IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
|
||||
|
|
@ -175,38 +182,48 @@ definition
|
|||
{ df->df_kind = D_HIDDEN;
|
||||
}
|
||||
]
|
||||
';'
|
||||
Semicolon
|
||||
]*
|
||||
|
|
||||
VAR [ VariableDeclaration ';' ]*
|
||||
VAR [ VariableDeclaration Semicolon ]*
|
||||
|
|
||||
ProcedureHeading(&df, D_PROCHEAD) ';'
|
||||
ProcedureHeading(&df, D_PROCHEAD) Semicolon
|
||||
;
|
||||
|
||||
Semicolon:
|
||||
';'
|
||||
|
|
||||
{ warning("; expected"); }
|
||||
;
|
||||
|
||||
ProgramModule(int state;)
|
||||
{
|
||||
struct idf *id;
|
||||
struct def *df, *GetDefinitionModule();
|
||||
struct scope *scope = 0;
|
||||
struct def *GetDefinitionModule();
|
||||
register struct def *df;
|
||||
} :
|
||||
MODULE
|
||||
IDENT {
|
||||
id = dot.TOK_IDF;
|
||||
if (state == IMPLEMENTATION) {
|
||||
DEFofIMPL = 1;
|
||||
df = GetDefinitionModule(id);
|
||||
CurrentScope = df->mod_scope;
|
||||
DEFofIMPL = 0;
|
||||
DefinitionModule = 0;
|
||||
}
|
||||
else open_scope(CLOSEDSCOPE);
|
||||
}
|
||||
priority?
|
||||
IDENT {
|
||||
id = dot.TOK_IDF;
|
||||
if (state == IMPLEMENTATION) {
|
||||
DEFofIMPL = 1;
|
||||
df = GetDefinitionModule(id);
|
||||
CurrentScope = df->mod_scope;
|
||||
DEFofIMPL = 0;
|
||||
DefinitionModule = 0;
|
||||
}
|
||||
else {
|
||||
df = define(id, CurrentScope, D_MODULE);
|
||||
open_scope(CLOSEDSCOPE);
|
||||
df->mod_scope = CurrentScope;
|
||||
}
|
||||
}
|
||||
priority(&(df->mod_priority))?
|
||||
';' import(0)*
|
||||
block IDENT
|
||||
{ close_scope(SC_CHKFORW|SC_CHKPROC);
|
||||
match_id(id, dot.TOK_IDF);
|
||||
}
|
||||
block(&(df->mod_body)) IDENT
|
||||
{ close_scope(SC_CHKFORW|SC_CHKPROC);
|
||||
match_id(id, dot.TOK_IDF);
|
||||
}
|
||||
'.'
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -23,7 +23,6 @@ open_scope(scopetype)
|
|||
/* Open a scope that is either open (automatic imports) or closed.
|
||||
*/
|
||||
register struct scope *sc = new_scope();
|
||||
register struct scope *sc1;
|
||||
|
||||
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
|
||||
sc->sc_scopeclosed = scopetype == CLOSEDSCOPE;
|
||||
|
|
@ -161,6 +160,24 @@ rem_forwards(fo)
|
|||
}
|
||||
}
|
||||
|
||||
Reverse(pdf)
|
||||
register struct def **pdf;
|
||||
{
|
||||
/* Reverse the order in the list of definitions in a scope.
|
||||
This is neccesary because this list is built in reverse.
|
||||
*/
|
||||
register struct def *df, *df1;
|
||||
|
||||
df = 0;
|
||||
df1 = *pdf;
|
||||
while (df1) {
|
||||
df1 = df1->df_nextinscope;
|
||||
(*pdf)->df_nextinscope = df;
|
||||
df = *pdf;
|
||||
*pdf = df1;
|
||||
}
|
||||
}
|
||||
|
||||
close_scope(flag)
|
||||
{
|
||||
/* Close a scope. If "flag" is set, check for forward declarations,
|
||||
|
|
@ -177,6 +194,7 @@ close_scope(flag)
|
|||
DO_DEBUG(2, PrScopeDef(sc->sc_def));
|
||||
if (flag & SC_CHKPROC) chk_proc(sc->sc_def);
|
||||
if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def));
|
||||
Reverse(&(sc->sc_def));
|
||||
}
|
||||
CurrentScope = sc->next;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4,7 +4,9 @@
|
|||
static char *RcsId = "$Header$";
|
||||
|
||||
#include <em_arith.h>
|
||||
#include <em_label.h>
|
||||
#include "LLlex.h"
|
||||
#include "type.h"
|
||||
#include "node.h"
|
||||
|
||||
static int loopcount = 0; /* Count nested loops */
|
||||
|
|
@ -12,7 +14,7 @@ static int loopcount = 0; /* Count nested loops */
|
|||
|
||||
statement(struct node **pnd;)
|
||||
{
|
||||
struct node *nd1;
|
||||
register struct node *nd;
|
||||
} :
|
||||
{ *pnd = 0; }
|
||||
[
|
||||
|
|
@ -21,16 +23,16 @@ statement(struct node **pnd;)
|
|||
* states : assignment | ProcedureCall | ...
|
||||
* but this gives LL(1) conflicts
|
||||
*/
|
||||
designator(&nd1)
|
||||
[ { nd1 = MkNode(Call, nd1, NULLNODE, &dot);
|
||||
nd1->nd_symb = '(';
|
||||
designator(pnd)
|
||||
[ { nd = MkNode(Call, *pnd, NULLNODE, &dot);
|
||||
nd->nd_symb = '(';
|
||||
}
|
||||
ActualParameters(&(nd1->nd_right))?
|
||||
ActualParameters(&(nd->nd_right))?
|
||||
|
|
||||
BECOMES { nd1 = MkNode(Stat, nd1, NULLNODE, &dot); }
|
||||
expression(&(nd1->nd_right))
|
||||
BECOMES { nd = MkNode(Stat, *pnd, NULLNODE, &dot); }
|
||||
expression(&(nd->nd_right))
|
||||
]
|
||||
{ *pnd = nd1; }
|
||||
{ *pnd = nd; }
|
||||
/*
|
||||
* end of changed part
|
||||
*/
|
||||
|
|
@ -58,9 +60,9 @@ statement(struct node **pnd;)
|
|||
*pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot);
|
||||
}
|
||||
|
|
||||
RETURN { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
|
||||
RETURN { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
|
||||
[
|
||||
expression(&((*pnd)->nd_right))
|
||||
expression(&(nd->nd_right))
|
||||
]?
|
||||
]?
|
||||
;
|
||||
|
|
@ -138,7 +140,7 @@ CaseStatement(struct node **pnd;)
|
|||
|
||||
case(struct node **pnd; struct type **ptp;) :
|
||||
{ *pnd = 0; }
|
||||
[ CaseLabelList(ptp/*,pnd*/)
|
||||
[ CaseLabelList(ptp, pnd)
|
||||
':' { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); }
|
||||
StatementSequence(&((*pnd)->nd_right))
|
||||
]?
|
||||
|
|
|
|||
|
|
@ -102,21 +102,21 @@ extern struct type
|
|||
*error_type; /* All from type.c */
|
||||
|
||||
extern int
|
||||
wrd_align,
|
||||
word_align,
|
||||
int_align,
|
||||
lint_align,
|
||||
real_align,
|
||||
lreal_align,
|
||||
ptr_align,
|
||||
record_align; /* All from type.c */
|
||||
long_align,
|
||||
float_align,
|
||||
double_align,
|
||||
pointer_align,
|
||||
struct_align; /* All from type.c */
|
||||
|
||||
extern arith
|
||||
wrd_size,
|
||||
word_size,
|
||||
int_size,
|
||||
lint_size,
|
||||
real_size,
|
||||
lreal_size,
|
||||
ptr_size; /* All from type.c */
|
||||
long_size,
|
||||
float_size,
|
||||
double_size,
|
||||
pointer_size; /* All from type.c */
|
||||
|
||||
extern arith
|
||||
align(); /* type.c */
|
||||
|
|
|
|||
|
|
@ -6,34 +6,36 @@ static char *RcsId = "$Header$";
|
|||
#include <alloc.h>
|
||||
#include <em_arith.h>
|
||||
#include <em_label.h>
|
||||
#include "def_sizes.h"
|
||||
|
||||
#include "target_sizes.h"
|
||||
#include "debug.h"
|
||||
|
||||
#include "def.h"
|
||||
#include "type.h"
|
||||
#include "idf.h"
|
||||
#include "LLlex.h"
|
||||
#include "node.h"
|
||||
#include "const.h"
|
||||
#include "debug.h"
|
||||
|
||||
/* To be created dynamically in main() from defaults or from command
|
||||
line parameters.
|
||||
*/
|
||||
int
|
||||
wrd_align = AL_WORD,
|
||||
word_align = AL_WORD,
|
||||
int_align = AL_INT,
|
||||
lint_align = AL_LONG,
|
||||
real_align = AL_FLOAT,
|
||||
lreal_align = AL_DOUBLE,
|
||||
ptr_align = AL_POINTER,
|
||||
record_align = AL_STRUCT;
|
||||
long_align = AL_LONG,
|
||||
float_align = AL_FLOAT,
|
||||
double_align = AL_DOUBLE,
|
||||
pointer_align = AL_POINTER,
|
||||
struct_align = AL_STRUCT;
|
||||
|
||||
arith
|
||||
wrd_size = SZ_WORD,
|
||||
word_size = SZ_WORD,
|
||||
int_size = SZ_INT,
|
||||
lint_size = SZ_LONG,
|
||||
real_size = SZ_FLOAT,
|
||||
lreal_size = SZ_DOUBLE,
|
||||
ptr_size = SZ_POINTER;
|
||||
long_size = SZ_LONG,
|
||||
float_size = SZ_FLOAT,
|
||||
double_size = SZ_DOUBLE,
|
||||
pointer_size = SZ_POINTER;
|
||||
|
||||
struct type
|
||||
*bool_type,
|
||||
|
|
@ -83,12 +85,12 @@ construct_type(fund, tp)
|
|||
switch (fund) {
|
||||
case T_PROCEDURE:
|
||||
case T_POINTER:
|
||||
dtp->tp_align = ptr_align;
|
||||
dtp->tp_size = ptr_size;
|
||||
dtp->tp_align = pointer_align;
|
||||
dtp->tp_size = pointer_size;
|
||||
dtp->next = tp;
|
||||
break;
|
||||
case T_SET:
|
||||
dtp->tp_align = wrd_align;
|
||||
dtp->tp_align = word_align;
|
||||
dtp->next = tp;
|
||||
break;
|
||||
case T_ARRAY:
|
||||
|
|
@ -135,17 +137,17 @@ init_types()
|
|||
bool_type = standard_type(T_ENUMERATION, 1, (arith) 1);
|
||||
bool_type->enm_ncst = 2;
|
||||
int_type = standard_type(T_INTEGER, int_align, int_size);
|
||||
longint_type = standard_type(T_INTEGER, lint_align, lint_size);
|
||||
longint_type = standard_type(T_INTEGER, long_align, long_size);
|
||||
card_type = standard_type(T_CARDINAL, int_align, int_size);
|
||||
real_type = standard_type(T_REAL, real_align, real_size);
|
||||
longreal_type = standard_type(T_REAL, lreal_align, lreal_size);
|
||||
word_type = standard_type(T_WORD, wrd_align, wrd_size);
|
||||
real_type = standard_type(T_REAL, float_align, float_size);
|
||||
longreal_type = standard_type(T_REAL, double_align, double_size);
|
||||
word_type = standard_type(T_WORD, word_align, word_size);
|
||||
intorcard_type = standard_type(T_INTORCARD, int_align, int_size);
|
||||
string_type = standard_type(T_STRING, 1, (arith) -1);
|
||||
address_type = construct_type(T_POINTER, word_type);
|
||||
tp = construct_type(T_SUBRANGE, int_type);
|
||||
tp->sub_lb = 0;
|
||||
tp->sub_ub = wrd_size * 8 - 1;
|
||||
tp->sub_ub = word_size * 8 - 1;
|
||||
bitset_type = set_type(tp);
|
||||
std_type = construct_type(T_PROCEDURE, NULLTYPE);
|
||||
error_type = standard_type(T_CHAR, 1, (arith) 1);
|
||||
|
|
@ -265,7 +267,7 @@ set_type(tp)
|
|||
/* Construct a set type with base type "tp", but first
|
||||
perform some checks
|
||||
*/
|
||||
int lb, ub;
|
||||
arith lb, ub;
|
||||
|
||||
if (tp->tp_fund == T_SUBRANGE) {
|
||||
if ((lb = tp->sub_lb) < 0 || (ub = tp->sub_ub) > MAX_SET - 1) {
|
||||
|
|
@ -285,7 +287,7 @@ set_type(tp)
|
|||
return error_type;
|
||||
}
|
||||
tp = construct_type(T_SET, tp);
|
||||
tp->tp_size = align(((ub - lb) + 7)/8, wrd_align);
|
||||
tp->tp_size = align(((ub - lb) + 7)/8, word_align);
|
||||
return tp;
|
||||
}
|
||||
|
||||
|
|
@ -346,13 +348,9 @@ gcd(m, n)
|
|||
|
||||
int
|
||||
lcm(m, n)
|
||||
register int m, n;
|
||||
int m, n;
|
||||
{
|
||||
/* Least Common Multiple
|
||||
*/
|
||||
while (m != n) {
|
||||
if (m < n) m = m + m;
|
||||
else n = n + n;
|
||||
}
|
||||
return n; /* or m */
|
||||
return m * (n / gcd(m, n));
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue