Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

UTS tweaks for Hal Morris.

p4raw-id: //depot/perl@11284
  • Loading branch information...
commit c89df6bff3e1d35ec00d05ede1265446fbb1d8c0 1 parent e5dd39f
jhi jhi authored
Showing with 206 additions and 4 deletions.
  1. +1 −0  MANIFEST
  2. +5 −4 hints/uts.sh
  3. +4 −0 perl.h
  4. +196 −0 uts/sprintf_wrap.c
1  MANIFEST
View
@@ -2138,6 +2138,7 @@ utils/perlcc.PL Front-end for compiler
utils/perldoc.PL A simple tool to find & display perl's documentation
utils/pl2pm.PL A pl to pm translator
utils/splain.PL Stand-alone version of diagnostics.pm
+uts/sprintf_wrap.c sprintf wrapper for UTS
uts/strtol_wrap.c strtol wrapper for UTS
vmesa/Makefile VM/ESA Makefile
vmesa/vmesa.c VM/ESA-specific C code for Perl core
9 hints/uts.sh
View
@@ -1,8 +1,8 @@
archname='s390'
-archobjs='uts/strtol_wrap.o'
-cc='cc'
+archobjs='uts/strtol_wrap.o uts/sprintf_wrap.o'
+cc='cc -Xa'
+ccflags='-XTSTRINGS=1500000 -DStrtol=strtol_wrap32 -DStrtoul=strtoul_wrap32 -DPERL_IGNORE_FPUSIG=SIGFPE -DSPRINTF_E_BUG'
cccdlflags='-pic'
-ccflags='-Xa -XTSTRINGS=1500000 -DStrtol=strtol_wrap32 -DStrtoul=strtoul_wrap32 -DPERL_IGNORE_FPUSIG=SIGFPE'
d_bincompat3='undef'
d_csh='undef'
d_lstat='define'
@@ -13,7 +13,7 @@ ld='ld'
lddlflags='-G -z text'
libperl='libperl.so'
libpth='/lib /usr/lib /usr/ccs/lib'
-libs='-lsocket -lnsl -ldl -lm'
+libs='-lsocket -lnsl -ldl -lm'
libswanted='m'
prefix='/usr/local'
toke_cflags='optimize=""'
@@ -23,6 +23,7 @@ useshrplib='define'
# Some less routine stuff:
#################################
cc -g -Xa -c -pic -O uts/strtol_wrap.c -o uts/strtol_wrap.o
+cc -g -Xa -c -pic -O uts/sprintf_wrap.c -o uts/sprintf_wrap.o
# Make POSIX a static extension.
cat <<'EOSH' > config.over
static_ext='POSIX B'
4 perl.h
View
@@ -1066,6 +1066,10 @@ int sockatmark(int);
#undef UV
#endif
+#ifdef SPRINTF_E_BUG
+# define sprintf UTS_sprintf_wrap
+#endif
+
/* Configure gets this right but the UTS compiler gets it wrong.
-- Hal Morris <hom00@utsglobal.com> */
#ifdef UTS
196 uts/sprintf_wrap.c
View
@@ -0,0 +1,196 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+#include <string.h>
+
+char *UTS_sprintf_wrap();
+char *do_efmt();
+char *do_gfmt();
+char *Fill();
+
+/* main(argc, argv)
+ * char **argv;
+ * {
+ * double d;
+ * char *Fmt, *Ret;
+ * char obuf[200];
+ *
+ * assert(argc > 2);
+ * Fmt = argv[1];
+ * d = strtod(argv[2], (char **)0);
+ *
+ * putchar('{');
+ * printf(Fmt, d);
+ * printf("}\n");
+ *
+ * Ret = UTS_sprintf_wrap(obuf, Fmt, d);
+ * assert(Ret == obuf);
+ *
+ * printf("{%s}\n", obuf);
+ * }
+ */
+
+char *
+UTS_sprintf_wrap(obuf, fmt, d,
+ a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15)
+char *obuf, *fmt;
+double d;
+{
+ int fmtlen, Width=0, Precision=6, Alt=0, Plus=0, Minus=0,
+ Zero = 0;
+ int FmtChar, BaseFmt = 0;
+ char *f = fmt, *AfterWidth = 0, *AfterPrecision = 0;
+ char *Dot;
+
+ if(*f++ != '%') {
+ return
+sprintf(obuf, fmt, d, a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15);
+ }
+ fmtlen = strlen(fmt);
+ FmtChar = fmt[fmtlen - 1];
+ switch(FmtChar) {
+ case 'f':
+ case 'F':
+ return
+sprintf(obuf, fmt, d, a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15);
+ case 'e':
+ case 'E':
+ BaseFmt = 'e';
+ goto BaseFmt_IsSet;
+ case 'g':
+ case 'G':
+ BaseFmt = 'g';
+BaseFmt_IsSet:
+ if(*f == '#') { Alt = 1; ++f; } /* Always has '.' */
+ if(*f == '+') { Plus = 1; ++f; } /* Force explicit sign */
+ if(*f == '-') { Minus = 1; ++f; } /* Left justify */
+ if(*f == '0') { Zero = 1; ++f;} /* Fill using 0s*/
+ if(Dot = strchr(f, '.')) {
+ Precision = strtol(Dot+1, &AfterPrecision, 0);
+ }
+ if(!Dot || (Dot && Dot > f)) { /* Next char=='.' => no width*/
+ Width = strtol(f, &AfterWidth, 0);
+ }
+ if(Dot) { f = AfterPrecision; }
+ else if(AfterWidth) { f = AfterWidth; }
+ if(*f != FmtChar) goto regular_sprintf;
+ /* It doesn't look like a f.p. sprintf call */
+ /* from Perl_sv_vcatpvfn */
+
+ if(BaseFmt == 'e') {
+ return do_efmt(d, obuf, Width, Precision, Alt,
+ Plus, Minus, Zero, FmtChar == 'E');
+ } else {
+ return do_gfmt(d, obuf, Width, Precision, Alt,
+ Plus, Minus, Zero, FmtChar == 'G');
+ }
+ default:
+regular_sprintf:
+ return
+sprintf(obuf, fmt, d, a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15);
+ }
+}
+
+char *
+do_efmt(d, obuf, Width, Precision, Alt, Plus, Minus, Zero, UpperCase)
+char *obuf;
+double d;
+{
+ char *Ecvt;
+ char *ob;
+ int decpt, sign, E;
+ int len;
+ int AllZeroes = 0;
+
+ Ecvt = ecvt( d , Precision+1, &decpt, &sign);
+
+ /* fprintf(stderr, "decpt=%d, sign=%d\n", decpt, sign); */
+
+ len = strlen(Ecvt);
+ if(strspn(Ecvt, "0") == len) AllZeroes = 1;
+
+ ob = obuf;
+ if(sign) *ob++ = '-';
+ else if(Plus) *ob++ = '+';
+
+ *ob++ = Ecvt[0];
+
+ if(Precision > 0 || Alt) *ob++ = '.';
+ strcpy(ob, &Ecvt[1]);
+
+ ob += strlen(ob); /* ADVANCE TO END OF WHAT WE JUST ADDED */
+ *ob++ = UpperCase ? 'E' : 'e';
+
+ if(AllZeroes) E = 0;
+ else E = decpt - 1;
+
+ if(E < 0) { *ob++ = '-'; E = -E; }
+ else { *ob++ = '+'; }
+
+ sprintf(ob, "%.2d", E); /* Too much horsepower used here */
+
+ if(Width > strlen(obuf)) return Fill(obuf, Width, Minus, Zero);
+ else return obuf;
+}
+
+char *
+do_gfmt(d, obuf, Width, Precision, Alt, Plus, Minus, Zero, UpperCase)
+char *obuf;
+double d;
+{
+ char *Ecvt = gcvt(d, Precision ? Precision : 1, obuf);
+ int len = strlen(obuf);
+
+ /* gcvt fails (maybe give a warning? For now return empty string): */
+ if(!Ecvt) { *obuf = '\0'; return obuf; }
+
+ /* printf("Ecvt='%s'\n", Ecvt); */
+ if(Plus && (Ecvt[0] != '-')) {
+ memmove(obuf+1, obuf, len+1); /* "+1" to get '\0' at end */
+ obuf[0] = '+';
+ ++len;
+ }
+ if(Alt && !strchr(Ecvt, '.')) {
+ int LenUpTo_E = strcspn(obuf, "eE");
+ int E_etc_len = strlen(&obuf[LenUpTo_E]);
+ /* ABOVE: Will be 0 if there's no E/e because */
+ /* strcspn will return length of whole string */
+
+ if(E_etc_len)
+ memmove(obuf+LenUpTo_E+1, obuf+LenUpTo_E, E_etc_len);
+ obuf[LenUpTo_E] = '.';
+ obuf[LenUpTo_E + 1 + E_etc_len ] = '\0';
+ }
+ { char *E_loc;
+ if(UpperCase && (E_loc = strchr(obuf, 'e'))) { *E_loc = 'E'; }
+ }
+ if(Width > len)
+ return Fill(obuf, Width, Minus, Zero);
+ else
+ return obuf;
+}
+
+char *
+Fill(obuf, Width, LeftJustify, Zero)
+char *obuf;
+{
+ int W = strlen(obuf);
+ int diff = Width - W;
+ /* LeftJustify means there was a '-' flag, and in that case, */
+ /* printf man page (UTS4.4) says ignore '0' */
+ char FillChar = (Zero && !LeftJustify) ? '0' : ' ';
+ int i;
+ int LeftFill = ! LeftJustify;
+
+ if(Width <= W) return obuf;
+
+ if(LeftFill) {
+ memmove(obuf+diff, obuf, W+1); /* "+1" to get '\0' at end */
+ for(i=0 ; i < diff ; ++i) { obuf[i] = FillChar; }
+ } else {
+ for(i=W ; i < Width ; ++i)
+ obuf[i] = FillChar;
+ obuf[Width] = '\0';
+ }
+ return obuf;
+}
Please sign in to comment.
Something went wrong with that request. Please try again.