Added support for constant floating point expressions

This commit is contained in:
ceriel 1989-12-19 09:40:25 +00:00
parent 4b42dcf97f
commit c3b3faf7a4
13 changed files with 243 additions and 29 deletions

View file

@ -48,6 +48,7 @@ node.c
options.c options.c
options options
program.g program.g
real.H
scope.C scope.C
scope.h scope.h
standards.h standards.h

View file

@ -42,6 +42,7 @@ extern int cntlines;
#endif #endif
extern char options[]; extern char options[];
extern int flt_status;
STATIC STATIC
SkipComment() SkipComment()
@ -391,10 +392,9 @@ again:
enum statetp {Oct,OptHex,Hex,Dec,OctEndOrHex,End,OptReal,Real}; enum statetp {Oct,OptHex,Hex,Dec,OctEndOrHex,End,OptReal,Real};
register enum statetp state; register enum statetp state;
register int base = 8; register int base = 8;
register char *np = &buf[1]; register char *np = &buf[0];
/* allow a '-' to be added */ /* allow a '-' to be added */
buf[0] = '-';
*np++ = ch; *np++ = ch;
state = is_oct(ch) ? Oct : Dec; state = is_oct(ch) ? Oct : Dec;
LoadChar(ch); LoadChar(ch);
@ -489,7 +489,7 @@ again:
*/ */
arith ubound = max_int[sizeof(arith)] arith ubound = max_int[sizeof(arith)]
/ (base >> 1); / (base >> 1);
np = &buf[1]; np = &buf[0];
while (*np == '0') np++; while (*np == '0') np++;
tk->TOK_INT = 0; tk->TOK_INT = 0;
while (*np) { while (*np) {
@ -613,12 +613,17 @@ lexwarning(W_ORDINARY, "overflow in constant");
*np++ = '\0'; *np++ = '\0';
PushBack(); PushBack();
tk->tk_data.tk_real = new_real();
if (np >= &buf[NUMSIZE]) { if (np >= &buf[NUMSIZE]) {
tk->TOK_REL = Salloc("-0.0", 5)+1; tk->TOK_REAL = Salloc("0.0", 4);
lexerror("real constant too long"); lexerror("real constant too long");
} }
else tk->TOK_REL = Salloc(buf, (unsigned) (np - buf)) + 1; else tk->TOK_REAL = Salloc(buf, (unsigned) (np - buf));
CheckForLet(); CheckForLet();
flt_str2flt(tk->TOK_REAL, &(tk->TOK_RVAL));
if (flt_status == FLT_OVFL) {
lexwarning(W_ORDINARY, "overflow in floating point constant");
}
return tk->tk_symb = REAL; return tk->tk_symb = REAL;
/*NOTREACHED*/ /*NOTREACHED*/

View file

@ -9,6 +9,8 @@
/* $Header$ */ /* $Header$ */
#include "real.h"
/* Structure to store a string constant /* Structure to store a string constant
*/ */
struct string { struct string {
@ -25,7 +27,7 @@ struct token {
struct idf *tk_idf; /* IDENT */ struct idf *tk_idf; /* IDENT */
struct string *tk_str; /* STRING */ struct string *tk_str; /* STRING */
arith tk_int; /* INTEGER */ arith tk_int; /* INTEGER */
char *tk_real; /* REAL */ struct real *tk_real; /* REAL */
arith *tk_set; /* only used in parse tree node */ arith *tk_set; /* only used in parse tree node */
struct def *tk_def; /* only used in parse tree node */ struct def *tk_def; /* only used in parse tree node */
label tk_lab; /* only used in parse tree node */ label tk_lab; /* only used in parse tree node */
@ -38,7 +40,8 @@ typedef struct token t_token;
#define TOK_STR tk_data.tk_str->s_str #define TOK_STR tk_data.tk_str->s_str
#define TOK_SLE tk_data.tk_str->s_length #define TOK_SLE tk_data.tk_str->s_length
#define TOK_INT tk_data.tk_int #define TOK_INT tk_data.tk_int
#define TOK_REL tk_data.tk_real #define TOK_REAL tk_data.tk_real->r_real
#define TOK_RVAL tk_data.tk_real->r_val
extern t_token dot, aside; extern t_token dot, aside;
extern struct type *toktype; extern struct type *toktype;

View file

@ -55,7 +55,9 @@ LLmessage(tk)
dotp->TOK_INT = 1; dotp->TOK_INT = 1;
break; break;
case REAL: case REAL:
dotp->TOK_REL = Salloc("0.0", 4); dotp->tk_data.tk_real = new_real();
dotp->TOK_REAL = Salloc("0.0", 4);
flt_str2flt(dotp->TOK_REAL, &dotp->TOK_RVAL);
break; break;
} }
} }

View file

@ -20,20 +20,19 @@ MODLIB = $(LIBDIR)/libinput.a \
$(LIBDIR)/libassert.a \ $(LIBDIR)/libassert.a \
$(LIBDIR)/liballoc.a \ $(LIBDIR)/liballoc.a \
$(MALLOC) \ $(MALLOC) \
$(LIBDIR)/libflt.a \
$(LIBDIR)/libprint.a \ $(LIBDIR)/libprint.a \
$(LIBDIR)/libstring.a \ $(LIBDIR)/libstring.a \
$(LIBDIR)/libsystem.a $(LIBDIR)/libsystem.a
EMCELIB = $(LIBDIR)/libem_mesCE.a \ EMCELIB = $(LIBDIR)/libem_mesCE.a \
$(EMHOME)/lib/$(MACH)/ce.a \ $(EMHOME)/lib/$(MACH)/ce.a \
$(EMHOME)/lib/$(MACH)/$(BACK).a \ $(EMHOME)/lib/$(MACH)/$(BACK).a \
$(LIBDIR)/libflt.a \
$(LIBDIR)/libobject.a \ $(LIBDIR)/libobject.a \
$(EMHOME)/lib/em_data.a $(EMHOME)/lib/em_data.a
EMOCELIB = $(LIBDIR)/libem_mesO.a \ EMOCELIB = $(LIBDIR)/libem_mesO.a \
$(LIBDIR)/libCEopt.a \ $(LIBDIR)/libCEopt.a \
$(EMHOME)/lib/$(MACH)/ce.a \ $(EMHOME)/lib/$(MACH)/ce.a \
$(EMHOME)/lib/$(MACH)/$(BACK).a \ $(EMHOME)/lib/$(MACH)/$(BACK).a \
$(LIBDIR)/libflt.a \
$(LIBDIR)/libobject.a \ $(LIBDIR)/libobject.a \
$(EMHOME)/lib/em_data.a $(EMHOME)/lib/em_data.a
@ -49,8 +48,8 @@ PROFILE =
COPTIONS = COPTIONS =
INCLUDES = -I$(MHDIR) -I$(EMHOME)/h -I$(PKGDIR) INCLUDES = -I$(MHDIR) -I$(EMHOME)/h -I$(PKGDIR)
OPTIM = -O OPTIM = -O
CFLAGS = $(PROFILE) $(INCLUDES) $(COPTIONS) $(OPTIM) -DSTATIC= CFLAGS = $(PROFILE) $(INCLUDES) $(COPTIONS) $(OPTIM)
LINTFLAGS = -DSTATIC= -DNORCSID LINTFLAGS =
LDFLAGS = -i $(PROFILE) LDFLAGS = -i $(PROFILE)
LSRC = tokenfile.c program.c declar.c expression.c statement.c LSRC = tokenfile.c program.c declar.c expression.c statement.c
@ -77,14 +76,14 @@ OBJ = $(COBJ) $(LOBJ) Lpars.o $(EXTRA_O)
GENH = errout.h \ 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 bigparam.h bigresult.h \
inputtype.h density.h squeeze.h nocross.h nostrict.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 def.h debugcst.h type.h Lpars.h node.h desig.h strict3rd.h real.h
HFILES =LLlex.h \ HFILES =LLlex.h \
chk_expr.h class.h const.h debug.h f_info.h idf.h \ chk_expr.h class.h const.h debug.h f_info.h idf.h \
input.h main.h misc.h scope.h standards.h tokenname.h \ input.h main.h misc.h scope.h standards.h tokenname.h \
walk.h warning.h SYSTEM.h $(GENH) walk.h warning.h SYSTEM.h $(GENH)
# #
GENFILES = $(GENGFILES) $(GENC) $(GENH) GENFILES = $(GENGFILES) $(GENC) $(GENH)
NEXTFILES = def.H type.H node.H desig.H scope.C tmpvar.C casestat.C NEXTFILES = def.H type.H node.H desig.H real.H scope.C tmpvar.C casestat.C
#EXCLEXCLEXCLEXCL #EXCLEXCLEXCLEXCL
@ -159,6 +158,7 @@ symbol2str.c: tokenname.c make.tokcase
def.h: make.allocd def.h: make.allocd
type.h: make.allocd type.h: make.allocd
real.h: make.allocd
node.h: make.allocd node.h: make.allocd
desig.h: make.allocd desig.h: make.allocd
scope.c: make.allocd scope.c: make.allocd
@ -188,6 +188,7 @@ Xlint:
$(LIBDIR)/llib-linput.ln \ $(LIBDIR)/llib-linput.ln \
$(LIBDIR)/llib-lassert.ln \ $(LIBDIR)/llib-lassert.ln \
$(LIBDIR)/llib-lalloc.ln \ $(LIBDIR)/llib-lalloc.ln \
$(LIBDIR)/llib-lflt.ln \
$(LIBDIR)/llib-lprint.ln \ $(LIBDIR)/llib-lprint.ln \
$(LIBDIR)/llib-lstring.ln \ $(LIBDIR)/llib-lstring.ln \
$(LIBDIR)/llib-lsystem.ln $(LIBDIR)/llib-lsystem.ln
@ -221,6 +222,7 @@ LLlex.o: input.h
LLlex.o: inputtype.h LLlex.o: inputtype.h
LLlex.o: nocross.h LLlex.o: nocross.h
LLlex.o: numsize.h LLlex.o: numsize.h
LLlex.o: real.h
LLlex.o: strsize.h LLlex.o: strsize.h
LLlex.o: target_sizes.h LLlex.o: target_sizes.h
LLlex.o: type.h LLlex.o: type.h
@ -228,6 +230,7 @@ LLlex.o: warning.h
LLmessage.o: LLlex.h LLmessage.o: LLlex.h
LLmessage.o: Lpars.h LLmessage.o: Lpars.h
LLmessage.o: idf.h LLmessage.o: idf.h
LLmessage.o: real.h
error.o: LLlex.h error.o: LLlex.h
error.o: debug.h error.o: debug.h
error.o: debugcst.h error.o: debugcst.h
@ -238,6 +241,7 @@ error.o: inputtype.h
error.o: main.h error.o: main.h
error.o: node.h error.o: node.h
error.o: nostrict.h error.o: nostrict.h
error.o: real.h
error.o: strict3rd.h error.o: strict3rd.h
error.o: warning.h error.o: warning.h
main.o: LLlex.h main.o: LLlex.h
@ -253,6 +257,7 @@ main.o: input.h
main.o: inputtype.h main.o: inputtype.h
main.o: nocross.h main.o: nocross.h
main.o: node.h main.o: node.h
main.o: real.h
main.o: scope.h main.o: scope.h
main.o: standards.h main.o: standards.h
main.o: strict3rd.h main.o: strict3rd.h
@ -278,6 +283,7 @@ type.o: idf.h
type.o: nocross.h type.o: nocross.h
type.o: node.h type.o: node.h
type.o: nostrict.h type.o: nostrict.h
type.o: real.h
type.o: scope.h type.o: scope.h
type.o: squeeze.h type.o: squeeze.h
type.o: target_sizes.h type.o: target_sizes.h
@ -294,6 +300,7 @@ def.o: idf.h
def.o: main.h def.o: main.h
def.o: nocross.h def.o: nocross.h
def.o: node.h def.o: node.h
def.o: real.h
def.o: scope.h def.o: scope.h
def.o: target_sizes.h def.o: target_sizes.h
def.o: type.h def.o: type.h
@ -303,6 +310,7 @@ misc.o: f_info.h
misc.o: idf.h misc.o: idf.h
misc.o: misc.h misc.o: misc.h
misc.o: node.h misc.o: node.h
misc.o: real.h
enter.o: LLlex.h enter.o: LLlex.h
enter.o: bigparam.h enter.o: bigparam.h
enter.o: debug.h enter.o: debug.h
@ -314,6 +322,7 @@ enter.o: main.h
enter.o: misc.h enter.o: misc.h
enter.o: nocross.h enter.o: nocross.h
enter.o: node.h enter.o: node.h
enter.o: real.h
enter.o: scope.h enter.o: scope.h
enter.o: target_sizes.h enter.o: target_sizes.h
enter.o: type.h enter.o: type.h
@ -331,6 +340,7 @@ defmodule.o: main.h
defmodule.o: misc.h defmodule.o: misc.h
defmodule.o: nocross.h defmodule.o: nocross.h
defmodule.o: node.h defmodule.o: node.h
defmodule.o: real.h
defmodule.o: scope.h defmodule.o: scope.h
defmodule.o: target_sizes.h defmodule.o: target_sizes.h
defmodule.o: type.h defmodule.o: type.h
@ -343,6 +353,7 @@ typequiv.o: idf.h
typequiv.o: main.h typequiv.o: main.h
typequiv.o: nocross.h typequiv.o: nocross.h
typequiv.o: node.h typequiv.o: node.h
typequiv.o: real.h
typequiv.o: strict3rd.h typequiv.o: strict3rd.h
typequiv.o: target_sizes.h typequiv.o: target_sizes.h
typequiv.o: type.h typequiv.o: type.h
@ -355,16 +366,19 @@ node.o: def.h
node.o: main.h node.o: main.h
node.o: nocross.h node.o: nocross.h
node.o: node.h node.o: node.h
node.o: real.h
node.o: target_sizes.h node.o: target_sizes.h
node.o: type.h node.o: type.h
cstoper.o: LLlex.h cstoper.o: LLlex.h
cstoper.o: Lpars.h cstoper.o: Lpars.h
cstoper.o: bigparam.h cstoper.o: bigparam.h
cstoper.o: const.h
cstoper.o: debug.h cstoper.o: debug.h
cstoper.o: debugcst.h cstoper.o: debugcst.h
cstoper.o: idf.h cstoper.o: idf.h
cstoper.o: nocross.h cstoper.o: nocross.h
cstoper.o: node.h cstoper.o: node.h
cstoper.o: real.h
cstoper.o: standards.h cstoper.o: standards.h
cstoper.o: target_sizes.h cstoper.o: target_sizes.h
cstoper.o: type.h cstoper.o: type.h
@ -383,6 +397,7 @@ chk_expr.o: misc.h
chk_expr.o: nocross.h chk_expr.o: nocross.h
chk_expr.o: node.h chk_expr.o: node.h
chk_expr.o: nostrict.h chk_expr.o: nostrict.h
chk_expr.o: real.h
chk_expr.o: scope.h chk_expr.o: scope.h
chk_expr.o: standards.h chk_expr.o: standards.h
chk_expr.o: strict3rd.h chk_expr.o: strict3rd.h
@ -415,6 +430,7 @@ walk.o: main.h
walk.o: misc.h walk.o: misc.h
walk.o: nocross.h walk.o: nocross.h
walk.o: node.h walk.o: node.h
walk.o: real.h
walk.o: scope.h walk.o: scope.h
walk.o: squeeze.h walk.o: squeeze.h
walk.o: strict3rd.h walk.o: strict3rd.h
@ -430,6 +446,7 @@ desig.o: def.h
desig.o: desig.h desig.o: desig.h
desig.o: nocross.h desig.o: nocross.h
desig.o: node.h desig.o: node.h
desig.o: real.h
desig.o: scope.h desig.o: scope.h
desig.o: squeeze.h desig.o: squeeze.h
desig.o: target_sizes.h desig.o: target_sizes.h
@ -446,6 +463,7 @@ code.o: def.h
code.o: desig.h code.o: desig.h
code.o: nocross.h code.o: nocross.h
code.o: node.h code.o: node.h
code.o: real.h
code.o: scope.h code.o: scope.h
code.o: squeeze.h code.o: squeeze.h
code.o: standards.h code.o: standards.h
@ -461,6 +479,7 @@ lookup.o: idf.h
lookup.o: misc.h lookup.o: misc.h
lookup.o: nocross.h lookup.o: nocross.h
lookup.o: node.h lookup.o: node.h
lookup.o: real.h
lookup.o: scope.h lookup.o: scope.h
lookup.o: target_sizes.h lookup.o: target_sizes.h
lookup.o: type.h lookup.o: type.h
@ -476,6 +495,7 @@ program.o: idf.h
program.o: main.h program.o: main.h
program.o: nocross.h program.o: nocross.h
program.o: node.h program.o: node.h
program.o: real.h
program.o: scope.h program.o: scope.h
program.o: strict3rd.h program.o: strict3rd.h
program.o: target_sizes.h program.o: target_sizes.h
@ -494,6 +514,7 @@ declar.o: misc.h
declar.o: nocross.h declar.o: nocross.h
declar.o: node.h declar.o: node.h
declar.o: nostrict.h declar.o: nostrict.h
declar.o: real.h
declar.o: scope.h declar.o: scope.h
declar.o: strict3rd.h declar.o: strict3rd.h
declar.o: target_sizes.h declar.o: target_sizes.h
@ -510,6 +531,7 @@ expression.o: def.h
expression.o: idf.h expression.o: idf.h
expression.o: nocross.h expression.o: nocross.h
expression.o: node.h expression.o: node.h
expression.o: real.h
expression.o: target_sizes.h expression.o: target_sizes.h
expression.o: type.h expression.o: type.h
expression.o: warning.h expression.o: warning.h
@ -520,6 +542,7 @@ statement.o: def.h
statement.o: idf.h statement.o: idf.h
statement.o: nocross.h statement.o: nocross.h
statement.o: node.h statement.o: node.h
statement.o: real.h
statement.o: scope.h statement.o: scope.h
statement.o: target_sizes.h statement.o: target_sizes.h
statement.o: type.h statement.o: type.h
@ -537,6 +560,7 @@ casestat.o: density.h
casestat.o: desig.h casestat.o: desig.h
casestat.o: nocross.h casestat.o: nocross.h
casestat.o: node.h casestat.o: node.h
casestat.o: real.h
casestat.o: squeeze.h casestat.o: squeeze.h
casestat.o: target_sizes.h casestat.o: target_sizes.h
casestat.o: type.h casestat.o: type.h
@ -548,6 +572,7 @@ tmpvar.o: debugcst.h
tmpvar.o: def.h tmpvar.o: def.h
tmpvar.o: main.h tmpvar.o: main.h
tmpvar.o: nocross.h tmpvar.o: nocross.h
tmpvar.o: real.h
tmpvar.o: scope.h tmpvar.o: scope.h
tmpvar.o: target_sizes.h tmpvar.o: target_sizes.h
tmpvar.o: type.h tmpvar.o: type.h
@ -559,6 +584,7 @@ scope.o: def.h
scope.o: idf.h scope.o: idf.h
scope.o: nocross.h scope.o: nocross.h
scope.o: node.h scope.o: node.h
scope.o: real.h
scope.o: scope.h scope.o: scope.h
scope.o: target_sizes.h scope.o: target_sizes.h
scope.o: type.h scope.o: type.h

View file

@ -37,6 +37,7 @@
extern char *symbol2str(); extern char *symbol2str();
extern char *sprint(); extern char *sprint();
extern arith flt2arith();
STATIC int STATIC int
df_error(nd, mess, edf) df_error(nd, mess, edf)
@ -78,14 +79,53 @@ MkCoercion(pnd, tp)
register t_type *nd_tp = nd->nd_type; register t_type *nd_tp = nd->nd_type;
extern int pass_1; extern int pass_1;
char *wmess = 0; char *wmess = 0;
arith op;
if (nd_tp == tp || nd_tp->tp_fund == T_STRING /* Why ??? */) return; if (nd_tp == tp || nd_tp->tp_fund == T_STRING /* Why ??? */) return;
nd_tp = BaseType(nd_tp); nd_tp = BaseType(nd_tp);
if (nd->nd_class == Value && if (nd->nd_class == Value) {
nd_tp->tp_fund != T_REAL && if (nd_tp->tp_fund == T_REAL) {
tp->tp_fund != T_REAL) {
/* Constant expression not involving REALs */
switch(tp->tp_fund) { switch(tp->tp_fund) {
case T_REAL:
nd->nd_type = tp;
return;
case T_CARDINAL:
op = flt_flt2arith(&nd->nd_RVAL, 1);
break;
case T_INTEGER:
op = flt_flt2arith(&nd->nd_RVAL, 0);
break;
default:
crash("MkCoercion");
}
if (flt_status == FLT_OVFL) {
wmess = "conversion";
}
if (!wmess || pass_1) {
if (nd->nd_REAL) free(nd->nd_REAL);
free_real(nd->nd_token.tk_data.tk_real);
nd->nd_INT = op;
nd->nd_symb = INTEGER;
}
}
switch(tp->tp_fund) {
case T_REAL: {
struct real *p = new_real();
switch(BaseType(nd_tp)->tp_fund) {
case T_CARDINAL:
case T_INTORCARD:
flt_arith2flt(nd->nd_INT, &p->r_val, 1);
break;
case T_INTEGER:
flt_arith2flt(nd->nd_INT, &p->r_val, 0);
break;
default:
crash("MkCoercion");
}
nd->nd_token.tk_data.tk_real = p;
nd->nd_symb = REAL;
}
break;
case T_SUBRANGE: case T_SUBRANGE:
case T_ENUMERATION: case T_ENUMERATION:
case T_CHAR: case T_CHAR:
@ -330,6 +370,16 @@ ChkExLinkOrName(expp)
expp->nd_class = Def; expp->nd_class = Def;
} }
else expp->nd_class = Value; else expp->nd_class = Value;
if (df->df_type->tp_fund == T_REAL) {
struct real *p = expp->nd_token.tk_data.tk_real;
expp->nd_token.tk_data.tk_real = new_real();
*(expp->nd_token.tk_data.tk_real) = *p;
if (p->r_real) {
p->r_real = Salloc(p->r_real,
(unsigned)(strlen(p->r_real)+1));
}
}
} }
if (!(df->df_kind & D_VALUE)) { if (!(df->df_kind & D_VALUE)) {
@ -912,12 +962,14 @@ ChkBinOper(expp)
cstset(expp); cstset(expp);
} }
} }
else if ( tpl->tp_fund != T_REAL && else if ( expp->nd_left->nd_class == Value &&
expp->nd_left->nd_class == Value &&
expp->nd_right->nd_class == Value) { expp->nd_right->nd_class == Value) {
if (expp->nd_left->nd_type->tp_fund == T_INTEGER) { if (expp->nd_left->nd_type->tp_fund == T_INTEGER) {
cstibin(expp); cstibin(expp);
} }
else if (tpl->tp_fund == T_REAL) {
cstfbin(expp);
}
else cstubin(expp); else cstubin(expp);
} }
@ -967,8 +1019,11 @@ ChkUnOper(expp)
else if (tpr->tp_fund == T_REAL) { else if (tpr->tp_fund == T_REAL) {
if (right->nd_class == Value) { if (right->nd_class == Value) {
*expp = *right; *expp = *right;
if (*(expp->nd_REL) == '-') (expp->nd_REL)++; flt_umin(&(expp->nd_RVAL));
else (expp->nd_REL)--; if (expp->nd_REAL) {
free(expp->nd_REAL);
expp->nd_REAL = 0;
}
FreeNode(right); FreeNode(right);
} }
return 1; return 1;
@ -976,6 +1031,7 @@ ChkUnOper(expp)
break; break;
case NOT: case NOT:
case '~':
if (tpr == bool_type) { if (tpr == bool_type) {
if (right->nd_class == Value) { if (right->nd_class == Value) {
cstunary(expp); cstunary(expp);
@ -1026,6 +1082,10 @@ ChkStandard(expp)
MkCoercion(&(arg->nd_left), expp->nd_type); MkCoercion(&(arg->nd_left), expp->nd_type);
switch(expp->nd_type->tp_fund) { switch(expp->nd_type->tp_fund) {
case T_REAL: case T_REAL:
if (arg->nd_left->nd_class == Value) {
arg->nd_left->nd_RVAL.flt_sign = 0;
free_it = 1;
}
break; break;
case T_INTEGER: case T_INTEGER:
if (arg->nd_left->nd_class == Value) { if (arg->nd_left->nd_class == Value) {

View file

@ -127,7 +127,13 @@ CodeExpr(nd, ds, true_label, false_label)
switch(nd->nd_symb) { switch(nd->nd_symb) {
case REAL: case REAL:
C_df_dlb(++data_label); C_df_dlb(++data_label);
C_rom_fcon(nd->nd_REL, tp->tp_size); if (! nd->nd_REAL) {
static char buf[FLT_STRLEN];
flt_flt2str(&nd->nd_RVAL, buf, FLT_STRLEN);
C_rom_fcon(buf, tp->tp_size);
}
else C_rom_fcon(nd->nd_REAL, tp->tp_size);
c_lae_dlb(data_label); c_lae_dlb(data_label);
C_loi(tp->tp_size); C_loi(tp->tp_size);
break; break;

View file

@ -15,6 +15,7 @@
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
#include <assert.h> #include <assert.h>
#include <alloc.h>
#include "idf.h" #include "idf.h"
#include "type.h" #include "type.h"
@ -25,6 +26,8 @@
#include "warning.h" #include "warning.h"
#include "const.h" #include "const.h"
extern char *symbol2str();
arith full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */ arith full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */
arith max_int[MAXSIZE]; /* max_int[1] == 0x7F, max_int[2] == 0x7FFF, .. */ arith max_int[MAXSIZE]; /* max_int[1] == 0x7F, max_int[2] == 0x7FFF, .. */
arith min_int[MAXSIZE]; /* min_int[1] == 0xFFFFFF80, min_int[2] = 0xFFFF8000, arith min_int[MAXSIZE]; /* min_int[1] == 0xFFFFFF80, min_int[2] = 0xFFFF8000,
@ -266,6 +269,91 @@ cstibin(expp)
expp->nd_INT = o1; expp->nd_INT = o1;
} }
cstfbin(expp)
register t_node *expp;
{
/* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expp.
This version is for REAL expressions.
*/
register struct real *p = expp->nd_left->nd_token.tk_data.tk_real;
register flt_arith *o1 = &p->r_val;
register flt_arith *o2 = &expp->nd_right->nd_RVAL;
int compar = 0;
int cmpval = 0;
assert(expp->nd_class == Oper);
assert(expp->nd_left->nd_class == Value);
assert(expp->nd_right->nd_class == Value);
switch (expp->nd_symb) {
case '*':
flt_mul(o1, o2, o1);
break;
case '/':
flt_div(o1, o2, o1);
break;
case '+':
flt_add(o1, o2, o1);
break;
case '-':
flt_sub(o1, o2, o1);
break;
case '<':
case '>':
case LESSEQUAL:
case GREATEREQUAL:
case '=':
case '#':
compar++;
cmpval = flt_cmp(o1, o2);
switch(expp->nd_symb) {
case '<': cmpval = (cmpval < 0); break;
case '>': cmpval = (cmpval > 0); break;
case LESSEQUAL: cmpval = (cmpval <= 0); break;
case GREATEREQUAL: cmpval = (cmpval >= 0); break;
case '=': cmpval = (cmpval == 0); break;
case '#': cmpval = (cmpval != 0); break;
}
if (expp->nd_right->nd_REAL) free(expp->nd_right->nd_REAL);
free_real(expp->nd_right->nd_token.tk_data.tk_real);
break;
default:
crash("(cstfbin)");
}
switch(flt_status) {
case FLT_OVFL:
node_warning(expp, "floating point overflow on %s",
symbol2str(expp->nd_symb));
break;
case FLT_DIV0:
node_error(expp, "division by 0.0");
break;
}
if (p->r_real) {
free(p->r_real);
p->r_real = 0;
}
if (compar) {
free_real(p);
}
commonbin(expp);
if (compar) {
expp->nd_symb = INTEGER;
expp->nd_INT = cmpval;
}
else {
expp->nd_token.tk_data.tk_real = p;
}
}
cstubin(expp) cstubin(expp)
register t_node *expp; register t_node *expp;
{ {
@ -564,6 +652,7 @@ CutSize(expr)
register t_type *tp = BaseType(expr->nd_type); register t_type *tp = BaseType(expr->nd_type);
assert(expr->nd_class == Value); assert(expr->nd_class == Value);
if (tp->tp_fund == T_REAL) return;
if (tp->tp_fund != T_INTEGER) { if (tp->tp_fund != T_INTEGER) {
expr->nd_INT &= full_mask[(int)(tp->tp_size)]; expr->nd_INT &= full_mask[(int)(tp->tp_size)];
} }

View file

@ -13,6 +13,8 @@
#ifdef DEBUG #ifdef DEBUG
#define DO_DEBUG(x, y) ((x) && (y)) #define DO_DEBUG(x, y) ((x) && (y))
#define STATIC
#else #else
#define DO_DEBUG(x, y) #define DO_DEBUG(x, y)
#define STATIC static
#endif #endif

View file

@ -136,7 +136,7 @@ LexScan()
break; break;
case REAL: case REAL:
print("%s\n", tkp->TOK_REL); print("%s\n", tkp->TOK_REAL);
break; break;
case STRING: case STRING:

View file

@ -40,7 +40,8 @@ struct node {
#define nd_STR nd_token.TOK_STR #define nd_STR nd_token.TOK_STR
#define nd_SLE nd_token.TOK_SLE #define nd_SLE nd_token.TOK_SLE
#define nd_INT nd_token.TOK_INT #define nd_INT nd_token.TOK_INT
#define nd_REL nd_token.TOK_REL #define nd_REAL nd_token.TOK_REAL
#define nd_RVAL nd_token.TOK_RVAL
}; };
typedef struct node t_node; typedef struct node t_node;

19
lang/m2/comp/real.H Normal file
View file

@ -0,0 +1,19 @@
/*
* (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
*/
/* R E A L C O N S T A N T D E S C R I P T O R D E F I N I T I O N */
/* $Header$ */
#include <flt_arith.h>
struct real {
char *r_real;
flt_arith r_val;
};
/* ALLOCDEF "real" 20 */

View file

@ -820,11 +820,11 @@ intorcard(left, right)
register t_type *left, *right; register t_type *left, *right;
{ {
if (left == intorcard_type) { if (left == intorcard_type) {
if (right == int_type || right == card_type) { t_type *tmp = left;
return right; left = right;
right = tmp;
} }
} if (right == intorcard_type) {
else if (right == intorcard_type) {
if (left == int_type || left == card_type) { if (left == int_type || left == card_type) {
return left; return left;
} }