options.c
options
program.g
+real.H
scope.C
scope.h
standards.h
#endif
extern char options[];
+extern int flt_status;
STATIC
SkipComment()
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);
*/
arith ubound = max_int[sizeof(arith)]
/ (base >> 1);
- np = &buf[1];
+ np = &buf[0];
while (*np == '0') np++;
tk->TOK_INT = 0;
while (*np) {
*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*/
/* $Header$ */
+#include "real.h"
+
/* Structure to store a string constant
*/
struct string {
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 */
#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;
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;
}
}
$(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
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
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
def.h: make.allocd
type.h: make.allocd
+real.h: make.allocd
node.h: make.allocd
desig.h: make.allocd
scope.c: make.allocd
$(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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
extern char *symbol2str();
extern char *sprint();
+extern arith flt2arith();
STATIC int
df_error(nd, mess, edf)
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:
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)) {
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);
}
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;
break;
case NOT:
+ case '~':
if (tpr == bool_type) {
if (right->nd_class == Value) {
cstunary(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) {
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;
#include <em_arith.h>
#include <em_label.h>
#include <assert.h>
+#include <alloc.h>
#include "idf.h"
#include "type.h"
#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,
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;
{
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)];
}
#ifdef DEBUG
#define DO_DEBUG(x, y) ((x) && (y))
+#define STATIC
#else
#define DO_DEBUG(x, y)
+#define STATIC static
#endif
break;
case REAL:
- print("%s\n", tkp->TOK_REL);
+ print("%s\n", tkp->TOK_REAL);
break;
case STRING:
#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;
--- /dev/null
+/*
+ * (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 */
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;
}
public / ack.git / commitdiff