}
str->s_length = p - str->s_str;
while (p - str->s_str < len) *p++ = '\0';
- if (str->s_length == 0) str->s_length = 1; /* ??? string length
- at least 1 ???
- */
+ if (str->s_length == 0) str->s_length = 1;
+ /* ??? string length at least 1 ??? */
return str;
}
goto again;
case STGARB:
- if (040 < ch && ch < 0177) {
+ if ((unsigned) ch - 040 < 0137) {
lexerror("garbage char %c", ch);
}
- else {
- lexerror("garbage char \\%03o", ch);
- }
+ else lexerror("garbage char \\%03o", ch);
goto again;
case STSIMP:
LIBDIR = $(EMDIR)/modules/lib
OBJECTCODE = $(LIBDIR)/libemk.a
LLGEN = $(EMDIR)/bin/LLgen
+CURRDIR = .
INCLUDES = -I$(MHDIR) -I$(EMDIR)/h -I$(PKGDIR)
GFILES = tokenfile.g program.g declar.g expression.g statement.g
-CC = cc
LLGENOPTIONS =
PROFILE =
CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC=
#EXCLEXCLEXCLEXCL
all: Cfiles
- sh -c 'if $(CC) nmclash.c > /dev/null 2>&1 ; then make ../comp/main ; else sh Resolve ../comp/main ; fi'
+ sh -c 'if $(CC) nmclash.c > /dev/null 2>&1 ; then make $(CURRDIR)/main ; else sh Resolve main ; fi'
@rm -f nmclash.o a.out
install: all
- cp main $(EMDIR)/lib/em_m2
+ cp $(CURRDIR)/main $(EMDIR)/lib/em_m2
clean:
- rm -f $(OBJ) $(GENFILES) LLfiles hfiles Cfiles tab clashes main
+ rm -f $(OBJ) $(GENFILES) LLfiles hfiles Cfiles tab clashes $(CURRDIR)/main
(cd .. ; rm -rf Xsrc)
lint: Cfiles
Xlint:
lint $(INCLUDES) $(LINTFLAGS) $(SRC)
-../comp/main: $(OBJ) ../comp/Makefile
- $(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(OBJECTCODE) $(LIBDIR)/libinput.a $(LIBDIR)/libassert.a $(LIBDIR)/liballoc.a $(MALLOC) $(LIBDIR)/libprint.a $(LIBDIR)/libstring.a $(LIBDIR)/libsystem.a -o ../comp/main
- size ../comp/main
+$(CURRDIR)/main: $(OBJ)
+ $(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(OBJECTCODE) $(LIBDIR)/libinput.a $(LIBDIR)/libassert.a $(LIBDIR)/liballoc.a $(MALLOC) $(LIBDIR)/libprint.a $(LIBDIR)/libstring.a $(LIBDIR)/libsystem.a -o $(CURRDIR)/main
+ size $(CURRDIR)/main
#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
LLlex.o: LLlex.h Lpars.h class.h const.h debug.h debugcst.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h warning.h
exit 1
;;
esac
+currdir=`pwd`
case $1 in
-../comp/main|Xlint)
+main) target=$currdir/$1
+ ;;
+Xlint) target=$1
;;
*) echo "$0: $1: Illegal argument" 1>&2
exit 1
cid -Fclashes < $PW/$i > $i
EOF
done
-make $1
+make CURRDIR=$currdir $target
}
left = arg->nd_left;
+ *argp = arg;
if (designator ? !ChkVariable(left) : !ChkExpression(left)) {
return 0;
}
}
- *argp = arg;
return left;
}
register struct node *arg = *argp;
register struct node *left;
+ *argp = arg->nd_right;
+
if (!arg->nd_right) {
Xerror(arg, "too few arguments supplied", edf);
return 0;
}
}
- *argp = arg;
return left;
}
if (left->nd_symb == STRING) {
TryToString(left, TypeOfParam(param));
}
- if (! TstParCompat(RemoveEqual(TypeOfParam(param)),
+ else if (! TstParCompat(RemoveEqual(TypeOfParam(param)),
left->nd_type,
IsVarParam(param),
left)) {
if (expp->nd_right) {
Xerror(expp->nd_right, "too many parameters supplied", edf);
+ while (expp->nd_right) {
+ getarg(&expp, 0, 0, edf);
+ }
return 0;
}
return ChkCast(expp, left);
}
- if (IsProcCall(left)) {
+ if (IsProcCall(left) || left->nd_type == error_type) {
/* A procedure call.
It may also be a call to a standard procedure
*/
C_loi(sizearg);
}
-
CodeExpr(nd, ds, true_label, false_label)
register struct node *nd;
register struct desig *ds;
left = arg->nd_left;
left_type = left->nd_type;
if (IsConformantArray(tp)) {
+ register struct type *elem = tp->arr_elem;
+
C_loc(tp->arr_elsize);
if (IsConformantArray(left_type)) {
DoHIGH(left);
- if (tp->arr_elem->tp_size !=
- left_type->arr_elem->tp_size) {
+ if (elem->tp_size != left_type->arr_elem->tp_size) {
/* This can only happen if the formal type is
- ARRAY OF WORD
+ ARRAY OF (WORD|BYTE)
*/
- assert(tp->arr_elem == word_type);
C_loc(left_type->arr_elem->tp_size);
- C_cal("_wa");
- C_asp(dword_size);
- C_lfr(word_size);
+ C_mli(word_size);
+ if (elem == word_type) {
+ C_loc(word_size - 1);
+ C_adi(word_size);
+ C_loc(word_size);
+ C_dvi(word_size);
+ }
+ else {
+ assert(elem == byte_type);
+ }
}
}
else if (left->nd_symb == STRING) {
- C_loc(left->nd_SLE);
+ C_loc(left->nd_SLE - 1);
}
- else if (tp->arr_elem == word_type) {
+ else if (elem == word_type) {
C_loc((left_type->tp_size+word_size-1) / word_size - 1);
}
+ else if (elem == byte_type) {
+ C_loc(left_type->tp_size - 1);
+ }
else {
arith lb, ub;
getbounds(IndexType(left_type), &lb, &ub);
if (left->nd_symb == STRING) {
CodeString(left);
}
+ else if (left->nd_class == Call) {
+ /* ouch! forgot about this one! */
+ arith tmp, TmpSpace();
+
+ CodePExpr(left);
+ tmp = TmpSpace(left->nd_type->tp_size, left->nd_type->tp_align);
+ C_lal(tmp);
+ C_sti(WA(left->nd_type->tp_size));
+ C_lal(tmp);
+ }
else CodeDAddress(left);
+ return;
}
- else if (IsVarParam(param)) {
+ if (IsVarParam(param)) {
CodeDAddress(left);
+ return;
}
- else {
- if (left_type->tp_fund == T_STRING) {
- CodePadString(left, tp->tp_size);
- }
- else {
- CodePExpr(left);
- RangeCheck(left_type, tp);
- }
+ if (left_type->tp_fund == T_STRING) {
+ CodePadString(left, tp->tp_size);
+ return;
}
+ CodePExpr(left);
+ RangeCheck(tp, left_type);
+ CodeCoercion(left_type, tp);
}
CodeStd(nd)
}
}
-CodeAssign(nd, dss, dst)
- register struct node *nd;
- struct desig *dst, *dss;
-{
- /* Generate code for an assignment. Testing of type
- compatibility and the like is already done.
- */
- register struct type *tp = nd->nd_right->nd_type;
- arith size = nd->nd_left->nd_type->tp_size;
-
- if (dss->dsg_kind == DSG_LOADED) {
- if (tp->tp_fund == T_STRING) {
- CodeAddress(dst);
- C_loc(tp->tp_size);
- C_loc(size);
- C_cal("_StringAssign");
- C_asp((int_size << 1) + (pointer_size << 1));
- return;
- }
- CodeStore(dst, size);
- return;
- }
- CodeAddress(dss);
- CodeAddress(dst);
- C_blm(size);
-}
-
RangeCheck(tpl, tpr)
register struct type *tpl, *tpr;
{
case OR:
case AND:
case '&': {
- label l_true, l_false, l_maybe = ++text_label, l_end;
+ label l_maybe = ++text_label, l_end;
struct desig Des;
+ int genlabels = 0;
if (true_label == 0) {
- l_true = ++text_label;
- l_false = ++text_label;
+ genlabels = 1;
+ true_label = ++text_label;
+ false_label = ++text_label;
l_end = ++text_label;
}
- else {
- l_true = true_label;
- l_false = false_label;
- }
Des = InitDesig;
if (expr->nd_symb == OR) {
- CodeExpr(leftop, &Des, l_true, l_maybe);
+ CodeExpr(leftop, &Des, true_label, l_maybe);
}
- else CodeExpr(leftop, &Des, l_maybe, l_false);
+ else CodeExpr(leftop, &Des, l_maybe, false_label);
C_df_ilb(l_maybe);
Des = InitDesig;
- CodeExpr(rightop, &Des, l_true, l_false);
- if (true_label == 0) {
- C_df_ilb(l_true);
+ CodeExpr(rightop, &Des, true_label, false_label);
+ if (genlabels) {
+ C_df_ilb(true_label);
C_loc((arith)1);
C_bra(l_end);
- C_df_ilb(l_false);
+ C_df_ilb(false_label);
C_loc((arith)0);
C_df_ilb(l_end);
}
} :
ARRAY OF qualtype(ptp)
{ register struct type *tp = construct_type(T_ARRAY, NULLTYPE);
+
tp->arr_elem = *ptp;
*ptp = tp;
tp->arr_elsize = ArrayElSize(tp->arr_elem);
- tp->tp_align = lcm(word_align, pointer_align);
+ tp->tp_align = tp->arr_elem->tp_align;
}
|
qualtype(ptp)
struct node *EnumList;
} :
'(' IdentList(&EnumList) ')'
- {
- *ptp = standard_type(T_ENUMERATION, int_align, int_size);
- EnterEnumList(EnumList, *ptp);
- if (ufit((*ptp)->enm_ncst-1, 1)) {
- (*ptp)->tp_size = 1;
- (*ptp)->tp_align = 1;
+ { register struct type *tp =
+ standard_type(T_ENUMERATION, int_align, int_size);
+
+ *ptp = tp;
+ EnterEnumList(EnumList, tp);
+ if (ufit(tp->enm_ncst-1, 1)) {
+ tp->tp_size = 1;
+ tp->tp_align = 1;
}
- else if (ufit((*ptp)->enm_ncst-1, short_size)) {
- (*ptp)->tp_size = short_size;
- (*ptp)->tp_align = short_align;
+ else if (ufit(tp->enm_ncst-1, short_size)) {
+ tp->tp_size = short_size;
+ tp->tp_align = short_align;
}
}
;
{ open_scope(OPENSCOPE); /* scope for fields of record */
scope = CurrentScope;
close_scope(0);
- size = 0;
}
FieldListSequence(scope, &size, &xalign)
{ *ptp = standard_type(T_RECORD, xalign, WA(size));
#define for_name df_value.df_forward.fo_name
};
+struct forwtype {
+ struct node *f_node;
+ struct type *f_type;
+#define df_forw_type df_value.df_fortype.f_type
+#define df_forw_node df_value.df_fortype.f_node
+};
+
struct def { /* list of definitions for a name */
struct def *next; /* next definition in definitions chain */
struct def *df_nextinscope;
/* link all definitions in a scope */
struct idf *df_idf; /* link back to the name */
struct scope *df_scope; /* scope in which this definition resides */
- short df_kind; /* the kind of this definition: */
+ unsigned short df_kind; /* the kind of this definition: */
#define D_MODULE 0x0001 /* a module */
#define D_PROCEDURE 0x0002 /* procedure of function */
#define D_VARIABLE 0x0004 /* a variable */
#define D_HIDDEN 0x0200 /* a hidden type */
#define D_FORWARD 0x0400 /* not yet defined */
#define D_FORWMODULE 0x0800 /* module must be declared later */
-#define D_ERROR 0x1000 /* a compiler generated definition for an
+#define D_FORWTYPE 0x1000 /* forward type */
+#define D_FTYPE 0x2000 /* resolved forward type */
+#define D_ERROR 0x4000 /* a compiler generated definition for an
undefined variable
*/
#define D_VALUE (D_PROCEDURE|D_VARIABLE|D_FIELD|D_ENUM|D_CONST|D_PROCHEAD)
-#define D_ISTYPE (D_HIDDEN|D_TYPE)
+#define D_ISTYPE (D_HIDDEN|D_TYPE|D_FTYPE)
#define is_type(dfx) ((dfx)->df_kind & D_ISTYPE)
char df_flags;
#define D_NOREG 0x01 /* set if it may not reside in a register */
#define D_USED 0x02 /* set if used (future use ???) */
#define D_DEFINED 0x04 /* set if it is assigned a value (future use ???) */
-#define D_VARPAR 0x10 /* set if it is a VAR parameter */
-#define D_VALPAR 0x20 /* set if it is a value parameter */
-#define D_EXPORTED 0x40 /* set if exported */
-#define D_QEXPORTED 0x80 /* set if qualified exported */
+#define D_VARPAR 0x08 /* set if it is a VAR parameter */
+#define D_VALPAR 0x10 /* set if it is a value parameter */
+#define D_EXPORTED 0x20 /* set if exported */
+#define D_QEXPORTED 0x40 /* set if qualified exported */
struct type *df_type;
union {
struct module df_module;
struct import df_import;
struct dfproc df_proc;
struct dforward df_forward;
+ struct forwtype df_fortype;
int df_stdname; /* define for standard name */
} df_value;
};
int cnt_def; /* count number of allocated ones */
#endif
+extern int (*c_inp)();
+
STATIC
DefInFront(df)
register struct def *df;
}
break;
+ case D_FORWTYPE:
+ if (kind == D_FORWTYPE) return df;
+ if (kind == D_TYPE) {
+ df->df_kind = D_FTYPE;
+ FreeNode(df->df_forw_node);
+ }
+ else {
+ error("identifier \"%s\" must be a type",
+ id->id_text);
+ }
+ return df;
+
case D_FORWARD:
/* A forward reference, for which we may now have
found a definition.
df = define(id, CurrentScope, type);
sprint(buf,"_%d_%s",++nmcount,id->id_text);
name = Salloc(buf, (unsigned)(strlen(buf)+1));
- C_inp(buf);
+ (*c_inp)(buf);
}
open_scope(OPENSCOPE);
scope = CurrentScope;
/* Create a type for it
*/
- df->df_type = standard_type(T_RECORD, 0, (arith) 0);
+ df->df_type = standard_type(T_RECORD, 1, (arith) 0);
df->df_type->rec_scope = sc;
/* Generate code that indicates that the initialization procedure
for this module is local.
*/
- C_inp(buf);
+ (*c_inp)(buf);
return df;
}
buf[10] = '\0'; /* maximum length */
strcat(buf, ".def");
if (! InsertFile(buf, DEFPATH, &(FileName))) {
- error("could'nt find a DEFINITION MODULE for \"%s\"", name);
+ error("could not find a DEFINITION MODULE for \"%s\"", name);
return 0;
}
LineNumber = 1;
struct def *df;
static int level;
struct scopelist *vis;
+ int didread = 0;
level += incr;
df = lookup(id, GlobalScope, 1);
else {
open_scope(CLOSEDSCOPE);
if (!is_anon_idf(id) && GetFile(id->id_text)) {
+ didread = 1;
DefModule();
if (level == 1) {
/* The module is directly imported by
}
df = lookup(id, GlobalScope, 1);
if (! df) {
+ if (didread) {
+ error("did not read a DEFINITION MODULE for \"%s\"", id->id_text);
+ }
df = MkDef(id, GlobalScope, D_ERROR);
df->df_type = error_type;
df->mod_vis = vis;
register struct node *nd;
} :
expression(pnd) { *pnd = nd = MkNode(Link,*pnd,NULLNODE,&dot);
- (*pnd)->nd_symb = ',';
+ nd->nd_symb = ',';
}
[
',' { nd->nd_right = MkLeaf(Link, &dot);
]*
;
-ConstExpression(struct node **pnd;):
+ConstExpression(struct node **pnd;)
+{
+ register struct node *nd;
+}:
expression(pnd)
/*
* Changed rule in new Modula-2.
* Check that the expression is a constant expression and evaluate!
*/
- { DO_DEBUG(options['X'], print("CONSTANT EXPRESSION\n"));
- DO_DEBUG(options['X'], PrNode(*pnd, 0));
- if (ChkExpression(*pnd) &&
- ((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) {
+ { nd = *pnd;
+ DO_DEBUG(options['X'], print("CONSTANT EXPRESSION\n"));
+ DO_DEBUG(options['X'], PrNode(nd, 0));
+
+ if (ChkExpression(nd) &&
+ ((nd)->nd_class != Set && (nd)->nd_class != Value)) {
error("constant expression expected");
}
+
DO_DEBUG(options['X'], print("RESULTS IN\n"));
- DO_DEBUG(options['X'], PrNode(*pnd, 0));
+ DO_DEBUG(options['X'], PrNode(nd, 0));
}
;
[ '+' | '-' ]
{ *pnd = MkLeaf(Uoper, &dot);
pnd = &((*pnd)->nd_right);
+ /* priority of unary operator ??? */
}
]?
term(pnd)
extern int err_occurred;
extern int fp_used; /* set if floating point used */
+extern C_inp(), C_exp();
+int (*c_inp)() = C_inp;
+
main(argc, argv)
register char **argv;
{
fprint(STDERR, "%s: Use a file argument\n", ProgName);
return 1;
}
+ if (options['x']) c_inp = C_exp;
return !Compile(Nargv[1], Nargv[2]);
}
*/
open_scope(CLOSEDSCOPE);
(void) Enter("WORD", D_TYPE, word_type, 0);
+ (void) Enter("BYTE", D_TYPE, byte_type, 0);
(void) Enter("ADDRESS", D_TYPE, address_type, 0);
(void) Enter("ADR", D_PROCEDURE, std_type, S_ADR);
(void) Enter("TSIZE", D_PROCEDURE, std_type, S_TSIZE);
{
extern int cnt_def, cnt_node, cnt_paramlist, cnt_type,
cnt_switch_hdr, cnt_case_entry,
- cnt_scope, cnt_scopelist, cnt_forwards, cnt_tmpvar;
+ cnt_scope, cnt_scopelist, cnt_tmpvar;
print("\
%6d def\n%6d node\n%6d paramlist\n%6d type\n%6d switch_hdr\n\
-%6d case_entry\n%6d scope\n%6d scopelist\n%6d forwards\n%6d tmpvar\n",
+%6d case_entry\n%6d scope\n%6d scopelist\n%6d tmpvar\n",
cnt_def, cnt_node, cnt_paramlist, cnt_type,
cnt_switch_hdr, cnt_case_entry,
-cnt_scope, cnt_scopelist, cnt_forwards, cnt_tmpvar);
+cnt_scope, cnt_scopelist, cnt_tmpvar);
print("\nNumber of lines read: %d\n", cntlines);
}
#endif
priority(arith *pprio;)
{
- struct node *nd;
+ register struct node *nd;
+ struct node *nd1; /* &nd is illegal */
} :
- '[' ConstExpression(&nd) ']'
- { if (!(nd->nd_type->tp_fund & T_CARDINAL)) {
+ '[' ConstExpression(&nd1) ']'
+ { nd = nd1;
+ if (!(nd->nd_type->tp_fund & T_CARDINAL)) {
node_error(nd, "illegal priority");
}
*pprio = nd->nd_INT;
}
;
-export(int *QUALflag; struct node **ExportList;)
-{
-} :
+export(int *QUALflag; struct node **ExportList;):
EXPORT
[
QUALIFIED
import(int local;)
{
struct node *ImportList;
- struct node *FromId = 0;
+ register struct node *FromId = 0;
register struct def *df;
extern struct def *GetDefinitionModule();
} :
if (!Defined) Defined = df;
CurrentScope->sc_name = df->df_idf->id_text;
df->mod_vis = CurrVis;
- df->df_type = standard_type(T_RECORD, 0, (arith) 0);
+ df->df_type = standard_type(T_RECORD, 1, (arith) 0);
df->df_type->rec_scope = df->mod_vis->sc_scope;
DefinitionModule++;
}
;
Module:
- { open_scope(CLOSEDSCOPE);
- warning(W_ORDINARY, "Compiling a definition module");
- }
- DefinitionModule
- { close_scope(SC_CHKFORW); }
-|
+ DEFINITION
+ { fatal("Compiling a definition module"); }
+| %default
[
IMPLEMENTATION { state = IMPLEMENTATION; }
|
register struct scopelist *ls = new_scopelist();
sc->sc_scopeclosed = 0;
- sc->sc_forw = 0;
sc->sc_def = 0;
sc->sc_level = proclevel;
PervasiveScope = sc;
CurrVis = ls;
}
-struct forwards {
- struct forwards *next;
- struct node *fo_tok;
- struct type *fo_ptyp;
-};
-
-/* STATICALLOCDEF "forwards" 5 */
-
Forward(tk, ptp)
struct node *tk;
struct type *ptp;
may have forward references that must howewer be declared in the
same scope.
*/
- register struct forwards *f = new_forwards();
- register struct scope *sc = CurrentScope;
+ register struct def *df = define(tk->nd_IDF, CurrentScope, D_FORWTYPE);
- f->fo_tok = tk;
- f->fo_ptyp = ptp;
- f->next = sc->sc_forw;
- sc->sc_forw = f;
+ df->df_forw_type = ptp;
+ df->df_forw_node = tk;
}
STATIC
register struct def *df;
while (df = *pdf) {
- if (df->df_kind & (D_FORWARD|D_FORWMODULE)) {
+ if (df->df_kind == D_FORWTYPE) {
+node_error(df->df_forw_node, "type \"%s\" not declared", df->df_idf->id_text);
+ FreeNode(df->df_forw_node);
+ }
+ else if (df->df_kind == D_FTYPE) {
+ df->df_kind = D_TYPE;
+ df->df_forw_type->next = df->df_type;
+ }
+ else if (df->df_kind & (D_FORWARD|D_FORWMODULE)) {
/* These definitions must be found in
the enclosing closed scope, which of course
may be the scope that is now closed!
/* Indeed, the scope was a closed
scope, so give error message
*/
-node_error(df->for_node, "identifier \"%s\" has not been declared",
+node_error(df->for_node, "identifier \"%s\" not declared",
df->df_idf->id_text);
FreeNode(df->for_node);
}
}
}
-STATIC
-rem_forwards(fo)
- register struct forwards *fo;
-{
- /* When closing a scope, all forward references must be resolved
- */
- register struct def *df;
-
- if (fo->next) rem_forwards(fo->next);
- df = lookfor(fo->fo_tok, CurrVis, 0);
- if (! is_type(df)) {
- node_error(fo->fo_tok,
- "identifier \"%s\" does not represent a type",
- df->df_idf->id_text);
- }
- fo->fo_ptyp->next = df->df_type;
- free_forwards(fo);
-}
-
Reverse(pdf)
struct def **pdf;
{
assert(sc != 0);
if (flag) {
- if (sc->sc_forw) rem_forwards(sc->sc_forw);
DO_DEBUG(options['S'], PrScopeDef(sc->sc_def));
if (flag & SC_CHKPROC) chk_proc(sc->sc_def);
if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def));
struct scope {
struct scope *next;
- struct forwards *sc_forw;
char *sc_name; /* name of this scope */
struct def *sc_def; /* list of definitions in this scope */
arith sc_off; /* offsets of variables in this scope */
ProcScope = sc;
}
+arith
+TmpSpace(sz, al)
+ arith sz;
+{
+ register struct scope *sc = ProcScope;
+
+ sc->sc_off = - WA(align(sz - sc->sc_off, al));
+ return sc->sc_off;
+}
+
arith
NewInt()
{
register struct tmpvar *tmp;
if (!TmpInts) {
- offset = - WA(align(int_size - ProcScope->sc_off, int_align));
- ProcScope->sc_off = offset;
+ offset = TmpSpace(int_size, int_align);
if (! options['n']) C_ms_reg(offset, int_size, reg_any, 0);
}
else {
register struct tmpvar *tmp;
if (!TmpPtrs) {
- offset = - WA(align(pointer_size - ProcScope->sc_off, pointer_align));
- ProcScope->sc_off = offset;
+ offset = TmpSpace(pointer_size, pointer_align);
if (! options['n']) C_ms_reg(offset, pointer_size, reg_pointer, 0);
}
else {
*real_type,
*longreal_type,
*word_type,
+ *byte_type,
*address_type,
*intorcard_type,
*bitset_type,
*real_type,
*longreal_type,
*word_type,
+ *byte_type,
*address_type,
*intorcard_type,
*bitset_type,
register struct type *tp = new_type();
tp->tp_fund = fund;
- tp->tp_align = align;
+ tp->tp_align = align ? align : 1;
tp->tp_size = size;
return tp;
/* SYSTEM types
*/
word_type = standard_type(T_WORD, word_align, word_size);
+ byte_type = standard_type(T_WORD, 1, (arith) 1);
address_type = construct_type(T_POINTER, word_type);
/* create BITSET type
if (tp->tp_fund == T_ARRAY) ArraySizes(tp);
algn = align(tp->tp_size, tp->tp_align);
- if (algn && word_size % algn != 0) {
+ if (word_size % algn != 0) {
/* algn is not a dividor of the word size, so make sure it
is a multiple
*/
- algn = WA(algn);
+ return WA(algn);
}
return algn;
}
*/
if (! bounded(index_type)) {
error("illegal index type");
- tp->tp_size = 0;
+ tp->tp_size = tp->arr_elsize;
return;
}
getbounds(index_type, &lo, &hi);
- tp->tp_size = WA((hi - lo + 1) * tp->arr_elsize);
+ tp->tp_size = (hi - lo + 1) * tp->arr_elsize;
/* generate descriptor and remember label.
*/
/* Check type compatibility for a parameter in a procedure call.
Assignment compatibility may do if the parameter is
a value parameter.
- Otherwise, a conformant array may do, or an ARRAY OF WORD
+ Otherwise, a conformant array may do, or an ARRAY OF (WORD|BYTE)
may do too.
Or: a WORD may do.
*/
)
)
)
+ ||
+ ( formaltype == byte_type
+ && actualtype->tp_size == (arith) 1
+ )
||
( IsConformantArray(formaltype)
&&
( formaltype->arr_elem == word_type
+ || formaltype->arr_elem == byte_type
||
( actualtype->tp_fund == T_ARRAY
&& TstTypeEquiv(formaltype->arr_elem,actualtype->arr_elem)
static label filename_label = 0;
if (! options['L']) {
- if (!filename_label) {
- filename_label = ++data_label;
- C_df_dlb(filename_label);
+ register label fn_label = filename_label;
+
+ if (!fn_label) {
+ filename_label = fn_label = ++data_label;
+ C_df_dlb(fn_label);
C_rom_scon(FileName, (arith) (strlen(FileName) + 1));
}
- C_fil_dlb(filename_label, (arith) 0);
+ C_fil_dlb(fn_label, (arith) 0);
}
}
local definitions, checking and generating code.
*/
struct scopelist *savevis = CurrVis;
- register struct scope *sc;
+ register struct scope *sc = procedure->prc_vis->sc_scope;
register struct type *tp;
register struct paramlist *param;
label func_res_label = 0;
proclevel++;
CurrVis = procedure->prc_vis;
- sc = CurrentScope;
/* Generate code for all local modules and procedures
*/
}
WalkStat(nd, exit_label)
- struct node *nd;
+ register struct node *nd;
label exit_label;
{
/* Walk through a statement, generating code for it.
{
arith tmp = 0;
register struct node *fnd;
+ int good_forvar;
label l1 = ++text_label;
label l2 = ++text_label;
- if (! DoForInit(nd, left)) break;
+ good_forvar = DoForInit(nd, left);
fnd = left->nd_right;
if (fnd->nd_class != Value) {
/* Upperbound not constant.
C_bgt(l2);
}
else C_blt(l2);
- RangeCheck(nd->nd_type, int_type);
- CodeDStore(nd);
+ if (good_forvar) {
+ RangeCheck(nd->nd_type, int_type);
+ CodeDStore(nd);
+ }
WalkNode(right, exit_label);
- CodePExpr(nd);
- C_loc(left->nd_INT);
- C_adi(int_size);
- C_bra(l1);
- C_df_ilb(l2);
- C_asp(int_size);
+ if (good_forvar) {
+ CodePExpr(nd);
+ C_loc(left->nd_INT);
+ C_adi(int_size);
+ C_bra(l1);
+ C_df_ilb(l2);
+ C_asp(int_size);
+ }
if (tmp) FreeInt(tmp);
}
break;
case RETURN:
if (right) {
- if (! WalkExpr(right)) break;
+ 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 (!TstAssCompat(func_type, right->nd_type)) {
node_error(right, "type incompatibility in RETURN statement");
+ break;
}
+ if (right->nd_type->tp_fund == T_STRING) {
+ arith strsize = WA(right->nd_type->tp_size);
+
+ C_zer(WA(func_type->tp_size) - strsize);
+ CodePExpr(right);
+ C_loi(strsize);
+ }
+ else CodePExpr(right);
}
C_bra(RETURN_LABEL);
break;
if (df->df_kind == D_FIELD) {
node_error(nd,
"FOR-loop variable may not be a field of a record");
- return 0;
+ return 1;
}
if (!df->var_name && df->var_off >= 0) {
node_error(nd, "FOR-loop variable may not be a parameter");
- return 0;
+ return 1;
}
if (df->df_scope != CurrentScope) {
if (!sc) {
node_error(nd,
"FOR-loop variable may not be imported");
- return 0;
+ 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 0;
+ return 1;
}
if (!TstCompat(df->df_type, left->nd_left->nd_type) ||
if (!TstAssCompat(df->df_type, left->nd_left->nd_type) ||
!TstAssCompat(df->df_type, left->nd_right->nd_type)) {
node_error(nd, "type incompatibility in FOR statement");
- return 0;
+ return 1;
}
node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement");
}
DAMN THE BOOK!
*/
struct desig dsl, dsr;
+ register struct type *rtp, *ltp;
if (! (ChkExpression(right) & ChkVariable(left))) return;
+ rtp = right->nd_type;
+ ltp = left->nd_type;
- if (right->nd_symb == STRING) TryToString(right, left->nd_type);
+ if (right->nd_symb == STRING) TryToString(right, ltp);
dsr = InitDesig;
- if (! TstAssCompat(left->nd_type, right->nd_type)) {
+ if (! TstAssCompat(ltp, rtp)) {
node_error(nd, "type incompatibility in assignment");
return;
}
CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);
- if (complex(right->nd_type)) {
- CodeAddress(&dsr);
- }
+ if (complex(rtp)) CodeAddress(&dsr);
else {
- CodeValue(&dsr, right->nd_type->tp_size);
- RangeCheck(left->nd_type, right->nd_type);
+ CodeValue(&dsr, rtp->tp_size);
+ RangeCheck(ltp, rtp);
+ CodeCoercion(rtp, ltp);
}
dsl = InitDesig;
CodeDesig(left, &dsl);
- CodeAssign(nd, &dsr, &dsl);
+ /* Generate code for an assignment. Testing of type
+ compatibility and the like is already done.
+ */
+
+ if (dsr.dsg_kind == DSG_LOADED) {
+ if (rtp->tp_fund == T_STRING) {
+ CodeAddress(&dsl);
+ C_loc(rtp->tp_size);
+ C_loc(ltp->tp_size);
+ C_cal("_StringAssign");
+ C_asp((int_size << 1) + (pointer_size << 1));
+ return;
+ }
+ CodeStore(&dsl, ltp->tp_size);
+ return;
+ }
+ CodeAddress(&dsl);
+ C_blm(ltp->tp_size);
}
RegisterMessages(df)
public / ack.git / commitdiff