d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Added support for constant floating point expressions

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

1
lang/m2/comp/.distr
View file

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

15
lang/m2/comp/LLlex.c
View file

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

7
lang/m2/comp/LLlex.h
View file

@ -9,6 +9,8 @@
/* $Header$ */
#include "real.h"
/* Structure to store a string constant
*/
struct string {
@ -25,7 +27,7 @@ struct token {
struct idf *tk_idf; /* IDENT */
struct string *tk_str; /* STRING */
arith tk_int; /* INTEGER */
char *tk_real; /* REAL */
struct real *tk_real; /* REAL */
arith *tk_set; /* 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 */
@ -38,7 +40,8 @@ typedef struct token t_token;
#define TOK_STR tk_data.tk_str->s_str
#define TOK_SLE tk_data.tk_str->s_length
#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 struct type *toktype;

4
lang/m2/comp/LLmessage.c
View file

@ -55,7 +55,9 @@ LLmessage(tk)
dotp->TOK_INT = 1;
break;
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;
}
}

38
lang/m2/comp/Makefile
View file

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

76
lang/m2/comp/chk_expr.c
View file

@ -37,6 +37,7 @@
extern char *symbol2str();
extern char *sprint();
extern arith flt2arith();
STATIC int
df_error(nd, mess, edf)
@ -78,14 +79,53 @@ MkCoercion(pnd, tp)
register t_type *nd_tp = nd->nd_type;
extern int pass_1;
char *wmess = 0;
arith op;
if (nd_tp == tp || nd_tp->tp_fund == T_STRING /* Why ??? */) return;
nd_tp = BaseType(nd_tp);
if (nd->nd_class == Value &&
nd_tp->tp_fund != T_REAL &&
tp->tp_fund != T_REAL) {
/* Constant expression not involving REALs */
if (nd->nd_class == Value) {
if (nd_tp->tp_fund == T_REAL) {
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_ENUMERATION:
case T_CHAR:
@ -330,6 +370,16 @@ ChkExLinkOrName(expp)
expp->nd_class = Def;
}
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)) {
@ -912,12 +962,14 @@ ChkBinOper(expp)
cstset(expp);
}
}
else if ( tpl->tp_fund != T_REAL &&
expp->nd_left->nd_class == Value &&
else if ( expp->nd_left->nd_class == Value &&
expp->nd_right->nd_class == Value) {
if (expp->nd_left->nd_type->tp_fund == T_INTEGER) {
cstibin(expp);
}
else if (tpl->tp_fund == T_REAL) {
cstfbin(expp);
}
else cstubin(expp);
}
@ -967,8 +1019,11 @@ ChkUnOper(expp)
else if (tpr->tp_fund == T_REAL) {
if (right->nd_class == Value) {
*expp = *right;
if (*(expp->nd_REL) == '-') (expp->nd_REL)++;
else (expp->nd_REL)--;
flt_umin(&(expp->nd_RVAL));
if (expp->nd_REAL) {
free(expp->nd_REAL);
expp->nd_REAL = 0;
}
FreeNode(right);
}
return 1;
@ -976,6 +1031,7 @@ ChkUnOper(expp)
break;
case NOT:
case '~':
if (tpr == bool_type) {
if (right->nd_class == Value) {
cstunary(expp);
@ -1026,6 +1082,10 @@ ChkStandard(expp)
MkCoercion(&(arg->nd_left), expp->nd_type);
switch(expp->nd_type->tp_fund) {
case T_REAL:
if (arg->nd_left->nd_class == Value) {
arg->nd_left->nd_RVAL.flt_sign = 0;
free_it = 1;
}
break;
case T_INTEGER:
if (arg->nd_left->nd_class == Value) {

8
lang/m2/comp/code.c
View file

@ -127,7 +127,13 @@ CodeExpr(nd, ds, true_label, false_label)
switch(nd->nd_symb) {
case REAL:
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_loi(tp->tp_size);
break;

89
lang/m2/comp/cstoper.c
View file

@ -15,6 +15,7 @@
#include <em_arith.h>
#include <em_label.h>
#include <assert.h>
#include <alloc.h>
#include "idf.h"
#include "type.h"
@ -25,6 +26,8 @@
#include "warning.h"
#include "const.h"
extern char *symbol2str();
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 min_int[MAXSIZE]; /* min_int[1] == 0xFFFFFF80, min_int[2] = 0xFFFF8000,
@ -266,6 +269,91 @@ cstibin(expp)
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)
register t_node *expp;
{
@ -564,6 +652,7 @@ CutSize(expr)
register t_type *tp = BaseType(expr->nd_type);
assert(expr->nd_class == Value);
if (tp->tp_fund == T_REAL) return;
if (tp->tp_fund != T_INTEGER) {
expr->nd_INT &= full_mask[(int)(tp->tp_size)];
}

2
lang/m2/comp/debug.h
View file

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

2
lang/m2/comp/main.c
View file

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

3
lang/m2/comp/node.H
View file

@ -40,7 +40,8 @@ struct node {
#define nd_STR nd_token.TOK_STR
#define nd_SLE nd_token.TOK_SLE
#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;

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 */

8
lang/m2/comp/type.c
View file

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