According to Kevin A. Foss:
I was trying the latest alpha and trying to get the newint/frac functions to work, however the first piece of code I tried caused gpc to dump core :(
Sorry - my fault! A patch to the latest alpha GPC which fixes this problem (and another one related to operators defined in Units) follows below.
Peter -- Peter Gerwinski, Essen, Germany, free physicist and programmer Maintainer GNU Pascal - http://home.pages.de/~GNU-Pascal/ - 1 Oct 1997 PGP key fingerprint: AC 6C 94 45 BE 28 A4 96 0E CC E9 12 47 25 82 75 Fight the SPAM! - http://maps.vix.com/
8< --------------------------------------------------------------------
Changes for gpc from gpc-980106.
Changes in files you can reconstruct with Bison, etags, makeinfo, and TeX have been omitted. Some of these files are updated just by building the compiler. You can update the rest of these files by executing this command
make TAGS info dvi -f Makefile.in
in the directory of GPC sources, provided the necessary tools (etags, makeinfo, TeX and texi2dvi) are installed.
To apply these diffs, go to the directory gpc-980106 and use the command
patch -p1
feeding it the following diffs as input. Then rename the directory to gpc.
diff -r -U3 -N -x *.o -x *.log -x *.old -x Makefile -x config.cache -x config.status -x gpc-version.c -x *parse.c -x *parse.h -x gpc-gperf.h -x TAGS -x gpc.?? -x gpc.??s -x gpc.aux -x g?c.info* -x gpc*.html -x *.dvi -x *.toc -x *.html -x INSTALL -x FPKvsGNU -x specs -x core -x version -x rts-version.c -x rts-config.h -x gpc -x gpc-cpp -x gpc1 -x libgpc.a -x config.h -x b[i,c]-* -x hconfig.h -x tconfig.h -x insn-*.[c,h] -x options.h -x specs.h -x stamp* -x tm.h -x gen* -x stage[1-4] -x include -x ?++* -x cc1 -x cccp -x cpp -x enquire -x float.h* -x gfloat.h* -x multilib.h -x lib*.a -x underscore.c -x xg?c -x xlimits.h -x site.exp -x *.bak -x *.swp -x gcc-2.7.2.2.patch -x *.aux -x *.cp -x *.cps -x *.ky -x *.kys -x *.gdt -x *.gpr -x *.gpi -x gpc-config.h -x *.orig gpc-980106/p/ChangeLog gpc/p/ChangeLog --- gpc-980106/p/ChangeLog Tue Jan 6 20:50:55 1998 +++ gpc/p/ChangeLog Mon Jan 12 14:17:50 1998 @@ -1,3 +1,14 @@ +Mon 12 Jan 1998 12:15 Peter Gerwinski peter.gerwinski@uni-essen.de + + * rts.c: rts[], build_rts_call(): case ucsd_INT, bp_FRAC: + make `int' and `frac' use Frank's RTS functions rather than + converting the argument to `Integer' and back. + +Sat 10 Jan 1998 12:15 Peter Gerwinski peter.gerwinski@uni-essen.de + + * module.c: load_tree(): case TYPE_DECL: remember the name of + the type in the *_TYPE node. + Tue 6 Jan 1998 20:00:00 Peter Gerwinski peter.gerwinski@uni-essen.de
* rts.c: rts-read(): pass correct string capacity for diff -r -U3 -N -x *.o -x *.log -x *.old -x Makefile -x config.cache -x config.status -x gpc-version.c -x *parse.c -x *parse.h -x gpc-gperf.h -x TAGS -x gpc.?? -x gpc.??s -x gpc.aux -x g?c.info* -x gpc*.html -x *.dvi -x *.toc -x *.html -x INSTALL -x FPKvsGNU -x specs -x core -x version -x rts-version.c -x rts-config.h -x gpc -x gpc-cpp -x gpc1 -x libgpc.a -x config.h -x b[i,c]-* -x hconfig.h -x tconfig.h -x insn-*.[c,h] -x options.h -x specs.h -x stamp* -x tm.h -x gen* -x stage[1-4] -x include -x ?++* -x cc1 -x cccp -x cpp -x enquire -x float.h* -x gfloat.h* -x multilib.h -x lib*.a -x underscore.c -x xg?c -x xlimits.h -x site.exp -x *.bak -x *.swp -x gcc-2.7.2.2.patch -x *.aux -x *.cp -x *.cps -x *.ky -x *.kys -x *.gdt -x *.gpr -x *.gpi -x gpc-config.h -x *.orig gpc-980106/p/module.c gpc/p/module.c --- gpc-980106/p/module.c Tue Jan 6 20:44:36 1998 +++ gpc/p/module.c Sat Jan 10 12:04:38 1998 @@ -1881,6 +1881,8 @@ #endif DECL_NAME (t) = load_tree (s, depth + 1); TREE_TYPE (t) = load_tree (s, depth + 1); + if (code == TYPE_DECL) + TYPE_NAME (TREE_TYPE (t)) = DECL_NAME (t); DECL_INITIAL (t) = load_tree (s, depth + 1); DECL_CONTEXT (t) = current_function_decl; break; diff -r -U3 -N -x *.o -x *.log -x *.old -x Makefile -x config.cache -x config.status -x gpc-version.c -x *parse.c -x *parse.h -x gpc-gperf.h -x TAGS -x gpc.?? -x gpc.??s -x gpc.aux -x g?c.info* -x gpc*.html -x *.dvi -x *.toc -x *.html -x INSTALL -x FPKvsGNU -x specs -x core -x version -x rts-version.c -x rts-config.h -x gpc -x gpc-cpp -x gpc1 -x libgpc.a -x config.h -x b[i,c]-* -x hconfig.h -x tconfig.h -x insn-*.[c,h] -x options.h -x specs.h -x stamp* -x tm.h -x gen* -x stage[1-4] -x include -x ?++* -x cc1 -x cccp -x cpp -x enquire -x float.h* -x gfloat.h* -x multilib.h -x lib*.a -x underscore.c -x xg?c -x xlimits.h -x site.exp -x *.bak -x *.swp -x gcc-2.7.2.2.patch -x *.aux -x *.cp -x *.cps -x *.ky -x *.kys -x *.gdt -x *.gpr -x *.gpi -x gpc-config.h -x *.orig gpc-980106/p/rts.c gpc/p/rts.c --- gpc-980106/p/rts.c Tue Jan 6 20:44:36 1998 +++ gpc/p/rts.c Mon Jan 12 12:08:06 1998 @@ -82,6 +82,9 @@ { pp_SIN, "sinl", NULL_RTX, NULL_TREE}, { pp_SQRT, "_pp_sqrt", NULL_RTX, NULL_TREE},
+ { ucsd_INT, "_p_int", NULL_RTX, NULL_TREE}, + { bp_FRAC, "_p_frac", NULL_RTX, NULL_TREE}, + { p_DISPOSE,"_p_dispose", NULL_RTX, NULL_TREE}, { p_EOF, "_p_eof", NULL_RTX, NULL_TREE}, { p_EOLN, "_p_eoln", NULL_RTX, NULL_TREE}, @@ -1754,67 +1757,6 @@ break; }
- case ucsd_INT: - { - /* Calculate the integer part of a real number by converting it - * to the largest possible integer type and back. - * - * If the number is too big to fit in an integer and has a - * precision not bigger than that of the integer, we know that - * it does not have a fractional part. - * - * If the number is too big to fit in an integer but has a - * precision not than that of the integer, we are hosed. - * Maybe we should do a loop then ... - * - * This code is suboptimal anyway, since at least the i386 has - * a single instruction which calculates `int'. @@@@ - */ - INLINE_RTS_LENGTH ("int", 1); - if (code == REAL_TYPE) - { - if (TYPE_PRECISION (type) <= TYPE_PRECISION (long_long_integer_type_node)) - { - tree abs_val = build_unary_op (ABS_EXPR, val, 0); - tree condition = build_binary_op (GT_EXPR, abs_val, - convert (type, TYPE_MAX_VALUE (long_long_integer_type_node)), 0); - retval = convert (type, convert (long_long_integer_type_node, val)); - retval = build (COND_EXPR, type, condition, - val, retval); - } - else - abort (); - } - else - errstr = "argument to `int' must be of real type"; - break; - } - - case bp_FRAC: - { - /* frac ( foo ) = foo - int ( foo ). - */ - INLINE_RTS_LENGTH ("frac", 1); - if (code == REAL_TYPE) - { - if (TYPE_PRECISION (type) <= TYPE_PRECISION (long_long_integer_type_node)) - { - tree abs_val = build_unary_op (ABS_EXPR, val, 0); - tree condition = build_binary_op (GT_EXPR, abs_val, - convert (type, TYPE_MAX_VALUE (long_long_integer_type_node)), 0); - retval = convert (type, convert (long_long_integer_type_node, val)); - retval = build (COND_EXPR, type, condition, - val, retval); - } - else - abort (); - retval = build_pascal_binary_op (MINUS_EXPR, val, retval); - } - else - errstr = "argument to `frac' must be of real type"; - break; - } - case p_SUCC: { /* rts_inline */ @@ -3027,6 +2969,14 @@ rval = double_type_node; fpar = ptype_double; } + break; + } + + case ucsd_INT: + case bp_FRAC: + { + rval = long_double_type_node; + fpar = ptype_long_double; break; }
-
Peter Gerwinski