#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"
#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()
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) {
}
*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);
}
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 = ˙
register struct idf *id;
do {
- if (tg - buf < IDFSIZE) *tg++ = ch;
+ if (tg - buf < idfsize) *tg++ = ch;
LoadChar(ch);
} while(in_idf(ch));
/* $Header$ */
struct string {
- int s_length; /* length of a string */
+ unsigned int s_length; /* length of a string */
char *s_str; /* the string itself */
};
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
$(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
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
--- /dev/null
+!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 */
+
+
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) ||
/* 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 == ',');
}
}
else if (*set) {
- free(*set);
+ free((char *) *set);
*set = 0;
}
return 1;
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");
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 &&
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) {
}
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
{
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;
#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"
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;
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;
}
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;
}
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);
}
;
-block
+block(struct node **pnd;)
{
- struct node *nd;
}:
- declaration* [ BEGIN StatementSequence(&nd) ]? END
+ declaration*
+ [
+ BEGIN
+ StatementSequence(pnd)
+ |
+ { *pnd = 0; }
+ ]
+ END
;
declaration:
{ pr1 = *pr; }
[
{ for (; pr1->next; pr1 = pr1->next) ; }
- ';' FPSection(doparams, &(pr1->next), &parmaddr)
+ ';' FPSection(doparams, &(pr1->next), parmaddr)
]*
]?
')'
{ 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;
} :
'(' 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;
}
}
}
{
struct scope *scope;
arith count;
- int xalign = record_align;
+ int xalign = struct_align;
}
:
RECORD
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 &&
/* $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 {
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 {
#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
/* $Header$ */
+#include "inputtype.h"
+
#define INP_NPUSHBACK 2
#define INP_TYPE struct f_info
#define INP_VAR file_info
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++;
}
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;
}
}
#endif
-Option(str)
- char *str;
-{
- options[str[1]]++; /* switch option on */
-}
-
add_standards()
{
register struct def *df;
--- /dev/null
+: 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
--- /dev/null
+/* 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;
+}
ModuleDeclaration
{
struct idf *id;
- struct def *df;
+ register struct def *df;
} :
MODULE IDENT {
id = dot.TOK_IDF;
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;)
{
struct def *df;
} :
- CONST [ ConstantDeclaration ';' ]*
+ CONST [ ConstantDeclaration Semicolon ]*
|
TYPE
[ IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
{ 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);
+ }
'.'
;
/* 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;
}
}
+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,
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;
}
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 */
statement(struct node **pnd;)
{
- struct node *nd1;
+ register struct node *nd;
} :
{ *pnd = 0; }
[
* 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
*/
*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))
]?
]?
;
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))
]?
*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 */
#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,
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:
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);
/* 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) {
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;
}
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));
}