if (! ChkDesignator(expp)) return 0;
- if (expp->nd_class == Def &&
- !(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) {
+ if ((expp->nd_class == Def || expp->nd_class == LinkDef) &&
+ !(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) {
Xerror(expp, "variable expected", expp->nd_def);
return 0;
}
- if (expp->nd_class == Value) {
- node_error(expp, "variable expected");
- return 0;
- }
return 1;
}
if (! ChkDesignator(left)) return 0;
- if (left->nd_class == Def &&
- (left->nd_type->tp_fund != T_RECORD ||
+ if ((left->nd_type->tp_fund != T_RECORD ||
!(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD))
)
) {
}
}
- if (left->nd_class == Def &&
- left->nd_def->df_kind == D_MODULE) {
+ if (left->nd_def->df_kind == D_MODULE) {
expp->nd_class = Def;
FreeNode(left);
expp->nd_left = 0;
assert(expp->nd_class == Def);
+ return df->df_kind != D_ERROR;
+}
+
+STATIC int
+ChkExLinkOrName(expp)
+ register struct node *expp;
+{
+ /* Check either an ID or an ID.ID [.ID]* occurring in an
+ expression.
+ */
+ register struct def *df;
+
+ if (! ChkLinkOrName(expp)) return 0;
+
df = expp->nd_def;
if (df->df_kind & (D_ENUM | D_CONST)) {
expp->nd_lineno = ln;
}
}
- return df->df_kind != D_ERROR;
-}
-
-STATIC int
-ChkExLinkOrName(expp)
- register struct node *expp;
-{
- /* Check either an ID or an ID.ID [.ID]* occurring in an
- expression.
- */
- register struct def *df;
-
- if (! ChkLinkOrName(expp)) return 0;
- if (expp->nd_class != Def) return 1;
- df = expp->nd_def;
if (!(df->df_kind & D_VALUE)) {
Xerror(expp, "value expected", df);
/* A type was given. Check it out
*/
if (! ChkDesignator(nd)) return 0;
- assert(nd->nd_class == Def);
+ assert(nd->nd_class == Def || nd->nd_class == LinkDef);
df = nd->nd_def;
if (!is_type(df) ||
(df->df_type->tp_fund != T_SET)) {
if (df->df_kind != D_ERROR) {
- Xerror(nd, "not a set type", df);
+ Xerror(nd, "not a SET type", df);
}
return 0;
}
return 0;
}
- if (designator && left->nd_class == Def) {
+ if (designator && (left->nd_class==Def || left->nd_class==LinkDef)) {
left->nd_def->df_flags |= D_NOREG;
}
register struct def *edf;
int std;
- assert(left->nd_class == Def);
- std = left->nd_def->df_value.df_stdname;
+ assert(left->nd_class == Def || left->nd_class == LinkDef);
edf = left->nd_def;
+ std = edf->df_value.df_stdname;
switch(std) {
case S_ABS:
Xerror(left, "pointer variable expected", edf);
return 0;
}
- if (left->nd_class == Def) {
- left->nd_def->df_flags |= D_NOREG;
- }
/* Now, make it look like a call to ALLOCATE or DEALLOCATE */
{
struct token dt;
- register struct token *tk = &dt;
struct node *nd;
- tk->TOK_INT = PointedtoType(left->nd_type)->tp_size;
- tk->tk_symb = INTEGER;
- tk->tk_lineno = left->nd_lineno;
- nd = MkLeaf(Value, tk);
+ dt.TOK_INT = PointedtoType(left->nd_type)->tp_size;
+ dt.tk_symb = INTEGER;
+ dt.tk_lineno = left->nd_lineno;
+ nd = MkLeaf(Value, &dt);
nd->nd_type = card_type;
- tk->tk_symb = ',';
- arg->nd_right = MkNode(Link, nd, NULLNODE, tk);
+ dt.tk_symb = ',';
+ arg->nd_right = MkNode(Link, nd, NULLNODE, &dt);
/* Ignore other arguments to NEW and/or DISPOSE ??? */
FreeNode(expp->nd_left);
- tk->tk_symb = IDENT;
- tk->tk_lineno = expp->nd_left->nd_lineno;
- tk->TOK_IDF = str2idf(std == S_NEW ?
+ dt.tk_symb = IDENT;
+ dt.tk_lineno = expp->nd_left->nd_lineno;
+ dt.TOK_IDF = str2idf(std == S_NEW ?
"ALLOCATE" : "DEALLOCATE", 0);
- expp->nd_left = MkLeaf(Name, tk);
+ expp->nd_left = MkLeaf(Name, &dt);
}
return ChkCall(expp);
}
C_asp(left->nd_type->prc_nbpar);
if (result_tp = ResultType(left->nd_type)) {
+ arith sz = WA(result_tp->tp_size);
if (IsConstructed(result_tp)) {
C_lfr(pointer_size);
- C_loi(result_tp->tp_size);
+ C_loi(sz);
}
- else C_lfr(WA(result_tp->tp_size));
+ else C_lfr(sz);
}
}
if (left->nd_symb == STRING) {
CodeString(left);
}
- else if (left->nd_class == Call) {
- /* ouch! forgot about this one! */
+ else if (left->nd_class == Call || left->nd_class == Value) {
+ /* ouch! forgot about these ones! */
arith tmp, TmpSpace();
CodePExpr(left);
{ *ptp = qualified_type(nd); }
;
-ProcedureType(register struct type **ptp;)
-{
- struct paramlist *pr = 0;
- arith parmaddr = 0;
-}
-:
- { *ptp = 0; }
+ProcedureType(struct type **ptp;) :
PROCEDURE
[
- FormalTypeList(&pr, &parmaddr, ptp)
- ]?
- { *ptp = proc_type(*ptp, pr, parmaddr); }
+ FormalTypeList(ptp)
+ |
+ { *ptp = proc_type((struct type *) 0,
+ (struct paramlist *) 0,
+ (arith) 0);
+ }
+ ]
;
-FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;):
+FormalTypeList(struct type **ptp;)
+{
+ struct paramlist *pr = 0;
+ arith parmaddr = 0;
+} :
'('
[
- VarFormalType(ppr, parmaddr)
+ VarFormalType(&pr, &parmaddr)
[
- ',' VarFormalType(ppr, parmaddr)
+ ',' VarFormalType(&pr, &parmaddr)
]*
]?
')'
[ ':' qualtype(ptp)
]?
+ { *ptp = proc_type(*ptp, pr, parmaddr); }
;
VarFormalType(struct paramlist **ppr; arith *parmaddr;)
{ EnterVarList(VarList, tp, proclevel > 0); }
;
-IdentAddr(struct node **pnd;) :
+IdentAddr(register struct node **pnd;) :
IDENT { *pnd = MkLeaf(Name, &dot); }
[ '['
ConstExpression(&((*pnd)->nd_left))
if (lhs->dsg_kind == DSG_FIXED &&
lhs->dsg_offset % word_size ==
rhs->dsg_offset % word_size) {
- register arith sz;
+ register int sz;
arith size = tp->tp_size;
while (size && (sz = (lhs->dsg_offset % word_size))) {
boundaries
*/
if (sz < 0) sz = -sz; /* bloody '%' */
- while (word_size % sz) sz--;
- CodeCopy(lhs, rhs, sz, &size);
+ while ((int) word_size % sz) sz--;
+ CodeCopy(lhs, rhs, (arith) sz, &size);
}
if (size > 3*dword_size) {
/* Do a block move
case 'V' : /* set object sizes and alignment requirements */
{
- register arith size;
+ register int size;
register int align;
char c;
char *t;
{
register struct type *tp = new_type();
- if (align == 0) align = 1;
-
tp->tp_fund = fund;
tp->tp_align = align;
tp->tp_size = size;
#include <em_label.h>
#include <em_reg.h>
#include <em_code.h>
+#include <m2_traps.h>
#include <assert.h>
#include "def.h"
func_type = tp = RemoveEqual(ResultType(procedure->df_type));
- if (tp && 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(tp->tp_size, (arith) 0, 0);
+ 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);
+ }
}
- if (tp) func_res_size = WA(tp->tp_size);
-
/* Generate calls to initialization routines of modules defined within
this procedure
*/
param;
param = param->next) {
if (! IsVarParam(param)) {
- tp = TypeOfParam(param);
+ register struct type *TpParam = TypeOfParam(param);
- if (! IsConformantArray(tp)) {
- if (tp->tp_size < word_size) {
+ if (! IsConformantArray(TpParam)) {
+ if (TpParam->tp_size < word_size &&
+ (int) word_size % (int) TpParam->tp_size == 0) {
C_lol(param->par_def->var_off);
C_lal(param->par_def->var_off);
- C_sti(tp->tp_size);
+ C_sti(TpParam->tp_size);
}
}
else {
WalkNode(procedure->prc_body, NO_EXIT_LABEL);
DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0));
+ if (func_res_size) {
+ C_loc((arith) M2_NORESULT);
+ C_trp();
+ C_asp(-func_res_size);
+ }
C_df_ilb(RETURN_LABEL); /* label at end */
- tp = func_type;
if (func_res_label) {
/* Fill the data area reserved for the function result
with the result
*/
C_lae_dlb(func_res_label, (arith) 0);
- C_sti(tp->tp_size);
+ C_sti(func_res_size);
if (StackAdjustment) {
/* Remove copies of conformant arrays
*/
public / ack.git / commitdiff