options[ch] = !on_on_minus;
break;
}
+ ch = c;
}
/* fall through */
default:
- PushBack();
break;
}
}
}
}
str->s_length = p - str->s_str;
- while (p - str->s_str < len) *p++ = '\0';
+ *p = '\0';
+ str->s_str = Realloc(str->s_str, (unsigned)(str->s_length) + 1);
if (str->s_length == 0) str->s_length = 1;
/* ??? string length at least 1 ??? */
return str;
LineNumber = i;
}
+static
+UnloadChar(ch)
+{
+ if (ch == EOI) eofseen = 1;
+ else PushBack();
+}
+
int
LLlex()
{
SkipComment();
goto again;
}
- else if (nch == EOI) eofseen = 1;
- else PushBack();
+ UnloadChar(nch);
}
if (ch == '&') return tk->tk_symb = AND;
if (ch == '~') return tk->tk_symb = NOT;
default :
crash("(LLlex, STCOMP)");
}
- if (nch == EOI) eofseen = 1;
- else PushBack();
+ UnloadChar(nch);
return tk->tk_symb = ch;
case STIDF:
LoadChar(ch);
} while(in_idf(ch));
- if (ch == EOI) eofseen = 1;
- else PushBack();
+ UnloadChar(ch);
*tag = '\0';
if (*(tag - 1) == '_') {
lexerror("last character of an identifier may not be an underscore");
}
else {
tk->tk_data.tk_str = str;
- if (! fit(str->s_length, (int) word_size)) {
+ if (! fit((arith)(str->s_length), (int) word_size)) {
lexerror("string too long");
}
- toktype = standard_type(T_STRING, 1, str->s_length);
+ toktype = standard_type(T_STRING, 1, (arith)(str->s_length));
}
return tk->tk_symb = STRING;
}
else {
state = End;
if (ch == 'H') base = 16;
- else if (ch == EOI) eofseen = 1;
- else PushBack();
+ UnloadChar(ch);
}
break;
state = End;
if (ch != 'H') {
lexerror("H expected after hex number");
- if (ch == EOI) eofseen = 1;
- else PushBack();
+ UnloadChar(ch);
}
break;
state = Hex;
break;
}
- if (ch == EOI) eofseen = 1;
- else PushBack();
+ UnloadChar(ch);
ch = *--np;
*np++ = '\0';
base = 8;
noscale:
*np++ = '\0';
- if (ch == EOI) eofseen = 1;
- else PushBack();
+ UnloadChar(ch);
if (np >= &buf[NUMSIZE]) {
tk->TOK_REL = Salloc("0.0", 5);
/* Structure to store a string constant
*/
struct string {
- arith s_length; /* length of a string */
+ unsigned s_length; /* length of a string */
char *s_str; /* the string itself */
};
-static char Version[] = "ACK Modula-2 compiler Version 0.38";
+static char Version[] = "ACK Modula-2 compiler Version 0.39";
if (nd->nd_class == Value &&
nd_tp->tp_fund != T_REAL &&
tp->tp_fund != T_REAL) {
- /* Constant expression mot involving REALs */
+ /* Constant expression not involving REALs */
switch(tp->tp_fund) {
case T_SUBRANGE:
- if (! chk_bounds(tp->sub_lb, nd->nd_INT,
- BaseType(tp)->tp_fund) ||
- ! chk_bounds(nd->nd_INT, tp->sub_ub,
- BaseType(tp)->tp_fund)) {
- wmess = "range bound";
- }
- break;
case T_ENUMERATION:
case T_CHAR:
- if (nd->nd_INT < 0 || nd->nd_INT >= tp->enm_ncst) {
+ if (! in_range(nd->nd_INT, tp)) {
wmess = "range bound";
}
break;
}
break;
case T_INTEGER: {
- long i = ~max_int[(int)(tp->tp_size)];
+ long i = min_int[(int)(tp->tp_size)];
long j = nd->nd_INT & i;
- if ((nd_tp->tp_fund == T_INTEGER &&
- j != i && j != 0) ||
- (nd_tp->tp_fund != T_INTEGER && j)) {
+ if (j != 0 && (nd_tp->tp_fund != T_INTEGER || j != i)) {
wmess = "conversion";
}
}
register t_node *expr = *expp;
t_type *el_type = ElementType(tp);
register unsigned int i;
- arith lo, hi, low, high;
+ arith low, high;
if (expr->nd_class == Link && expr->nd_symb == UPTO) {
/* { ... , expr1 .. expr2, ... }
}
low = high = expr->nd_INT;
}
- if (low > high) {
+ if (! chk_bounds(low, high, BaseType(el_type)->tp_fund)) {
node_error(expr, "lower bound exceeds upper bound in range");
return 0;
}
- getbounds(el_type, &lo, &hi);
- if (low < lo || high > hi) {
+ if (! in_range(low, el_type) || ! in_range(high, el_type)) {
node_error(expr, "set element out of range");
return 0;
}
/* Check a call that must have a result
*/
- if (! ChkCall(expp)) {
- expp->nd_type = error_type;
- return 0;
- }
-
- if (expp->nd_type == 0) {
+ if (ChkCall(expp)) {
+ if (expp->nd_type != 0) return 1;
node_error(expp, "function call expected");
- expp->nd_type = error_type;
- return 0;
}
- return 1;
+ expp->nd_type = error_type;
+ return 0;
}
int
return;
}
C_df_dlb(++data_label);
- C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
+ C_rom_scon(nd->nd_STR, WA((arith)(nd->nd_SLE + 1)));
c_lae_dlb(data_label);
}
}
}
else if (left->nd_symb == STRING) {
- C_loc(left->nd_SLE - 1);
+ C_loc((arith)(left->nd_SLE - 1));
}
else if (elem == word_type) {
C_loc((left_type->tp_size+word_size-1) / word_size - 1);
/* Generate a range check if neccessary
*/
- arith llo, lhi, rlo, rhi;
+ arith rlo, rhi;
if (options['R']) return;
if (bounded(tpl)) {
- /* in this case we might need a range check */
- if (!bounded(tpr)) {
- /* yes, we need one */
- genrck(tpl);
- return;
- }
- /* both types are restricted. check the bounds
+ /* In this case we might need a range check.
+ If both types are restricted. check the bounds
to see wether we need a range check.
We don't need one if the range of values of the
right hand side is a subset of the range of values
of the left hand side.
*/
- getbounds(tpl, &llo, &lhi);
- getbounds(tpr, &rlo, &rhi);
- if (llo > rlo || lhi < rhi) {
- genrck(tpl);
+ if (bounded(tpr)) {
+ getbounds(tpr, &rlo, &rhi);
+ if (in_range(rlo, tpl) && in_range(rhi, tpl)) {
+ return;
+ }
}
+ genrck(tpl);
return;
}
if (tpl->tp_size <= tpr->tp_size &&
register char *p;
char *strrindex();
- p = strrindex(fn, '/');
- while (p && *(p + 1) == '\0') { /* remove trailing /'s */
+ while ((p = strrindex(fn,'/')) && *(p + 1) == '\0') {
+ /* remove trailing /'s */
*p = '\0';
- p = strrindex(fn, '/');
}
if (p) {
*p = '/';
return fn;
}
- else return ".";
+ return ".";
}
STATIC
if (!df) {
/* Read definition module. Make an exception for SYSTEM.
*/
+ extern int ForeignFlag;
+
+ ForeignFlag = 0;
DefId = id;
+ open_scope(CLOSEDSCOPE);
if (!strcmp(id->id_text, "SYSTEM")) {
do_SYSTEM();
df = lookup(id, GlobalScope, D_IMPORTED, 0);
}
else {
- extern int ForeignFlag;
-
- ForeignFlag = 0;
- open_scope(CLOSEDSCOPE);
newsc = CurrentScope;
if (!is_anon_idf(id) && GetFile(id->id_text)) {
DefModule();
df = lookup(id, GlobalScope, D_IMPORTED, 0);
if (level == 1 &&
- (!df || !(df->df_flags & D_FOREIGN))) {
+ (df && !(df->df_flags & D_FOREIGN))) {
/* The module is directly imported by
the currently defined module, and
is not foreign, so we have to
extern t_node *Modules;
n = dot2leaf(Def);
- n->nd_def = CurrentScope->sc_definedby;
+ n->nd_def = newsc->sc_definedby;
if (nd_end) nd_end->nd_left = n;
else Modules = n;
nd_end = n;
newsc->sc_name = id->id_text;
}
vis = CurrVis;
- close_scope(SC_CHKFORW);
}
+ close_scope(SC_CHKFORW);
if (! df) {
df = MkDef(id, GlobalScope, D_ERROR);
df->mod_vis = vis;
*/
static char systemtext[] = SYSTEMTEXT;
- open_scope(CLOSEDSCOPE);
EnterType("WORD", word_type);
EnterType("BYTE", byte_type);
EnterType("ADDRESS",address_type);
fatal("could not insert text");
}
DefModule();
- close_scope(SC_CHKFORW);
}
#ifdef DEBUG
(tpx)->tp_next)
#define PointedtoType(tpx) (assert((tpx)->tp_fund == T_POINTER),\
(tpx)->tp_next)
+#define SubBaseType(tpx) (assert((tpx)->tp_fund == T_SUBRANGE), \
+ (tpx)->tp_next)
#else DEBUG
#define ResultType(tpx) ((tpx)->tp_next)
#define ParamList(tpx) ((tpx)->prc_params)
#define IndexType(tpx) ((tpx)->tp_next)
#define ElementType(tpx) ((tpx)->tp_next)
#define PointedtoType(tpx) ((tpx)->tp_next)
+#define SubBaseType(tpx) ((tpx)->tp_next)
#endif DEBUG
#define BaseType(tpx) ((tpx)->tp_fund == T_SUBRANGE ? (tpx)->tp_next : \
(tpx))
/* Check that the bounds of "tp" fall within the range
of "base".
*/
- int fund = base->tp_next->tp_fund;
-
- if (! chk_bounds(base->sub_lb, tp->sub_lb, fund) ||
- ! chk_bounds(tp->sub_ub, base->sub_ub, fund)) {
+ if (! in_range(tp->sub_lb, base) ||
+ ! in_range(tp->sub_ub, base)) {
error("base type has insufficient range");
}
base = base->tp_next;
}
- if (base->tp_fund & (T_ENUMERATION|T_CHAR)) {
+ if ((base->tp_fund & (T_ENUMERATION|T_CHAR)) || base == card_type) {
if (tp->tp_next != base) {
error("specified base does not conform");
}
}
- else if (base != card_type && base != int_type) {
- error("illegal base for a subrange");
- }
- else if (base == int_type && tp->tp_next == card_type &&
- (tp->sub_ub > max_int[(int) word_size] || tp->sub_ub < 0)) {
- error("upperbound to large for type INTEGER");
- }
- else if (base != tp->tp_next && base != int_type) {
- error("specified base does not conform");
+ else if (base == int_type) {
+ if (tp->tp_next == card_type &&
+ ! chk_bounds(tp->sub_ub,max_int[(int)int_size],T_CARDINAL)){
+ error("upperbound to large for type INTEGER");
+ }
}
-
+ else error("illegal base for a subrange");
tp->tp_next = base;
}
);
}
+int
+in_range(i, tp)
+ arith i;
+ register t_type *tp;
+{
+ /* Check that the value i fits in the subrange or enumeration
+ type tp. Return 1 if so, 0 otherwise
+ */
+
+ switch(tp->tp_fund) {
+ case T_ENUMERATION:
+ case T_CHAR:
+ return i >= 0 && i < tp->enm_ncst;
+
+ case T_SUBRANGE:
+ return chk_bounds(i, tp->sub_ub, SubBaseType(tp)->tp_fund) &&
+ chk_bounds(tp->sub_lb, i, SubBaseType(tp)->tp_fund);
+ }
+ assert(0);
+ /*NOTREACHED*/
+}
+
t_type *
subr_type(lb, ub)
register t_node *lb;
/* Assign sizes to an array type, and check index type
*/
register t_type *index_type = IndexType(tp);
- arith lo, hi, diff;
+ arith diff;
ArrayElSize(tp);
return;
}
- getbounds(index_type, &lo, &hi);
- tp->arr_low = lo;
- tp->arr_high = hi;
- diff = hi - lo;
+ getbounds(index_type, &(tp->arr_low), &(tp->arr_high));
+ diff = tp->arr_high - tp->arr_low;
if (! fit(diff, (int) int_size)) {
error("too many elements in array");
public / ack.git / commitdiff