884 lines
18 KiB
C
884 lines
18 KiB
C
/*
|
|
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
|
|
* See the copyright notice in the ACK home directory, in the file "Copyright".
|
|
*
|
|
* Author: Ceriel J.H. Jacobs
|
|
*/
|
|
|
|
/* P A R S E T R E E W A L K E R */
|
|
|
|
/* $Header$ */
|
|
|
|
/* Routines to walk through parts of the parse tree, and generate
|
|
code for these parts.
|
|
*/
|
|
|
|
#include "debug.h"
|
|
|
|
#include <em_arith.h>
|
|
#include <em_label.h>
|
|
#include <em_reg.h>
|
|
#include <em_code.h>
|
|
#include <m2_traps.h>
|
|
#include <assert.h>
|
|
#include <alloc.h>
|
|
|
|
#include "strict3rd.h"
|
|
#include "squeeze.h"
|
|
#include "LLlex.h"
|
|
#include "def.h"
|
|
#include "type.h"
|
|
#include "scope.h"
|
|
#include "main.h"
|
|
#include "node.h"
|
|
#include "Lpars.h"
|
|
#include "desig.h"
|
|
#include "f_info.h"
|
|
#include "idf.h"
|
|
#include "chk_expr.h"
|
|
#include "walk.h"
|
|
#include "warning.h"
|
|
|
|
extern arith NewPtr();
|
|
extern arith NewInt();
|
|
|
|
extern int proclevel;
|
|
|
|
label text_label;
|
|
label data_label = 1;
|
|
struct withdesig *WithDesigs;
|
|
t_node *Modules;
|
|
|
|
static t_type *func_type;
|
|
static arith priority;
|
|
|
|
static int RegisterMessage();
|
|
static int WalkDef();
|
|
static int MkCalls();
|
|
static int UseWarnings();
|
|
|
|
#define NO_EXIT_LABEL ((label) 0)
|
|
#define RETURN_LABEL ((label) 1)
|
|
|
|
LblWalkNode(lbl, nd, exit)
|
|
label lbl, exit;
|
|
register t_node *nd;
|
|
{
|
|
/* Generate code for node "nd", after generating instruction
|
|
label "lbl". "exit" is the exit label for the closest
|
|
enclosing LOOP.
|
|
*/
|
|
|
|
C_df_ilb(lbl);
|
|
WalkNode(nd, exit);
|
|
}
|
|
|
|
STATIC
|
|
DoPriority()
|
|
{
|
|
/* For the time being (???), handle priorities by calls to
|
|
the runtime system
|
|
*/
|
|
|
|
if (priority) {
|
|
C_loc(priority);
|
|
C_cal("_stackprio");
|
|
C_asp(word_size);
|
|
}
|
|
}
|
|
|
|
STATIC
|
|
EndPriority()
|
|
{
|
|
if (priority) {
|
|
C_cal("_unstackprio");
|
|
}
|
|
}
|
|
|
|
STATIC
|
|
DoProfil()
|
|
{
|
|
static label filename_label = 0;
|
|
|
|
if (! options['L']) {
|
|
|
|
if (! filename_label) {
|
|
filename_label = 1;
|
|
C_df_dlb((label) 1);
|
|
C_rom_scon(FileName, (arith) (strlen(FileName) + 1));
|
|
}
|
|
|
|
C_fil_dlb((label) 1, (arith) 0);
|
|
}
|
|
}
|
|
|
|
WalkModule(module)
|
|
register t_def *module;
|
|
{
|
|
/* Walk through a module, and all its local definitions.
|
|
Also generate code for its body.
|
|
This code is collected in an initialization routine.
|
|
*/
|
|
register t_scope *sc;
|
|
t_scopelist *savevis = CurrVis;
|
|
|
|
CurrVis = module->mod_vis;
|
|
priority = module->mod_priority ? module->mod_priority->nd_INT : 0;
|
|
sc = CurrentScope;
|
|
|
|
/* Walk through it's local definitions
|
|
*/
|
|
WalkDefList(sc->sc_def, WalkDef);
|
|
|
|
/* Now, generate initialization code for this module.
|
|
First call initialization routines for modules defined within
|
|
this module.
|
|
*/
|
|
sc->sc_off = 0; /* no locals (yet) */
|
|
text_label = 1; /* label at end of initialization routine */
|
|
TmpOpen(sc); /* Initialize for temporaries */
|
|
C_pro_narg(sc->sc_name);
|
|
DoPriority();
|
|
DoProfil();
|
|
if (module == Defined) {
|
|
/* Body of implementation or program module.
|
|
Call initialization routines of imported modules.
|
|
Also prevent recursive calls of this one.
|
|
*/
|
|
register t_node *nd = Modules;
|
|
|
|
if (state == IMPLEMENTATION) {
|
|
/* We don't actually prevent recursive calls,
|
|
but do nothing if called recursively
|
|
*/
|
|
C_df_dlb(++data_label);
|
|
C_con_cst((arith) 0);
|
|
/* if this one is set to non-zero, the initialization
|
|
was already done.
|
|
*/
|
|
C_loe_dlb(data_label, (arith) 0);
|
|
C_zne(RETURN_LABEL);
|
|
C_ine_dlb(data_label, (arith) 0);
|
|
}
|
|
|
|
for (; nd; nd = nd->nd_left) {
|
|
C_cal(nd->nd_IDF->id_text);
|
|
}
|
|
}
|
|
WalkDefList(sc->sc_def, MkCalls);
|
|
proclevel++;
|
|
WalkNode(module->mod_body, NO_EXIT_LABEL);
|
|
DO_DEBUG(options['X'], PrNode(module->mod_body, 0));
|
|
C_df_ilb(RETURN_LABEL);
|
|
EndPriority();
|
|
C_ret((arith) 0);
|
|
C_end(-sc->sc_off);
|
|
proclevel--;
|
|
TmpClose();
|
|
|
|
CurrVis = savevis;
|
|
WalkDefList(sc->sc_def, UseWarnings);
|
|
}
|
|
|
|
WalkProcedure(procedure)
|
|
register t_def *procedure;
|
|
{
|
|
/* Walk through the definition of a procedure and all its
|
|
local definitions, checking and generating code.
|
|
*/
|
|
t_scopelist *savevis = CurrVis;
|
|
register t_scope *sc = procedure->prc_vis->sc_scope;
|
|
register t_type *tp;
|
|
register t_param *param;
|
|
label func_res_label = 0;
|
|
arith StackAdjustment = 0;
|
|
arith retsav = 0;
|
|
arith func_res_size = 0;
|
|
|
|
proclevel++;
|
|
CurrVis = procedure->prc_vis;
|
|
|
|
/* Generate code for all local modules and procedures
|
|
*/
|
|
WalkDefList(sc->sc_def, WalkDef);
|
|
|
|
/* Generate code for this procedure
|
|
*/
|
|
C_pro_narg(sc->sc_name);
|
|
DoPriority();
|
|
DoProfil();
|
|
TmpOpen(sc);
|
|
|
|
func_type = tp = RemoveEqual(ResultType(procedure->df_type));
|
|
|
|
if (tp) {
|
|
func_res_size = WA(tp->tp_size);
|
|
if (IsConstructed(tp)) {
|
|
/* The result type of this procedure is constructed.
|
|
The actual procedure will return a pointer to a
|
|
global data area in which the function result is
|
|
stored.
|
|
Notice that this does make the code non-reentrant.
|
|
Here, we create the data area for the function
|
|
result.
|
|
*/
|
|
func_res_label = ++data_label;
|
|
C_df_dlb(func_res_label);
|
|
C_bss_cst(func_res_size, (arith) 0, 0);
|
|
}
|
|
}
|
|
|
|
/* Generate calls to initialization routines of modules defined within
|
|
this procedure
|
|
*/
|
|
WalkDefList(sc->sc_def, MkCalls);
|
|
|
|
/* Make sure that arguments of size < word_size are on a
|
|
fixed place.
|
|
Also make copies of conformant arrays when neccessary.
|
|
*/
|
|
for (param = ParamList(procedure->df_type);
|
|
param;
|
|
param = param->par_next) {
|
|
if (! IsVarParam(param)) {
|
|
tp = TypeOfParam(param);
|
|
|
|
if (! IsConformantArray(tp)) {
|
|
if (tp->tp_size < word_size &&
|
|
(int) word_size % (int) tp->tp_size == 0) {
|
|
C_lol(param->par_def->var_off);
|
|
C_lal(param->par_def->var_off);
|
|
C_sti(tp->tp_size);
|
|
}
|
|
}
|
|
else {
|
|
/* Here, we have to make a copy of the
|
|
array. We must also remember how much
|
|
room is reserved for copies, because
|
|
we have to adjust the stack pointer before
|
|
a RET is done. This is even more complicated
|
|
when the procedure returns a value.
|
|
Then, the value must be saved (in retval),
|
|
the stack adjusted, the return value pushed
|
|
again, and then RET
|
|
*/
|
|
if (! StackAdjustment) {
|
|
/* First time we get here
|
|
*/
|
|
if (func_type && !func_res_label) {
|
|
/* Some local space, only
|
|
needed if the value itself
|
|
is returned
|
|
*/
|
|
sc->sc_off -= func_res_size;
|
|
retsav = sc->sc_off;
|
|
}
|
|
StackAdjustment = NewPtr();
|
|
C_lor((arith) 1);
|
|
C_stl(StackAdjustment);
|
|
}
|
|
/* First compute new stackpointer */
|
|
C_lal(param->par_def->var_off);
|
|
C_cal("_new_stackptr");
|
|
C_asp(pointer_size);
|
|
C_lfr(pointer_size);
|
|
C_str((arith) 1);
|
|
/* adjusted stack pointer */
|
|
C_lol(param->par_def->var_off);
|
|
/* push source address */
|
|
C_cal("_copy_array");
|
|
/* copy */
|
|
C_asp(word_size);
|
|
}
|
|
}
|
|
}
|
|
|
|
text_label = 1; /* label at end of procedure */
|
|
|
|
WalkNode(procedure->prc_body, NO_EXIT_LABEL);
|
|
DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0));
|
|
if (func_res_size) {
|
|
c_loc(M2_NORESULT);
|
|
C_trp();
|
|
C_asp(-func_res_size);
|
|
}
|
|
C_df_ilb(RETURN_LABEL); /* label at end */
|
|
if (func_res_label) {
|
|
/* Fill the data area reserved for the function result
|
|
with the result
|
|
*/
|
|
c_lae_dlb(func_res_label);
|
|
C_sti(func_res_size);
|
|
if (StackAdjustment) {
|
|
/* Remove copies of conformant arrays
|
|
*/
|
|
C_lol(StackAdjustment);
|
|
C_str((arith) 1);
|
|
}
|
|
c_lae_dlb(func_res_label);
|
|
func_res_size = pointer_size;
|
|
}
|
|
else if (StackAdjustment) {
|
|
/* First save the function result in a safe place.
|
|
Then remove copies of conformant arrays,
|
|
and put function result back on the stack
|
|
*/
|
|
if (func_type) {
|
|
C_lal(retsav);
|
|
C_sti(func_res_size);
|
|
}
|
|
C_lol(StackAdjustment);
|
|
C_str((arith) 1);
|
|
if (func_type) {
|
|
C_lal(retsav);
|
|
C_loi(func_res_size);
|
|
}
|
|
FreePtr(StackAdjustment);
|
|
}
|
|
EndPriority();
|
|
C_ret(func_res_size);
|
|
if (! options['n']) WalkDefList(sc->sc_def, RegisterMessage);
|
|
C_end(-sc->sc_off);
|
|
TmpClose();
|
|
CurrVis = savevis;
|
|
proclevel--;
|
|
WalkDefList(sc->sc_def, UseWarnings);
|
|
}
|
|
|
|
static int
|
|
WalkDef(df)
|
|
register t_def *df;
|
|
{
|
|
/* Walk through a list of definitions
|
|
*/
|
|
|
|
switch(df->df_kind) {
|
|
case D_MODULE:
|
|
WalkModule(df);
|
|
break;
|
|
case D_PROCEDURE:
|
|
WalkProcedure(df);
|
|
break;
|
|
case D_VARIABLE:
|
|
if (!proclevel && !(df->df_flags & D_ADDRGIVEN)) {
|
|
C_df_dnam(df->var_name);
|
|
C_bss_cst(
|
|
WA(df->df_type->tp_size),
|
|
(arith) 0, 0);
|
|
}
|
|
break;
|
|
default:
|
|
/* nothing */
|
|
;
|
|
}
|
|
}
|
|
|
|
static int
|
|
MkCalls(df)
|
|
register t_def *df;
|
|
{
|
|
/* Generate calls to initialization routines of modules
|
|
*/
|
|
|
|
if (df->df_kind == D_MODULE) {
|
|
C_lxl((arith) 0);
|
|
C_cal(df->mod_vis->sc_scope->sc_name);
|
|
C_asp(pointer_size);
|
|
}
|
|
}
|
|
|
|
WalkLink(nd, exit_label)
|
|
register t_node *nd;
|
|
label exit_label;
|
|
{
|
|
/* Walk node "nd", which is a link.
|
|
*/
|
|
|
|
while (nd && nd->nd_class == Link) { /* statement list */
|
|
WalkNode(nd->nd_left, exit_label);
|
|
nd = nd->nd_right;
|
|
}
|
|
|
|
WalkNode(nd, exit_label);
|
|
}
|
|
|
|
STATIC
|
|
ForLoopVarExpr(nd)
|
|
register t_node *nd;
|
|
{
|
|
register t_type *tp = nd->nd_type;
|
|
|
|
CodePExpr(nd);
|
|
CodeCoercion(tp, BaseType(tp));
|
|
}
|
|
|
|
WalkStat(nd, exit_label)
|
|
register t_node *nd;
|
|
label exit_label;
|
|
{
|
|
/* Walk through a statement, generating code for it.
|
|
*/
|
|
register t_node *left = nd->nd_left;
|
|
register t_node *right = nd->nd_right;
|
|
|
|
assert(nd->nd_class == Stat);
|
|
|
|
if (! options['L'] && nd->nd_lineno) C_lin((arith) nd->nd_lineno);
|
|
switch(nd->nd_symb) {
|
|
case '(':
|
|
if (ChkCall(nd)) {
|
|
if (nd->nd_type != 0) {
|
|
node_error(nd, "procedure call expected");
|
|
break;
|
|
}
|
|
CodeCall(nd);
|
|
}
|
|
break;
|
|
|
|
case ';':
|
|
break;
|
|
|
|
case BECOMES:
|
|
DoAssign(left, right);
|
|
break;
|
|
|
|
case IF:
|
|
{ label l1 = ++text_label, l3 = ++text_label;
|
|
|
|
ExpectBool(left, l3, l1);
|
|
assert(right->nd_symb == THEN);
|
|
LblWalkNode(l3, right->nd_left, exit_label);
|
|
|
|
if (right->nd_right) { /* ELSE part */
|
|
label l2 = ++text_label;
|
|
|
|
C_bra(l2);
|
|
LblWalkNode(l1, right->nd_right, exit_label);
|
|
l1 = l2;
|
|
}
|
|
C_df_ilb(l1);
|
|
break;
|
|
}
|
|
|
|
case CASE:
|
|
CaseCode(nd, exit_label);
|
|
break;
|
|
|
|
case WHILE:
|
|
{ label loop = ++text_label,
|
|
exit = ++text_label,
|
|
dummy = ++text_label;
|
|
|
|
C_df_ilb(loop);
|
|
ExpectBool(left, dummy, exit);
|
|
LblWalkNode(dummy, right, exit_label);
|
|
C_bra(loop);
|
|
C_df_ilb(exit);
|
|
break;
|
|
}
|
|
|
|
case REPEAT:
|
|
{ label loop = ++text_label, exit = ++text_label;
|
|
|
|
LblWalkNode(loop, left, exit_label);
|
|
ExpectBool(right, exit, loop);
|
|
C_df_ilb(exit);
|
|
break;
|
|
}
|
|
|
|
case LOOP:
|
|
{ label loop = ++text_label, exit = ++text_label;
|
|
|
|
LblWalkNode(loop, right, exit);
|
|
C_bra(loop);
|
|
C_df_ilb(exit);
|
|
break;
|
|
}
|
|
|
|
case FOR:
|
|
{
|
|
arith tmp = NewInt();
|
|
arith tmp2;
|
|
register t_node *fnd;
|
|
int good_forvar;
|
|
label l1 = ++text_label;
|
|
label l2 = ++text_label;
|
|
int uns = 0;
|
|
arith stepsize;
|
|
t_type *bstp;
|
|
|
|
good_forvar = DoForInit(nd);
|
|
if ((stepsize = left->nd_INT) == 0) {
|
|
node_warning(left,
|
|
W_ORDINARY,
|
|
"zero stepsize in FOR loop");
|
|
}
|
|
fnd = left->nd_right;
|
|
if (good_forvar) {
|
|
bstp = BaseType(nd->nd_type);
|
|
uns = bstp->tp_fund != T_INTEGER;
|
|
C_dup(int_size);
|
|
CodeDStore(nd);
|
|
CodePExpr(fnd);
|
|
C_stl(tmp);
|
|
C_lol(tmp);
|
|
if (uns) C_cmu(int_size);
|
|
else C_cmi(int_size);
|
|
if (left->nd_INT >= 0) {
|
|
C_zgt(l2);
|
|
C_lol(tmp);
|
|
ForLoopVarExpr(nd);
|
|
}
|
|
else {
|
|
stepsize = -stepsize;
|
|
C_zlt(l2);
|
|
ForLoopVarExpr(nd);
|
|
C_lol(tmp);
|
|
}
|
|
C_sbu(int_size);
|
|
if (stepsize) {
|
|
C_loc(stepsize);
|
|
C_dvu(int_size);
|
|
}
|
|
C_stl(tmp);
|
|
nd->nd_def->df_flags |= D_FORLOOP;
|
|
C_df_ilb(l1);
|
|
if (! options['R']) {
|
|
tmp2 = NewInt();
|
|
ForLoopVarExpr(nd);
|
|
C_stl(tmp2);
|
|
}
|
|
}
|
|
WalkNode(right, exit_label);
|
|
nd->nd_def->df_flags &= ~D_FORLOOP;
|
|
if (good_forvar) {
|
|
if (! options['R']) {
|
|
C_lol(tmp2);
|
|
ForLoopVarExpr(nd);
|
|
C_cal("_forloopchk");
|
|
FreeInt(tmp2);
|
|
}
|
|
if (stepsize) {
|
|
C_lol(tmp);
|
|
C_zeq(l2);
|
|
C_lol(tmp);
|
|
c_loc(1);
|
|
C_sbu(int_size);
|
|
C_stl(tmp);
|
|
C_loc(left->nd_INT);
|
|
ForLoopVarExpr(nd);
|
|
C_adu(int_size);
|
|
RangeCheck(nd->nd_type, bstp);
|
|
CodeDStore(nd);
|
|
}
|
|
}
|
|
C_bra(l1);
|
|
C_df_ilb(l2);
|
|
FreeInt(tmp);
|
|
#ifdef DEBUG
|
|
nd->nd_left = left;
|
|
nd->nd_right = right;
|
|
#endif
|
|
}
|
|
break;
|
|
|
|
case WITH:
|
|
{
|
|
t_scopelist link;
|
|
struct withdesig wds;
|
|
t_desig ds;
|
|
|
|
if (! WalkDesignator(left, &ds, D_USED|D_DEFINED)) break;
|
|
if (left->nd_type->tp_fund != T_RECORD) {
|
|
node_error(left, "record variable expected");
|
|
break;
|
|
}
|
|
|
|
wds.w_next = WithDesigs;
|
|
WithDesigs = &wds;
|
|
wds.w_scope = left->nd_type->rec_scope;
|
|
CodeAddress(&ds);
|
|
ds.dsg_kind = DSG_FIXED;
|
|
/* Create a designator structure for the temporary.
|
|
*/
|
|
ds.dsg_offset = NewPtr();
|
|
ds.dsg_name = 0;
|
|
CodeStore(&ds, address_type);
|
|
ds.dsg_kind = DSG_PFIXED;
|
|
/* the record is indirectly available */
|
|
wds.w_desig = ds;
|
|
link.sc_scope = wds.w_scope;
|
|
link.sc_next = CurrVis;
|
|
CurrVis = &link;
|
|
WalkNode(right, exit_label);
|
|
CurrVis = link.sc_next;
|
|
WithDesigs = wds.w_next;
|
|
FreePtr(ds.dsg_offset);
|
|
break;
|
|
}
|
|
|
|
case EXIT:
|
|
assert(exit_label != 0);
|
|
|
|
C_bra(exit_label);
|
|
break;
|
|
|
|
case RETURN:
|
|
if (right) {
|
|
if (! ChkExpression(right)) break;
|
|
/* The type of the return-expression must be
|
|
assignment compatible with the result type of the
|
|
function procedure (See Rep. 9.11).
|
|
*/
|
|
if (!ChkAssCompat(&(nd->nd_right), func_type, "RETURN")) {
|
|
break;
|
|
}
|
|
right = nd->nd_right;
|
|
if (right->nd_type->tp_fund == T_STRING) {
|
|
CodePString(right, func_type);
|
|
}
|
|
else CodePExpr(right);
|
|
}
|
|
C_bra(RETURN_LABEL);
|
|
break;
|
|
|
|
default:
|
|
crash("(WalkStat)");
|
|
}
|
|
}
|
|
|
|
extern int NodeCrash();
|
|
|
|
STATIC
|
|
WalkOption(nd)
|
|
t_node *nd;
|
|
{
|
|
/* Set option indicated by node "nd"
|
|
*/
|
|
|
|
options[nd->nd_symb] = nd->nd_INT;
|
|
}
|
|
|
|
int (*WalkTable[])() = {
|
|
NodeCrash,
|
|
NodeCrash,
|
|
NodeCrash,
|
|
NodeCrash,
|
|
NodeCrash,
|
|
NodeCrash,
|
|
NodeCrash,
|
|
NodeCrash,
|
|
NodeCrash,
|
|
NodeCrash,
|
|
WalkStat,
|
|
WalkLink,
|
|
WalkOption
|
|
};
|
|
|
|
ExpectBool(nd, true_label, false_label)
|
|
register t_node *nd;
|
|
label true_label, false_label;
|
|
{
|
|
/* "nd" must indicate a boolean expression. Check this and
|
|
generate code to evaluate the expression.
|
|
*/
|
|
register t_desig *ds = new_desig();
|
|
|
|
if (ChkExpression(nd)) {
|
|
if (nd->nd_type != bool_type && nd->nd_type != error_type) {
|
|
node_error(nd, "boolean expression expected");
|
|
}
|
|
|
|
CodeExpr(nd, ds, true_label, false_label);
|
|
}
|
|
free_desig(ds);
|
|
}
|
|
|
|
int
|
|
WalkDesignator(nd, ds, flags)
|
|
t_node *nd;
|
|
t_desig *ds;
|
|
{
|
|
/* Check designator and generate code for it
|
|
*/
|
|
|
|
if (! ChkVariable(nd, flags)) return 0;
|
|
|
|
clear((char *) ds, sizeof(t_desig));
|
|
CodeDesig(nd, ds);
|
|
return 1;
|
|
}
|
|
|
|
DoForInit(nd)
|
|
register t_node *nd;
|
|
{
|
|
register t_node *left = nd->nd_left;
|
|
register t_def *df;
|
|
t_type *tpl, *tpr;
|
|
|
|
nd->nd_left = nd->nd_right = 0;
|
|
nd->nd_class = Name;
|
|
nd->nd_symb = IDENT;
|
|
|
|
if (!( ChkVariable(nd, D_USED|D_DEFINED) &
|
|
ChkExpression(left->nd_left) &
|
|
ChkExpression(left->nd_right))) return 0;
|
|
|
|
df = nd->nd_def;
|
|
if (df->df_kind == D_FIELD) {
|
|
node_error(nd,
|
|
"FOR-loop variable may not be a field of a record");
|
|
return 1;
|
|
}
|
|
|
|
if (!df->var_name && df->var_off >= 0) {
|
|
node_error(nd, "FOR-loop variable may not be a parameter");
|
|
return 1;
|
|
}
|
|
|
|
if (df->df_scope != CurrentScope) {
|
|
register t_scopelist *sc = CurrVis;
|
|
|
|
for (;;) {
|
|
if (!sc) {
|
|
node_error(nd,
|
|
"FOR-loop variable may not be imported");
|
|
return 1;
|
|
}
|
|
if (sc->sc_scope == df->df_scope) break;
|
|
sc = nextvisible(sc);
|
|
}
|
|
}
|
|
|
|
if (df->df_type->tp_size > word_size ||
|
|
!(df->df_type->tp_fund & T_DISCRETE)) {
|
|
node_error(nd, "illegal type of FOR loop variable");
|
|
return 1;
|
|
}
|
|
|
|
tpl = left->nd_left->nd_type;
|
|
tpr = left->nd_right->nd_type;
|
|
#ifndef STRICT_3RD_ED
|
|
if (! options['3']) {
|
|
if (!ChkAssCompat(&(left->nd_left), df->df_type, "FOR statement") ||
|
|
!ChkAssCompat(&(left->nd_right), BaseType(df->df_type), "FOR statement")) {
|
|
return 1;
|
|
}
|
|
if (!TstCompat(df->df_type, tpl) ||
|
|
!TstCompat(df->df_type, tpr)) {
|
|
node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement");
|
|
node_error(nd, "compatibility required in FOR statement");
|
|
}
|
|
} else
|
|
#endif
|
|
if (!ChkCompat(&(left->nd_left), df->df_type, "FOR statement") ||
|
|
!ChkCompat(&(left->nd_right), BaseType(df->df_type), "FOR statement")) {
|
|
return 1;
|
|
}
|
|
|
|
CodePExpr(left->nd_left);
|
|
return 1;
|
|
}
|
|
|
|
DoAssign(left, right)
|
|
register t_node *left;
|
|
t_node *right;
|
|
{
|
|
/* May we do it in this order (expression first) ???
|
|
The reference manual sais nothing about it, but the book does:
|
|
it sais that the left hand side is evaluated first.
|
|
DAMN THE BOOK!
|
|
*/
|
|
register t_desig *dsr;
|
|
register t_type *tp;
|
|
|
|
if (! (ChkExpression(right) & ChkVariable(left, D_DEFINED))) return;
|
|
tp = left->nd_type;
|
|
|
|
if (right->nd_symb == STRING) TryToString(right, tp);
|
|
|
|
if (! ChkAssCompat(&right, tp, "assignment")) {
|
|
return;
|
|
}
|
|
dsr = new_desig();
|
|
|
|
#define StackNeededFor(ds) ((ds)->dsg_kind == DSG_PLOADED \
|
|
|| (ds)->dsg_kind == DSG_INDEXED)
|
|
CodeExpr(right, dsr, NO_LABEL, NO_LABEL);
|
|
tp = right->nd_type;
|
|
if (complex(tp)) {
|
|
if (StackNeededFor(dsr)) CodeAddress(dsr);
|
|
}
|
|
else {
|
|
CodeValue(dsr, tp);
|
|
}
|
|
CodeMove(dsr, left, tp);
|
|
free_desig(dsr);
|
|
}
|
|
|
|
static int
|
|
RegisterMessage(df)
|
|
register t_def *df;
|
|
{
|
|
register t_type *tp;
|
|
arith sz;
|
|
int regtype;
|
|
|
|
if (df->df_kind == D_VARIABLE) {
|
|
if ( !(df->df_flags & D_NOREG)) {
|
|
/* Examine type and size
|
|
*/
|
|
regtype = -1;
|
|
tp = BaseType(df->df_type);
|
|
if ((df->df_flags & D_VARPAR) ||
|
|
(tp->tp_fund&(T_POINTER|T_HIDDEN|T_EQUAL))) {
|
|
sz = pointer_size;
|
|
regtype = reg_pointer;
|
|
}
|
|
else if (tp->tp_fund & T_NUMERIC) {
|
|
sz = tp->tp_size;
|
|
regtype = tp->tp_fund == T_REAL ?
|
|
reg_float : reg_any;
|
|
}
|
|
if (regtype >= 0) {
|
|
C_ms_reg(df->var_off, sz, regtype, 0);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
static int
|
|
UseWarnings(df)
|
|
register t_def *df;
|
|
{
|
|
if (df->df_kind & (D_IMPORT | D_VARIABLE | D_PROCEDURE)) {
|
|
struct node *nd;
|
|
|
|
if (df->df_flags & (D_EXPORTED | D_QEXPORTED)) return;
|
|
if (df->df_kind == D_IMPORT) df = df->imp_def;
|
|
if (! (df->df_kind & (D_VARIABLE|D_PROCEDURE))) return;
|
|
nd = df->df_scope->sc_end;
|
|
if (! (df->df_flags & D_DEFINED)) {
|
|
node_warning(nd,
|
|
W_ORDINARY,
|
|
"identifier \"%s\" never assigned",
|
|
df->df_idf->id_text);
|
|
}
|
|
if (! (df->df_flags & D_USED)) {
|
|
node_warning(nd,
|
|
W_ORDINARY,
|
|
"identifier \"%s\" never used",
|
|
df->df_idf->id_text);
|
|
}
|
|
}
|
|
}
|
|
|
|
WalkDefList(df, proc)
|
|
register t_def *df;
|
|
int (*proc)();
|
|
{
|
|
for (; df; df = df->df_nextinscope) {
|
|
(*proc)(df);
|
|
}
|
|
}
|