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

newer version

Browse source
This commit is contained in:
ceriel 1986-05-14 09:03:51 +00:00
parent 0bf57a9c64
commit 15896e422c
6 changed files with 72 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
lang/m2/comp/Makefile
View file

@ -44,8 +44,8 @@ main: $(OBJ) Makefile
clean:
rm -f $(OBJ) $(GENFILES) LLfiles
lint: LLfiles lintlist
lint $(INCLUDES) `cat lintlist`
lint: LLfiles hfiles
lint $(INCLUDES) -DNORCSID `sources $(OBJ)`
tokenfile.g: tokenname.c make.tokfile
make.tokfile <tokenname.c >tokenfile.g
@ -79,11 +79,11 @@ depend:
make.allocd < $< > $@
#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
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
LLlex.o: LLlex.h Lpars.h class.h const.h debug.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 debug.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 ndirs.h node.h scope.h standards.h tokenname.h type.h
main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h ndir.h node.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
@ -92,17 +92,18 @@ type.o: LLlex.h const.h debug.h def.h idf.h maxset.h node.h target_sizes.h type.
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 main.h node.h scope.h type.h
enter.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h
defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h main.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 idf.h node.h standards.h target_sizes.h type.h
cstoper.o: LLlex.h Lpars.h debug.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
options.o: idfsize.h main.h ndir.h type.h
walk.o: LLlex.h Lpars.h debug.h def.h main.h node.h scope.h type.h
casestat.o: LLlex.h Lpars.h debug.h density.h node.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 main.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
declar.o: LLlex.h Lpars.h debug.h def.h idf.h main.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 type.h
statement.o: LLlex.h Lpars.h def.h idf.h node.h scope.h type.h
Lpars.o: Lpars.h

7
lang/m2/comp/casestat.C
View file

@ -18,8 +18,6 @@ static char *RcsId = "$Header$";
#include "density.h"
/* STATICALLOCDEF "caselist" */
struct switch_hdr {
struct switch_hdr *next;
label sh_break;
@ -102,7 +100,7 @@ CaseCode(nd, exitlabel)
tablabel = data_label(); /* the rom must have a label */
C_df_dlb(tablabel);
if (sh->sh_default) C_rom_ilb(sh->sh_default);
else C_rom_ucon((arith) 0, pointer_size);
else C_rom_ucon("0", pointer_size);
if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) {
/* CSA */
@ -253,8 +251,7 @@ AddOneCase(sh, node, lbl)
*/
if (c1) {
if (c1->ce_value == ce->ce_value) {
node_error("multiple case entry for value %ld",
ce->ce_value);
node_error(node, "multiple case entry for value %ld", ce->ce_value);
free_case_entry(ce);
return 0;
}

34
lang/m2/comp/chk_expr.c
View file

@ -448,7 +448,7 @@ chk_designator(expp, flag)
assert(expp->nd_right->nd_class == Name);
if (! chk_designator(expp->nd_left,
(flag|HASSELECTORS)&DESIGNATOR)) return 0;
(flag|HASSELECTORS))) return 0;
tp = expp->nd_left->nd_type;
@ -633,7 +633,7 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
case '*':
switch(tpl->tp_fund) {
case T_POINTER:
if (tpl != address_type) break;
if (! chk_address(tpl, tpr)) break;
/* Fall through */
case T_INTEGER:
case T_CARDINAL:
@ -669,7 +669,13 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
case DIV:
case MOD:
if ((tpl->tp_fund & T_INTORCARD) || tpl == address_type) {
switch(tpl->tp_fund) {
case T_POINTER:
if (! chk_address(tpl, tpr)) break;
/* Fall through */
case T_INTEGER:
case T_CARDINAL:
case T_INTORCARD:
if (left->nd_class==Value && right->nd_class==Value) {
cstbin(expp);
}
@ -718,7 +724,8 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
return 1;
case T_POINTER:
if (expp->nd_symb == '=' ||
if (chk_address(tpl, tpr) ||
expp->nd_symb == '=' ||
expp->nd_symb == UNEQUAL ||
expp->nd_symb == '#') return 1;
break;
@ -745,6 +752,22 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
return 0;
}
int
chk_address(tpl, tpr)
register struct type *tpl, *tpr;
{
if (tpl == address_type) {
return tpr == address_type || tpr->tp_fund != T_POINTER;
}
if (tpr == address_type) {
return tpl->tp_fund != T_POINTER;
}
return 0;
}
int
chk_uoper(expp)
register struct node *expp;
@ -769,6 +792,9 @@ chk_uoper(expp)
case '-':
if (tpr->tp_fund & T_INTORCARD) {
if (tpr == intorcard_type) {
expp->nd_type = int_type;
}
if (right->nd_class == Value) {
cstunary(expp);
}

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

@ -56,6 +56,12 @@ ProcedureHeading(struct def **pdf; int type;)
PROCEDURE IDENT
{
df = DeclProc(type);
if (proclevel) {
/* Room for static link
*/
df->prc_nbpar = pointer_size;
}
else df->prc_nbpar = 0;
}
FormalParameters(type == D_PROCEDURE, &params, &tp, &(df->prc_nbpar))?
{

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

@ -477,7 +477,6 @@ DeclProc(type)
strcpy(CurrentScope->sc_name, buf);
C_inp(buf);
}
df->prc_nbpar = 0;
}
return df;

40
lang/m2/comp/walk.c
View file

@ -25,8 +25,6 @@ static char *RcsId = "$Header$";
extern arith align();
static int prclev = 0;
static label instructionlabel;
static label datalabel = 1;
static label return_label;
static char return_expr_occurred;
static struct type *func_type;
@ -39,7 +37,9 @@ text_label()
label
data_label()
{
return datalabel++;
static label datalabel = 0;
return ++datalabel;
}
WalkModule(module)
@ -89,14 +89,13 @@ WalkModule(module)
this module.
*/
CurrentScope->sc_off = 0;
instructionlabel = 1;
return_label = instructionlabel++;
instructionlabel = 2;
func_type = 0;
C_pro_narg(CurrentScope->sc_name);
MkCalls(CurrentScope->sc_def);
WalkNode(module->mod_body, (label) 0);
C_df_ilb(return_label);
C_ret((label) 0);
C_df_ilb((label) 1);
C_ret(0);
C_end(align(-CurrentScope->sc_off, word_align));
CurrVis = vis;
@ -121,15 +120,20 @@ WalkProcedure(procedure)
/* generate calls to initialization routines of modules defined within
this procedure
*/
return_label = 1;
MkCalls(CurrentScope->sc_def);
return_expr_occurred = 0;
instructionlabel = 2;
func_type = procedure->df_type->next;
MkCalls(CurrentScope->sc_def);
WalkNode(procedure->prc_body, (label) 0);
C_df_ilb(return_label);
if (func_type) C_ret((arith) align(func_type->tp_size, word_align));
else C_ret((arith) 0);
C_end(align(-CurrentScope->sc_off, word_size));
C_df_ilb((label) 1);
if (func_type) {
if (! return_expr_occurred) {
node_error(procedure->prc_body,"function procedure does not return a value");
}
C_ret((int) align(func_type->tp_size, word_align));
}
else C_ret(0);
C_end((int) align(-CurrentScope->sc_off, word_align));
CurrVis = vis;
prclev--;
}
@ -195,6 +199,12 @@ WalkStat(nd, lab)
register struct node *left = nd->nd_left;
register struct node *right = nd->nd_right;
if (!nd) {
/* Empty statement
*/
return;
}
if (nd->nd_class == Call) {
if (chk_call(nd)) CodeCall(nd);
return;
@ -204,8 +214,8 @@ WalkStat(nd, lab)
switch(nd->nd_symb) {
case BECOMES:
WalkDesignator(left);
WalkExpr(right);
WalkDesignator(left); /* May we do it in this order??? */
if (! TstAssCompat(left->nd_type, right->nd_type)) {
node_error(nd, "type incompatibility in assignment");
@ -318,7 +328,7 @@ node_error(right, "type incompatibility in RETURN statement");
}
return_expr_occurred = 1;
}
C_bra(return_label);
C_bra((label) 1);
break;
default: