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-21 18:32:20 +00:00
parent 5a84f07281
commit 0f04bc72bd
13 changed files with 870 additions and 64 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lang/m2/comp/Makefile
View file

@ -18,7 +18,7 @@ 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 options.o walk.o casestat.o
cstoper.o chk_expr.o options.o walk.o casestat.o desig.o code.o
OBJ = $(COBJ) $(LOBJ) Lpars.o
GENFILES= tokenfile.c \
program.c declar.c expression.c statement.c \

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

@ -15,6 +15,7 @@ static char *RcsId = "$Header$";
#include "type.h"
#include "LLlex.h"
#include "node.h"
#include "desig.h"
#include "density.h"
@ -64,7 +65,7 @@ CaseCode(nd, exitlabel)
assert(nd->nd_class == Stat && nd->nd_symb == CASE);
WalkExpr(nd->nd_left);
WalkExpr(nd->nd_left, NO_LABEL, NO_LABEL);
sh->sh_type = nd->nd_left->nd_type;
sh->sh_break = text_label();
sh->sh_default = 0;

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

@ -371,6 +371,12 @@ node_error(arg->nd_left, "type incompatibility in parameter");
return 0;
}
if (param->par_var &&
!chk_designator(arg->nd_left, VARIABLE|DESIGNATOR)) {
node_error(arg->nd_left,"VAR parameter expected");
return 0;
}
param = param->next;
}
@ -445,14 +451,20 @@ chk_designator(expp, flag)
if (expp->nd_class == Link) {
assert(expp->nd_symb == '.');
assert(expp->nd_right->nd_class == Name);
if (! chk_designator(expp->nd_left,
(flag|HASSELECTORS))) return 0;
tp = expp->nd_left->nd_type;
if (expp->nd_right->nd_class == Def) {
/* We were here already!
*/
return 1;
}
assert(tp->tp_fund == T_RECORD);
assert(expp->nd_right->nd_class == Name);
df = lookup(expp->nd_right->nd_IDF, tp->rec_scope);
@ -472,7 +484,8 @@ df->df_idf->id_text);
}
}
if (expp->nd_left->nd_class == Def) {
if (expp->nd_left->nd_class == Def &&
expp->nd_left->nd_def->df_kind == D_MODULE) {
expp->nd_class = Def;
expp->nd_def = df;
FreeNode(expp->nd_left);
@ -628,7 +641,7 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
symbol2str(expp->nd_symb));
return 0;
}
switch(expp->nd_symb) {
case '+':
case '-':

584
lang/m2/comp/code.c Normal file
View file

@ -0,0 +1,584 @@
/* C O D E G E N E R A T I O N R O U T I N E S */
#ifndef NORCSID
static char *RcsId = "$Header$";
#endif
/* Code generation for expressions and coercions
*/
#include "debug.h"
#include <em_arith.h>
#include <em_label.h>
#include <assert.h>
#include "type.h"
#include "def.h"
#include "scope.h"
#include "desig.h"
#include "LLlex.h"
#include "node.h"
#include "Lpars.h"
extern label data_label();
extern char *long2str();
extern char *symbol2str();
extern int proclevel;
CodeConst(cst, size)
arith cst, size;
{
/* Generate code to push constant "cst" with size "size"
*/
label dlab;
if (size <= word_size) {
C_loc(cst);
}
else if (size == dword_size) {
C_ldc(cst);
}
else {
C_df_dlb(dlab = data_label());
C_rom_icon(long2str((long) cst), 10);
C_lae_dlb(dlab);
C_loi(size);
}
}
CodeString(nd)
struct node *nd;
{
label lab;
C_df_dlb(lab = data_label());
C_rom_scon(nd->nd_STR, nd->nd_SLE);
C_lae_dlb(lab);
}
CodeReal(nd)
struct node *nd;
{
label lab;
C_df_dlb(lab = data_label());
C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
C_lae_dlb(lab);
C_loi(nd->nd_type->tp_size);
}
CodeExpr(nd, ds, true_label, false_label)
struct node *nd;
struct desig *ds;
label true_label, false_label;
{
struct desig ds1, ds2;
switch(nd->nd_class) {
case Def:
CodeDesig(nd, ds);
break;
case Oper:
if (nd->nd_symb == '[') {
CodeDesig(nd, ds);
break;
}
CodeOper(nd, true_label, false_label);
if (true_label == 0) ds->dsg_kind = DSG_LOADED;
else {
*ds = InitDesig;
true_label = 0;
}
break;
case Uoper:
if (nd->nd_symb == '^') {
CodeDesig(nd, ds);
break;
}
CodeExpr(nd->nd_right, ds, NO_LABEL, NO_LABEL);
CodeValue(ds, nd->nd_right->nd_type->tp_size);
CodeUoper(nd);
ds->dsg_kind = DSG_LOADED;
break;
case Value:
switch(nd->nd_symb) {
case REAL:
CodeReal(nd);
break;
case STRING:
CodeString(nd);
break;
case INTEGER:
CodeConst(nd->nd_INT, nd->nd_type->tp_size);
break;
default:
crash("Value error");
}
ds->dsg_kind = DSG_LOADED;
break;
case Link:
CodeDesig(nd, ds);
break;
case Call:
CodeCall(nd);
ds->dsg_kind = DSG_LOADED;
break;
case Xset:
case Set:
/* ??? */
ds->dsg_kind = DSG_LOADED;
break;
default:
crash("(CodeExpr) bad node type");
}
if (true_label != 0) {
CodeValue(ds, nd->nd_type->tp_size);
*ds = InitDesig;
C_zne(true_label);
C_bra(false_label);
}
}
CodeCoercion(t1, t2)
struct type *t1, *t2;
{
/* ??? */
}
CodeCall(nd)
struct node *nd;
{
/* Generate code for a procedure call. Checking of parameters
and result is already done.
*/
register struct node *left = nd->nd_left;
register struct node *arg = nd;
register struct paramlist *param;
struct type *tp;
arith pushed = 0;
struct desig Des;
if (left->nd_type == std_type) {
CodeStd(nd);
return;
}
tp = left->nd_type;
assert(tp->tp_fund == T_PROCEDURE);
for (param = left->nd_type->prc_params; param; param = param->next) {
Des = InitDesig;
arg = arg->nd_right;
assert(arg != 0);
if (param->par_var) {
CodeDesig(arg->nd_left, &Des);
CodeAddress(&Des);
pushed += pointer_size;
}
else {
CodeExpr(arg->nd_left, &Des, NO_LABEL, NO_LABEL);
CodeValue(&Des, arg->nd_left->nd_type->tp_size);
pushed += align(arg->nd_left->nd_type->tp_size, word_align);
}
/* ??? Conformant arrays */
}
if (left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) {
if (left->nd_def->df_scope->sc_level > 0) {
C_lxl((arith) proclevel - left->nd_def->df_scope->sc_level);
pushed += pointer_size;
}
C_cal(left->nd_def->prc_vis->sc_scope->sc_name);
}
else if (left->nd_class == Def && left->nd_def->df_kind == D_PROCHEAD) {
C_cal(left->nd_def->for_name);
}
else {
Des = InitDesig;
CodeDesig(left, &Des);
CodeAddress(&Des);
C_cai();
}
C_asp(pushed);
if (tp->next) {
C_lfr(align(tp->next->tp_size, word_align));
}
}
CodeStd(nd)
struct node *nd;
{
/* ??? */
}
CodeAssign(nd, dst, dss)
struct node *nd;
struct desig *dst, dss;
{
/* Generate code for an assignment. Testing of type
compatibility and the like is already done.
*/
CodeCoercion(nd->nd_right->nd_type, nd->nd_left->nd_type);
/* ??? */
}
Operands(leftop, rightop)
struct node *leftop, *rightop;
{
struct desig Des;
Des = InitDesig;
CodeExpr(leftop, &Des, NO_LABEL, NO_LABEL);
CodeValue(&Des, leftop->nd_type->tp_size);
Des = InitDesig;
if (rightop->nd_type->tp_fund == T_POINTER &&
leftop->nd_type->tp_size != pointer_size) {
CodeCoercion(leftop->nd_type, rightop->nd_type);
leftop->nd_type = rightop->nd_type;
}
CodeExpr(rightop, &Des, NO_LABEL, NO_LABEL);
CodeValue(&Des, rightop->nd_type->tp_size);
}
CodeOper(expr, true_label, false_label)
struct node *expr; /* the expression tree itself */
label true_label;
label false_label; /* labels to jump to in logical expr's */
{
register int oper = expr->nd_symb;
register struct node *leftop = expr->nd_left;
register struct node *rightop = expr->nd_right;
register struct type *tp = expr->nd_type;
struct desig Des;
register struct desig *ds = &Des;
switch (oper) {
case '+':
Operands(leftop, rightop);
switch (tp->tp_fund) {
case T_INTEGER:
C_adi(tp->tp_size);
break;
case T_POINTER:
C_ads(rightop->nd_type->tp_size);
break;
case T_REAL:
C_adf(tp->tp_size);
break;
case T_CARDINAL:
C_adu(tp->tp_size);
break;
case T_SET:
C_ior(tp->tp_size);
break;
default:
crash("bad type +");
}
break;
case '-':
Operands(leftop, rightop);
switch (tp->tp_fund) {
case T_INTEGER:
C_sbi(tp->tp_size);
break;
case T_POINTER:
if (rightop->nd_type->tp_fund == T_POINTER) {
C_sbs(pointer_size);
}
else {
C_ngi(rightop->nd_type->tp_size);
C_ads(rightop->nd_type->tp_size);
}
break;
case T_REAL:
C_sbf(tp->tp_size);
break;
case T_CARDINAL:
C_sbu(tp->tp_size);
break;
case T_SET:
C_com(tp->tp_size);
C_and(tp->tp_size);
break;
default:
crash("bad type -");
}
break;
case '*':
Operands(leftop, rightop);
switch (tp->tp_fund) {
case T_INTEGER:
C_mli(tp->tp_size);
break;
case T_POINTER:
CodeCoercion(rightop->nd_type, tp);
/* Fall through */
case T_CARDINAL:
C_mlu(tp->tp_size);
break;
case T_REAL:
C_mlf(tp->tp_size);
break;
case T_SET:
C_and(tp->tp_size);
break;
default:
crash("bad type *");
}
break;
case '/':
Operands(leftop, rightop);
switch (tp->tp_fund) {
case T_REAL:
C_dvf(tp->tp_size);
break;
case T_SET:
C_xor(tp->tp_size);
break;
default:
crash("bad type /");
}
break;
case DIV:
Operands(leftop, rightop);
switch(tp->tp_fund) {
case T_INTEGER:
C_dvi(tp->tp_size);
break;
case T_POINTER:
CodeCoercion(rightop->nd_type, tp);
/* Fall through */
case T_CARDINAL:
C_dvu(tp->tp_size);
break;
default:
crash("bad type DIV");
}
break;
case MOD:
Operands(leftop, rightop);
switch(tp->tp_fund) {
case T_INTEGER:
C_rmi(tp->tp_size);
break;
case T_POINTER:
CodeCoercion(rightop->nd_type, tp);
/* Fall through */
case T_CARDINAL:
C_rmu(tp->tp_size);
break;
default:
crash("bad type MOD");
}
break;
case '<':
case LESSEQUAL:
case '>':
case GREATEREQUAL:
case '=':
case UNEQUAL:
case '#':
Operands(leftop, rightop);
CodeCoercion(rightop->nd_type, leftop->nd_type);
switch (tp->tp_fund) {
case T_INTEGER:
C_cmi(leftop->nd_type->tp_size);
break;
case T_POINTER:
C_cmp();
break;
case T_CARDINAL:
C_cmu(leftop->nd_type->tp_size);
break;
case T_ENUMERATION:
case T_CHAR:
C_cmu(word_size);
break;
case T_REAL:
C_cmf(leftop->nd_type->tp_size);
break;
case T_SET:
C_cms(leftop->nd_type->tp_size);
break;
default:
crash("bad type COMPARE");
}
if (true_label != 0) {
compare(oper, true_label);
C_bra(false_label);
}
else {
truthvalue(oper);
}
break;
case IN:
Operands(leftop, rightop);
CodeCoercion(rightop->nd_type, word_type);
C_inn(leftop->nd_type->tp_size);
break;
case AND:
case '&':
if (true_label == 0) {
label l_true = text_label();
label l_false = text_label();
label l_maybe = text_label();
label l_end = text_label();
struct desig Des;
Des = InitDesig;
CodeExpr(leftop, &Des, l_maybe, l_false);
C_df_ilb(l_maybe);
Des = InitDesig;
CodeExpr(rightop, &Des, l_true, l_false);
C_df_ilb(l_true);
C_loc((arith)1);
C_bra(l_end);
C_df_ilb(l_false);
C_loc((arith)0);
C_df_ilb(l_end);
}
else {
label l_maybe = text_label();
struct desig Des;
Des = InitDesig;
CodeExpr(leftop, &Des, l_maybe, false_label);
Des = InitDesig;
C_df_ilb(l_maybe);
CodeExpr(rightop, &Des, true_label, false_label);
}
break;
case OR:
if (true_label == 0) {
label l_true = text_label();
label l_false = text_label();
label l_maybe = text_label();
label l_end = text_label();
struct desig Des;
Des = InitDesig;
CodeExpr(leftop, &Des, l_true, l_maybe);
C_df_ilb(l_maybe);
Des = InitDesig;
CodeExpr(rightop, &Des, l_true, l_false);
C_df_ilb(l_false);
C_loc((arith)0);
C_bra(l_end);
C_df_ilb(l_true);
C_loc((arith)1);
C_df_ilb(l_end);
}
else {
label l_maybe = text_label();
struct desig Des;
Des = InitDesig;
CodeExpr(leftop, &Des, true_label, l_maybe);
C_df_ilb(l_maybe);
Des = InitDesig;
CodeExpr(rightop, &Des, true_label, false_label);
}
break;
default:
crash("(CodeOper) Bad operator %s\n", symbol2str(oper));
}
}
/* compare() serves as an auxiliary function of CodeOper */
compare(relop, lbl)
int relop;
label lbl;
{
switch (relop) {
case '<':
C_zlt(lbl);
break;
case LESSEQUAL:
C_zle(lbl);
break;
case '>':
C_zgt(lbl);
break;
case GREATEREQUAL:
C_zge(lbl);
break;
case '=':
C_zeq(lbl);
break;
case UNEQUAL:
case '#':
C_zne(lbl);
break;
default:
crash("(compare)");
}
}
/* truthvalue() serves as an auxiliary function of CodeOper */
truthvalue(relop)
int relop;
{
switch (relop) {
case '<':
C_tlt();
break;
case LESSEQUAL:
C_tle();
break;
case '>':
C_tgt();
break;
case GREATEREQUAL:
C_tge();
break;
case '=':
C_teq();
break;
case UNEQUAL:
case '#':
C_tne();
break;
default:
crash("(truthvalue)");
}
}
CodeUoper(nd)
register struct node *nd;
{
register struct type *tp = nd->nd_type;
switch(nd->nd_symb) {
case '~':
case NOT:
C_teq();
break;
case '-':
switch(tp->tp_fund) {
case T_INTEGER:
C_ngi(tp->tp_size);
break;
case T_REAL:
C_ngf(tp->tp_size);
break;
default:
crash("Bad operand to unary -");
}
break;
default:
crash("Bad unary operator");
}
}

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

@ -56,16 +56,16 @@ ProcedureHeading(struct def **pdf; int type;)
{
if (type == D_PROCEDURE) proclevel++;
df = DeclProc(type);
tp = construct_type(T_PROCEDURE, tp);
if (proclevel > 1) {
/* Room for static link
*/
df->prc_nbpar = pointer_size;
tp->prc_nbpar = pointer_size;
}
else df->prc_nbpar = 0;
else tp->prc_nbpar = 0;
}
FormalParameters(type == D_PROCEDURE, &params, &tp, &(df->prc_nbpar))?
FormalParameters(type == D_PROCEDURE, &params, &(tp->next), &(tp->prc_nbpar))?
{
tp = construct_type(T_PROCEDURE, tp);
tp->prc_params = params;
if (df->df_type) {
/* We already saw a definition of this type

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

@ -45,10 +45,8 @@ struct field {
struct dfproc {
struct scopelist *pr_vis; /* scope of procedure */
arith pr_nbpar; /* number of bytes parameters */
struct node *pr_body; /* body of this procedure */
#define prc_vis df_value.df_proc.pr_vis
#define prc_nbpar df_value.df_proc.pr_nbpar
#define prc_body df_value.df_proc.pr_body
};

180
lang/m2/comp/desig.c
View file

@ -24,6 +24,10 @@ static char *RcsId = "$Header$";
#include "LLlex.h"
#include "node.h"
extern int proclevel;
struct desig Desig;
struct desig InitDesig = {DSG_INIT, 0, 0};
CodeValue(ds, size)
register struct desig *ds;
{
@ -44,7 +48,7 @@ CodeValue(ds, size)
break;
}
if (size == dwird_size) {
if (size == dword_size) {
if (ds->dsg_name) {
C_lde_dnam(ds->dsg_name, ds->dsg_offset);
}
@ -63,7 +67,7 @@ CodeValue(ds, size)
break;
default:
assert(0);
crash("(CodeValue)");
}
ds->dsg_kind = DSG_LOADED;
@ -101,8 +105,7 @@ CodeAddress(ds)
break;
default:
assert(0);
break;
crash("(CodeAddress)");
}
ds->dsg_offset = 0;
@ -152,13 +155,176 @@ CodeFieldDesig(df, ds)
case DSG_PFIXED:
case DSG_INDEXED:
CodeAddress(ds);
ds->dsg_kind = PLOADED;
ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = df->fld_off;
break;
default:
assert(0);
break;
crash("(CodeFieldDesig)");
}
}
CodeVarDesig(df, ds)
register struct def *df;
register struct desig *ds;
{
/* Generate code for a variable represented by a "def" structure.
Of course, there are numerous cases: the variable is local,
it is a value parameter, it is a var parameter, it is one of
those of an enclosing procedure, or it is global.
*/
register struct scope *sc = df->df_scope;
/* Selections from a module are handled earlier, when identifying
the variable, so ...
*/
assert(ds->dsg_kind == DSG_INIT);
if (df->var_addrgiven) {
/* the programmer specified an address in the declaration of
the variable. Generate code to push the address.
*/
CodeConst(df->var_off, pointer_size);
ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = 0;
return;
}
if (df->var_name) {
/* this variable has been given a name, so it is global.
It is directly accessible.
*/
ds->dsg_name = df->var_name;
ds->dsg_offset = 0;
ds->dsg_kind = DSG_FIXED;
return;
}
if (sc->sc_level == 0) {
/* the variable is global, but declared in a module local
to the implementation or program module.
Such variables can be accessed through an offset from
the name of the module.
*/
ds->dsg_name = &(sc->sc_name[1]);
ds->dsg_offset = df->var_off;
ds->dsg_kind = DSG_FIXED;
return;
}
if (sc->sc_level != proclevel) {
/* the variable is local to a statically enclosing procedure.
*/
assert(proclevel > sc->sc_level);
if (df->df_flags & (D_VARPAR|D_VALPAR)) {
/* value or var parameter
*/
C_lxa((arith) (proclevel - sc->sc_level));
if (df->df_flags & D_VARPAR) {
/* var parameter
*/
C_adp(df->var_off);
C_loi(pointer_size);
ds->dsg_offset = 0;
ds->dsg_kind = DSG_PLOADED;
return;
}
}
else C_lxl((arith) (proclevel - sc->sc_level));
ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = df->var_off;
return;
}
/* Now, finally, we have a local variable or a local parameter
*/
if (df->df_flags & D_VARPAR) {
/* a var parameter; address directly accessible.
*/
ds->dsg_kind = DSG_PFIXED;
}
else ds->dsg_kind = DSG_FIXED;
ds->dsg_offset =df->var_off;
}
CodeDesig(nd, ds)
register struct node *nd;
register struct desig *ds;
{
/* Generate code for a designator. Use divide and conquer
principle
*/
switch(nd->nd_class) { /* Divide */
case Def: {
register struct def *df = nd->nd_def;
switch(df->df_kind) {
case D_FIELD:
CodeFieldDesig(df, ds);
break;
case D_VARIABLE:
CodeVarDesig(df, ds);
break;
default:
crash("(CodeDesig) Def");
}
}
break;
case Link:
assert(nd->nd_symb == '.');
assert(nd->nd_right->nd_class == Def);
CodeDesig(nd->nd_left, ds);
CodeFieldDesig(nd->nd_right->nd_def, ds);
break;
case Oper:
assert(nd->nd_symb == '[');
CodeDesig(nd->nd_left, ds);
CodeAddress(ds);
*ds = InitDesig;
CodeExpr(nd->nd_right, ds, NO_LABEL, NO_LABEL);
CodeValue(ds, nd->nd_right->nd_type->tp_size);
CodeCoercion(nd->nd_right->nd_type, int_type);
if (IsConformantArray(nd->nd_left->nd_type)) {
/* ??? */
}
else {
/* load address of descriptor
*/
/* ??? */
}
break;
case Uoper:
assert(nd->nd_symb == '^');
CodeDesig(nd->nd_right, ds);
switch(ds->dsg_kind) {
case DSG_LOADED:
ds->dsg_kind = DSG_PLOADED;
break;
case DSG_INDEXED:
case DSG_PLOADED:
case DSG_PFIXED:
CodeValue(ds, pointer_size);
ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = 0;
break;
case DSG_FIXED:
ds->dsg_kind = DSG_PFIXED;
break;
default:
crash("(CodeDesig) Uoper");
}
break;
default:
crash("(CodeDesig) class");
}
}

6
lang/m2/comp/desig.h
View file

@ -44,10 +44,12 @@ struct withdesig {
struct scope *w_scope; /* scope in which fields of this record
reside
*/
struct desig *w_desig; /* a desig structure for this particular
struct desig w_desig; /* a desig structure for this particular
designator
*/
};
extern struct withdesig *WithDesigs;
extern struct desig Desig;
extern struct desig Desig, InitDesig;
#define NO_LABEL ((label) 0)

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

@ -64,13 +64,34 @@ EnterIdList(idlist, kind, flags, type, scope, addr)
df->df_type = type;
df->df_flags |= flags;
if (addr) {
int xalign = type->tp_align;
if (xalign < word_align && kind != D_FIELD) {
xalign = word_align;
}
if (*addr >= 0) {
off = align(*addr, type->tp_align);
*addr = off + type->tp_size;
if (scope->sc_level) {
/* alignment of parameters is on
word boundaries. We cannot do any
better, because we don't know the
alignment of the stack pointer when
starting to push parameters
*/
off = *addr;
*addr = align(off, word_align);
}
else {
/* for global variables we can honour
the alignment requirements totally.
*/
off = align(*addr, xalign);
*addr = off + type->tp_size;
}
}
else {
off = -align(-*addr, type->tp_align);
*addr = off - type->tp_size;
off = -align(-*addr-type->tp_size, xalign);
*addr = off;
}
if (kind == D_VARIABLE) {
df->var_off = off;

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

@ -111,6 +111,20 @@ fatal(fmt, args)
sys_stop(S_EXIT);
}
/*VARARGS1*/
crash(fmt, args)
char *fmt;
int args;
{
_error(CRASH, NULLNODE, fmt, &args);
#ifdef DEBUG
sys_stop(S_ABORT);
#else
sys_stop(S_EXIT);
#endif
}
_error(class, node, fmt, argv)
int class;
struct node *node;

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

@ -45,7 +45,9 @@ struct record {
struct proc {
struct paramlist *pr_params;
arith pr_nbpar;
#define prc_params tp_value.tp_proc.pr_params
#define prc_nbpar tp_value.tp_proc.pr_nbpar
};
struct type {

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

@ -149,6 +149,20 @@ init_types()
*/
register struct type *tp;
/* first, do some checking
*/
if (int_size != word_size) {
fatal("Integer size not equal to word size");
}
if (long_size < int_size) {
fatal("Long integer size smaller than integer size");
}
if (double_size < float_size) {
fatal("Long real size smaller than real size");
}
/* character type
*/
char_type = standard_type(T_CHAR, 1, (arith) 1);

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

@ -217,8 +217,11 @@ WalkStat(nd, lab)
assert(nd->nd_class == Stat);
switch(nd->nd_symb) {
case BECOMES:
WalkExpr(right);
case BECOMES: {
struct desig ds;
WalkExpr(right, NO_LABEL, NO_LABEL);
ds = Desig;
WalkDesignator(left); /* May we do it in this order??? */
if (! TstAssCompat(left->nd_type, right->nd_type)) {
@ -226,18 +229,19 @@ WalkStat(nd, lab)
break;
}
CodeAssign(nd);
CodeAssign(nd, &ds, &Desig);
}
break;
case IF:
{ label l1, l2;
{ label l1, l2, l3;
l1 = instructionlabel++;
l2 = instructionlabel++;
ExpectBool(left);
l3 = instructionlabel++;
ExpectBool(left, l3, l1);
assert(right->nd_symb == THEN);
C_zeq(l1);
C_df_ilb(l3);
WalkNode(right->nd_left, lab);
if (right->nd_right) { /* ELSE part */
@ -255,13 +259,14 @@ WalkStat(nd, lab)
break;
case WHILE:
{ label l1, l2;
{ label l1, l2, l3;
l1 = instructionlabel++;
l2 = instructionlabel++;
l3 = instructionlabel++;
C_df_ilb(l1);
ExpectBool(left);
C_zeq(l2);
ExpectBool(left, l3, l2);
C_df_ilb(l3);
WalkNode(right, lab);
C_bra(l1);
C_df_ilb(l2);
@ -269,13 +274,14 @@ WalkStat(nd, lab)
}
case REPEAT:
{ label l1;
{ label l1, l2;
l1 = instructionlabel++;
l2 = instructionlabel++;
C_df_ilb(l1);
WalkNode(left, lab);
ExpectBool(right);
C_zeq(l1);
ExpectBool(right, l2, l1);
C_df_ilb(l2);
break;
}
@ -314,10 +320,9 @@ WalkStat(nd, lab)
Decide here wether to use a temporary variable or
not, depending on the value of Desig.
Suggestion: temporary if Desig != DSG_FIXED
And then:
wds.w_desig = Desig; ???
???
*/
wds.w_desig = Desig;
link.sc_scope = wds.w_scope;
link.next = CurrVis;
CurrVis = &link;
@ -335,7 +340,7 @@ WalkStat(nd, lab)
case RETURN:
if (right) {
WalkExpr(right);
WalkExpr(right, NO_LABEL, NO_LABEL);
/* What kind of compatibility do we need here ???
assignment compatibility?
*/
@ -352,22 +357,24 @@ node_error(right, "type incompatibility in RETURN statement");
}
}
ExpectBool(nd)
ExpectBool(nd, true_label, false_label)
struct node *nd;
label true_label, false_label;
{
/* "nd" must indicate a boolean expression. Check this and
generate code to evaluate the expression.
*/
WalkExpr(nd);
WalkExpr(nd, true_label, false_label);
if (nd->nd_type != bool_type && nd->nd_type != error_type) {
node_error(nd, "boolean expression expected");
}
}
WalkExpr(nd)
WalkExpr(nd, true_label, false_label)
struct node *nd;
label true_label, false_label;
{
/* Check an expression and generate code for it
*/
@ -376,7 +383,8 @@ WalkExpr(nd)
if (! chk_expr(nd)) return;
/* ??? */
Desig = InitDesig;
CodeExpr(nd, &Desig, true_label, false_label);
}
WalkDesignator(nd)
@ -389,25 +397,8 @@ WalkDesignator(nd)
if (! chk_designator(nd, DESIGNATOR|VARIABLE)) return;
/* ??? */
}
CodeCall(nd)
struct node *nd;
{
/* Generate code for a procedure call. Checking of parameters
and result is already done.
*/
/* ??? */
}
CodeAssign(nd)
struct node *nd;
{
/* Generate code for an assignment. Testing of type
compatibility and the like is already done.
*/
/* ??? */
Desig = InitDesig;
CodeDesig(nd, &Desig);
}
#ifdef DEBUG