summaryrefslogtreecommitdiff
path: root/gnu/usr.bin/perl/uts
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/usr.bin/perl/uts')
-rw-r--r--gnu/usr.bin/perl/uts/sprintf_wrap.c196
-rw-r--r--gnu/usr.bin/perl/uts/strtol_wrap.c174
2 files changed, 370 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/uts/sprintf_wrap.c b/gnu/usr.bin/perl/uts/sprintf_wrap.c
new file mode 100644
index 00000000000..e86eae084b9
--- /dev/null
+++ b/gnu/usr.bin/perl/uts/sprintf_wrap.c
@@ -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;
+}
diff --git a/gnu/usr.bin/perl/uts/strtol_wrap.c b/gnu/usr.bin/perl/uts/strtol_wrap.c
new file mode 100644
index 00000000000..24bb05542f5
--- /dev/null
+++ b/gnu/usr.bin/perl/uts/strtol_wrap.c
@@ -0,0 +1,174 @@
+/* A wrapper around strtol() and strtoul() to correct some
+ * "out of bounds" cases that don't work well on at least UTS.
+ * If a value is Larger than the max, strto[u]l should return
+ * the max value, and set errno to ERANGE
+ * The same if a value is smaller than the min value (only
+ * relevant for strtol(); not strtoul()), except the minimum
+ * value is returned (and errno == ERANGE).
+ */
+
+#include <ctype.h>
+#include <string.h>
+#include <sys/errno.h>
+#include <stdlib.h>
+
+extern int errno;
+
+#undef I32
+#undef U32
+
+#define I32 int
+#define U32 unsigned int
+
+struct base_info {
+ char *ValidChars;
+
+ char *Ulong_max_str;
+ char *Long_max_str;
+ char *Long_min_str; /* Absolute value */
+
+ int Ulong_max_str_len;
+ int Long_max_str_len;
+ int Long_min_str_len; /* Absolute value */
+
+ U32 Ulong_max;
+ I32 Long_max;
+ I32 Long_min; /* NOT Absolute value */
+};
+static struct base_info Base_info[37];
+
+static struct base_info Base_info_16 = {
+ "0123456789abcdefABCDEF",
+ "4294967295", "2147483648" /* <== ABS VAL */ , "2147483647",
+ 10, 10, 10,
+ 4294967295, 2147483647, - 2147483648,
+};
+
+static struct base_info Base_info_10 = {
+ "0123456789",
+ "4294967295", "2147483648" /* <== ABS VAL */ , "2147483647",
+ 10, 10, 10,
+ 4294967295, 2147483647, - 2147483648,
+};
+
+ /* Used eventually (if this is fully developed) to hold info
+ * for processing bases 2-36. So that we can just plug the
+ * base in as a selector for its info, we sacrifice
+ * Base_info[0] and Base_info[1] (unless they are used
+ * at some point for special information).
+ */
+
+/* This may be replaced later by something more universal */
+static void
+init_Base_info()
+{
+ if(Base_info[10].ValidChars) return;
+ Base_info[10] = Base_info_10;
+ Base_info[16] = Base_info_16;
+}
+
+unsigned int
+strtoul_wrap32(char *s, char **pEnd, int base)
+{
+ int Len;
+ int isNegated = 0;
+ char *sOrig = s;
+
+ init_Base_info();
+
+ while(*s && isspace(*s)) ++s;
+
+ if(*s == '-') {
+ ++isNegated;
+ ++s;
+ while(*s && isspace(*s)) ++s;
+ }
+ if(base == 0) {
+ if(*s == '0') {
+ if(s[1] == 'x' || s[1] == 'X') {
+ s += 2;
+ base = 16;
+ } else {
+ ++s;
+ base = 8;
+ }
+ } else if(isdigit(*s)) {
+ base = 10;
+ }
+ }
+ if(base != 10) {
+ return strtoul(sOrig, pEnd, base);
+ }
+
+ Len = strspn(s, Base_info[base].ValidChars);
+
+ if(Len > Base_info[base].Ulong_max_str_len
+ ||
+ (Len == Base_info[base].Ulong_max_str_len
+ &&
+ strncmp(Base_info[base].Ulong_max_str, s, Len) < 0)
+ ) {
+ /* In case isNegated is set - what to do?? */
+ /* Mightn't we say a negative number is ERANGE for strtoul? */
+ errno = ERANGE;
+ return Base_info[base].Ulong_max;
+ }
+
+ return strtoul(sOrig, pEnd, base);
+}
+
+int
+strtol_wrap32(char *s, char **pEnd, int base)
+{
+ int Len;
+ int isNegated = 0;
+ char *sOrig = s;
+
+ init_Base_info();
+
+ while(*s && isspace(*s)) ++s;
+
+ if(*s == '-') {
+ ++isNegated;
+ ++s;
+ while(*s && isspace(*s)) ++s;
+ }
+ if(base == 0) {
+ if(*s == '0') {
+ if(s[1] == 'x' || s[1] == 'X') {
+ s += 2;
+ base = 16;
+ } else {
+ ++s;
+ base = 8;
+ }
+ } else if(isdigit(*s)) {
+ base = 10;
+ }
+ }
+ if(base != 10) {
+ return strtol(sOrig, pEnd, base);
+ }
+
+ Len = strspn(s, Base_info[base].ValidChars);
+
+ if(Len > Base_info[base].Long_max_str_len
+ ||
+ (!isNegated && Len == Base_info[base].Long_max_str_len
+ &&
+ strncmp(Base_info[base].Long_max_str, s, Len) < 0)
+ ||
+ (isNegated && Len == Base_info[base].Long_min_str_len
+ &&
+ strncmp(Base_info[base].Long_min_str, s, Len) < 0)
+ ) {
+ /* In case isNegated is set - what to do?? */
+ /* Mightn't we say a negative number is ERANGE for strtol? */
+ errno = ERANGE;
+ return(isNegated ? Base_info[base].Long_min
+ :
+ Base_info[base].Long_min);
+ }
+
+ return strtol(sOrig, pEnd, base);
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-18 08:37:59 +0000