*/
-!File: bigparam.h
-#undef PASS_BIG_VAL_AS_VAR 1 /* define when big value parameters must be
- passed as addresses
- */
-
-
!File: bigresult.h
#define BIG_RESULT_ON_STACK 1 /* define when function results must be
put on the stack; in this case, caller
#define USE_INSERT 1 /* use C_insertpart mechanism */
+!File: uns_arith.h
+#define UNSIGNED_ARITH unsigned arith
+
+
OBJ = $(COBJ) $(LOBJ) Lpars.o $(EXTRA_O)
GENH = errout.h \
- idfsize.h numsize.h strsize.h target_sizes.h bigparam.h bigresult.h \
+ idfsize.h numsize.h strsize.h target_sizes.h bigresult.h \
inputtype.h density.h squeeze.h nocross.h nostrict.h \
def.h debugcst.h type.h Lpars.h node.h desig.h strict3rd.h real.h \
- use_insert.h dbsymtab.h
+ use_insert.h dbsymtab.h uns_arith.h
HFILES =LLlex.h \
chk_expr.h class.h debug.h f_info.h idf.h \
input.h main.h misc.h scope.h standards.h tokenname.h \
#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
LLlex.o: LLlex.h
LLlex.o: Lpars.h
-LLlex.o: bigparam.h
LLlex.o: class.h
LLlex.o: dbsymtab.h
LLlex.o: debug.h
main.o: LLlex.h
main.o: Lpars.h
main.o: SYSTEM.h
-main.o: bigparam.h
main.o: dbsymtab.h
main.o: debug.h
main.o: debugcst.h
input.o: input.h
input.o: inputtype.h
type.o: LLlex.h
-type.o: bigparam.h
type.o: chk_expr.h
type.o: dbsymtab.h
type.o: debug.h
type.o: warning.h
def.o: LLlex.h
def.o: Lpars.h
-def.o: bigparam.h
def.o: dbsymtab.h
def.o: debug.h
def.o: debugcst.h
misc.o: node.h
misc.o: real.h
enter.o: LLlex.h
-enter.o: bigparam.h
enter.o: dbsymtab.h
enter.o: debug.h
enter.o: debugcst.h
enter.o: type.h
defmodule.o: LLlex.h
defmodule.o: Lpars.h
-defmodule.o: bigparam.h
defmodule.o: dbsymtab.h
defmodule.o: debug.h
defmodule.o: debugcst.h
defmodule.o: target_sizes.h
defmodule.o: type.h
typequiv.o: LLlex.h
-typequiv.o: bigparam.h
typequiv.o: dbsymtab.h
typequiv.o: debug.h
typequiv.o: debugcst.h
typequiv.o: type.h
typequiv.o: warning.h
node.o: LLlex.h
-node.o: bigparam.h
node.o: dbsymtab.h
node.o: debug.h
node.o: debugcst.h
node.o: type.h
cstoper.o: LLlex.h
cstoper.o: Lpars.h
-cstoper.o: bigparam.h
cstoper.o: dbsymtab.h
cstoper.o: debug.h
cstoper.o: debugcst.h
cstoper.o: standards.h
cstoper.o: target_sizes.h
cstoper.o: type.h
+cstoper.o: uns_arith.h
cstoper.o: warning.h
chk_expr.o: LLlex.h
chk_expr.o: Lpars.h
-chk_expr.o: bigparam.h
chk_expr.o: chk_expr.h
chk_expr.o: dbsymtab.h
chk_expr.o: debug.h
chk_expr.o: target_sizes.h
chk_expr.o: type.h
chk_expr.o: warning.h
-options.o: bigparam.h
options.o: class.h
options.o: dbsymtab.h
options.o: idfsize.h
options.o: warning.h
walk.o: LLlex.h
walk.o: Lpars.h
-walk.o: bigparam.h
walk.o: bigresult.h
walk.o: chk_expr.h
walk.o: dbsymtab.h
walk.o: walk.h
walk.o: warning.h
desig.o: LLlex.h
-desig.o: bigparam.h
desig.o: dbsymtab.h
desig.o: debug.h
desig.o: debugcst.h
desig.o: warning.h
code.o: LLlex.h
code.o: Lpars.h
-code.o: bigparam.h
code.o: bigresult.h
code.o: dbsymtab.h
code.o: debug.h
code.o: type.h
code.o: walk.h
lookup.o: LLlex.h
-lookup.o: bigparam.h
lookup.o: dbsymtab.h
lookup.o: debug.h
lookup.o: debugcst.h
lookup.o: target_sizes.h
lookup.o: type.h
stab.o: LLlex.h
-stab.o: bigparam.h
stab.o: dbsymtab.h
stab.o: def.h
stab.o: idf.h
tokenfile.o: Lpars.h
program.o: LLlex.h
program.o: Lpars.h
-program.o: bigparam.h
program.o: dbsymtab.h
program.o: debug.h
program.o: debugcst.h
program.o: warning.h
declar.o: LLlex.h
declar.o: Lpars.h
-declar.o: bigparam.h
declar.o: chk_expr.h
declar.o: dbsymtab.h
declar.o: debug.h
declar.o: warning.h
expression.o: LLlex.h
expression.o: Lpars.h
-expression.o: bigparam.h
expression.o: chk_expr.h
expression.o: dbsymtab.h
expression.o: debug.h
expression.o: warning.h
statement.o: LLlex.h
statement.o: Lpars.h
-statement.o: bigparam.h
statement.o: dbsymtab.h
statement.o: def.h
statement.o: idf.h
Lpars.o: Lpars.h
casestat.o: LLlex.h
casestat.o: Lpars.h
-casestat.o: bigparam.h
casestat.o: chk_expr.h
casestat.o: dbsymtab.h
casestat.o: debug.h
casestat.o: type.h
casestat.o: walk.h
tmpvar.o: LLlex.h
-tmpvar.o: bigparam.h
tmpvar.o: dbsymtab.h
tmpvar.o: debug.h
tmpvar.o: debugcst.h
tmpvar.o: target_sizes.h
tmpvar.o: type.h
scope.o: LLlex.h
-scope.o: bigparam.h
scope.o: dbsymtab.h
scope.o: debug.h
scope.o: debugcst.h
*/
-!File: bigparam.h
-#undef PASS_BIG_VAL_AS_VAR 1 /* define when big value parameters must be
- passed as addresses
- */
-
-
!File: bigresult.h
#define BIG_RESULT_ON_STACK 1 /* define when function results must be
put on the stack; in this case, caller
#undef USE_INSERT 1 /* use C_insertpart mechanism */
+!File: uns_arith.h
+#define UNSIGNED_ARITH unsigned arith
+
+
case S_ORD:
if (! (left = getarg(&arg, T_NOSUB, 0, edf))) return 0;
exp->nd_type = card_type;
- if (arg->nd_LEFT->nd_class == Value) {
- arg->nd_LEFT->nd_type = card_type;
+ if (left->nd_class == Value) {
+ left->nd_type = card_type;
free_it = 1;
}
break;
#endif
#ifndef STRICT_3RD_ED
if (! options['3'] && edf->df_value.df_stdname == S_TSIZE) {
- if (arg->nd_RIGHT) {
- node_warning(arg->nd_RIGHT,
+ if (left = arg->nd_RIGHT) {
+ node_warning(left,
W_OLDFASHIONED,
"TSIZE with multiple parameters, only first parameter used");
- FreeNode(arg->nd_RIGHT);
+ FreeNode(left);
arg->nd_RIGHT = 0;
}
}
}
c_loc(0);
}
- if (IsConformantArray(tp) || IsVarParam(param) || IsBigParamTp(tp)) {
+ if (IsConformantArray(tp) || IsVarParam(param)) {
if (arg->nd_symb == STRING) {
CodeString(arg);
}
#include "debug.h"
#include "target_sizes.h"
+#include "uns_arith.h"
#include <em_arith.h>
#include <em_label.h>
STATIC
commonbin(expp)
- register t_node **expp;
+ t_node **expp;
{
- register t_type *tp = (*expp)->nd_type;
- register t_node *right = (*expp)->nd_RIGHT;
+ register t_node *exp = *expp;
+ t_type *tp = exp->nd_type;
+ register t_node *right = exp->nd_RIGHT;
- (*expp)->nd_RIGHT = 0;
- FreeNode(*expp);
+ exp->nd_RIGHT = 0;
+ FreeNode(exp);
*expp = right;
right->nd_type = tp;
}
*/
case '-':
- if (o1 == min_int[(int)(right->nd_type->tp_size)]) {
+ if (! options['s'] &&
+ o1 == min_int[(int)(right->nd_type->tp_size)]) {
overflow(exp);
}
o1 = -o1;
register arith o1 = *pdiv;
register arith o2 = *prem;
+#ifndef UNSIGNED_ARITH
/* this is more of a problem than you might
think on C compilers which do not have
unsigned long.
*prem -= o2;
}
}
+#else
+ *pdiv = (UNSIGNED_ARITH) o1 / (UNSIGNED_ARITH) o2;
+ *prem = (UNSIGNED_ARITH) o1 % (UNSIGNED_ARITH) o2;
+#endif
}
cstibin(expp)
break;
case DIV:
- if (o2 == 0) {
- node_error(exp, "division by 0");
- return;
- }
- if ((o1 < 0) != (o2 < 0)) {
- if (o1 < 0) o1 = -o1;
- else o2 = -o2;
- o1 = -((o1+o2-1)/o2);
- }
- else {
- o1 /= o2;
- }
- break;
case MOD:
if (o2 == 0) {
- node_error(exp, "modulo by 0");
+ node_error(exp, exp->nd_symb == DIV ?
+ "division by 0" :
+ "modulo by 0");
return;
}
if ((o1 < 0) != (o2 < 0)) {
if (o1 < 0) o1 = -o1;
else o2 = -o2;
- o1 = ((o1+o2-1)/o2) * o2 - o1;
+ if (exp->nd_symb == DIV) o1 = -((o1+o2-1)/o2);
+ else o1 = ((o1+o2-1)/o2) * o2 - o1;
}
else {
- o1 %= o2;
+ if (exp->nd_symb == DIV) o1 /= o2;
+ else o1 %= o2;
}
break;
assert(exp->nd_LEFT->nd_class == Value);
exp->nd_LEFT->nd_INT -= exp->nd_RIGHT->nd_type->set_low;
- i = exp->nd_LEFT->nd_INT;
+ exp = exp->nd_LEFT;
+ i = exp->nd_INT;
/* Careful here; use exp->nd_LEFT->nd_INT to see if
it falls in the range of the set. Do not use i
for this, as i may be truncated.
*/
- i = (exp->nd_LEFT->nd_INT >= 0 &&
- exp->nd_LEFT->nd_INT < setsize * wrd_bits &&
+ i = (exp->nd_INT >= 0 &&
+ exp->nd_INT < setsize * wrd_bits &&
(set2[i / wrd_bits] & (1 << (i % wrd_bits))));
FreeSet(set2);
exp = getnode(Value);
switch(call) {
case S_ABS:
if (expr->nd_INT < 0) {
- if (expr->nd_INT <= min_int[(int)(tp->tp_size)]) {
+ if (! options['s'] &&
+ expr->nd_INT <= min_int[(int)(tp->tp_size)]) {
overflow(expr);
}
expr->nd_INT = - expr->nd_INT;
*/
C_lxa((arith) difflevel);
if ((df->df_flags & D_VARPAR) ||
- IsBigParamTp(df->df_type) ||
IsConformantArray(df->df_type)) {
/* var parameter, big parameter,
or conformant array.
/* Now, finally, we have a local variable or a local parameter
*/
if ((df->df_flags & D_VARPAR) ||
- ((df->df_flags & D_VALPAR) && IsBigParamTp(df->df_type)) ||
IsConformantArray(df->df_type)) {
/* a var parameter; address directly accessible.
*/
type->arr_high = *off + pointer_size + word_size;
*off += pointer_size + word_size + dword_size;
}
- else if (VARp == D_VARPAR || IsBigParamTp(type)) {
+ else if (VARp == D_VARPAR) {
*off += pointer_size;
}
else {
return MkLeaf(class, &dot);
}
-FreeLR(nd)
+FreeNode(nd)
register t_node *nd;
{
+ /* Put nodes that are no longer needed back onto the free
+ list
+ */
+ if (!nd) return;
switch(nsubnodes[nd->nd_class]) {
case 2:
FreeNode(nd->nd_LEFT);
FreeNode(nd->nd_RIGHT);
- nd->nd_LEFT = nd->nd_RIGHT = 0;
break;
case 1:
FreeNode(nd->nd_NEXT);
- nd->nd_NEXT = 0;
break;
}
-}
-
-FreeNode(nd)
- register t_node *nd;
-{
- /* Put nodes that are no longer needed back onto the free
- list
- */
- if (!nd) return;
- FreeLR(nd);
free_node(nd);
}
}
else df = GetDefinitionModule(dot.TOK_IDF, 1);
}
- IMPORT IdentList(&ImportList) ';'
- { EnterFromImportList(ImportList, df, FromId); }
- |
- IMPORT IdentList(&ImportList) ';'
- { EnterImportList(ImportList,
- local,
- enclosing(CurrVis)->sc_scope);
- }
- ]
- {
+ ]?
+ IMPORT IdentList(&ImportList) ';'
+ { if (FromId) {
+ EnterFromImportList(ImportList, df, FromId);
+ }
+ else {
+ EnterImportList(ImportList,
+ local,
+ enclosing(CurrVis)->sc_scope);
+ }
FreeNode(ImportList);
}
;
|
ForStatement(pnd)
|
- WithStatement(pnd)
+ WITH { *pnd = nd = dot2leaf(Stat); }
+ designator(&(nd->nd_LEFT))
+ DO
+ StatementSequence(&(nd->nd_RIGHT))
+ END
|
EXIT
{ if (!loopcount) error("EXIT not in a LOOP");
StatementSequence(&((*pnd)->nd_RIGHT))
END
;
-*/
WithStatement(t_node **pnd;)
{
StatementSequence(&(nd->nd_RIGHT))
END
;
+*/
ReturnStatement(t_node **pnd;)
{
#define IsConstructed(tpx) ((tpx)->tp_fund & T_CONSTRUCTED)
#define TooBigForReturnArea(tpx) ((tpx)->tp_size > ret_area_size)
-#include "bigparam.h"
-#ifdef PASS_BIG_VAL_AS_VAR
-#define IsBigParamTp(tpx) ((tpx)->tp_size > double_size)
-#else
-#define IsBigParamTp(tpx) (0)
-#endif PASS_BIG_VAL_AS_VAR
-
extern arith full_mask[];
extern arith max_int[];
extern arith min_int[];
{
/* Generate line number information, if necessary.
*/
- if ((! options['L'] || options['g']) &&
+ if ((! options['L']
+#ifdef DBSYMTAB
+ || options['g']
+#endif /* DBSYMTAB */
+ ) &&
nd->nd_lineno &&
nd->nd_lineno != oldlineno) {
oldlineno = nd->nd_lineno;
local definitions, checking and generating code.
*/
t_scopelist *savevis = CurrVis;
- register t_scope *procscope = procedure->prc_vis->sc_scope;
register t_type *tp;
register t_param *param;
+ register t_scope *procscope = procedure->prc_vis->sc_scope;
label too_big = 0; /* returnsize larger than returnarea */
arith StackAdjustment = 0; /* space for conformant arrays */
arith retsav = 0; /* temporary space for return value */
#ifdef USE_INSERT
C_insertpart(partno2); /* procedure header */
#else
- C_pro_narg(procscope->sc_name);
+ C_pro_narg(procedure->prc_name);
#ifdef DBSYMTAB
if (options['g']) {
C_ms_std((char *) 0, N_LBRAC, proclevel);
C_lol(param->par_def->var_off);
STL(param->par_def->var_off,
tp->tp_size);
- continue;
- }
- if (IsBigParamTp(tp) &&
- (param->par_def->df_flags & D_DEFINED)){
- /* Value parameter changed in body.
- Make a copy
- */
- arith tmp = TmpSpace(tp->tp_size,
- tp->tp_align);
- LOL(param->par_def->var_off,
- pointer_size);
- C_lal(tmp);
- CodeConst(WA(tp->tp_size),
- (int)pointer_size);
- C_bls(pointer_size);
- C_lal(tmp);
- STL(param->par_def->var_off,
- pointer_size);
}
continue;
}
-#ifdef PASS_BIG_VAL_AS_VAR
- if (param->par_def->df_flags & D_DEFINED)
-#endif
- {
- /* 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,
- the stack adjusted, the return value pushed
- again, and then RET
+ /* 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,
+ the stack adjusted, the return value pushed
+ again, and then RET
+ */
+ if (! StackAdjustment) {
+ /* First time we get here
*/
- if (! StackAdjustment) {
- /* First time we get here
+ if (func_type && !too_big) {
+ /* Some local space, only
+ needed if the value itself
+ is returned
*/
- if (func_type && !too_big) {
- /* Some local space, only
- needed if the value itself
- is returned
- */
- retsav= TmpSpace(func_res_size,
- 1);
- }
- StackAdjustment = NewPtr();
- C_lor((arith) 1);
- STL(StackAdjustment, pointer_size);
+ retsav= TmpSpace(func_res_size, 1);
}
- /* First compute new stackpointer */
- C_lal(param->par_def->var_off);
- CAL("new_stackptr", (int)pointer_size);
- C_lfr(pointer_size);
- C_ass(pointer_size);
- /* adjusted stack pointer */
- LOL(param->par_def->var_off, pointer_size);
- /* push source address */
- CAL("copy_array", (int)pointer_size);
- /* copy */
+ StackAdjustment = NewPtr();
+ C_lor((arith) 1);
+ STL(StackAdjustment, pointer_size);
}
+ /* First compute new stackpointer */
+ C_lal(param->par_def->var_off);
+ CAL("new_stackptr", (int)pointer_size);
+ C_lfr(pointer_size);
+ C_ass(pointer_size);
+ /* adjusted stack pointer */
+ LOL(param->par_def->var_off, pointer_size);
+ /* push source address */
+ CAL("copy_array", (int)pointer_size);
+ /* copy */
}
}
#ifdef USE_INSERT
C_ret(func_res_size);
#ifdef USE_INSERT
C_beginpart(partno2);
- C_pro(procscope->sc_name, -procscope->sc_off);
+ C_pro(procedure->prc_name, -procscope->sc_off);
#ifdef DBSYMTAB
if (options['g']) {
C_ms_std((char *) 0, N_LBRAC, proclevel);
loopid->nd_def->df_flags |= D_FORLOOP;
def_ilb(l1);
if (! options['R']) {
- label x = ++text_label;
-
ForLoopVarExpr(loopid);
C_stl(tmp2);
- end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
+ }
+ end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
+ if (! options['R']) {
+ label x = ++text_label;
C_lol(tmp2);
ForLoopVarExpr(loopid);
C_beq(x);
C_trp();
def_ilb(x);
}
- else end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
loopid->nd_def->df_flags &= ~D_FORLOOP;
FreeInt(tmp2);
if (stepsize) {
case D_VARPAR:
df_warning(nd, df,"never used/assigned");
break;
- case D_USED|D_VARPAR:
-#ifdef PASS_BIG_VAL_AS_VAR
- if (df->df_type->tp_fund != T_EQUAL) {
- df_warning(nd, df,"never assigned, could be value parameter");
- }
-#endif
- break;
case D_USED:
df_warning(nd, df,"never assigned");
break;