2 static char *RCSid() { return RCSid("$Id: internal.c,v 1.40.2.4 2008/09/25 19:50:57 sfeam Exp $"); }
5 /* GNUPLOT - internal.c */
8 * Copyright 1986 - 1993, 1998, 2004 Thomas Williams, Colin Kelley
10 * Permission to use, copy, and distribute this software and its
11 * documentation for any purpose with or without fee is hereby granted,
12 * provided that the above copyright notice appear in all copies and
13 * that both that copyright notice and this permission notice appear
14 * in supporting documentation.
16 * Permission to modify the software is granted, but not the right to
17 * distribute the complete modified source code. Modifications are to
18 * be distributed as patches to the released version. Permission to
19 * distribute binaries produced by compiling modified sources is granted,
21 * 1. distribute the corresponding source modifications from the
22 * released version in the form of a patch file along with the binaries,
23 * 2. add special version identification to distinguish your version
24 * in addition to the base release version number,
25 * 3. provide your name and address as the primary contact for the
26 * support of your modified version, and
27 * 4. retain our contact information in regard to use of the base
29 * Permission to distribute the released version of the source code along
30 * with corresponding source modifications in the form of a patch file is
31 * granted with same provisions 2 through 4 for binary distributions.
33 * This software is provided "as is" without express or implied warranty
34 * to the extent permitted by applicable law.
42 #include "util.h" /* for int_error() */
44 # include "gp_time.h" /* for str(p|f)time */
46 #include "command.h" /* for do_system_func */
51 * Excerpt from the Solaris man page for matherr():
53 * The The System V Interface Definition, Third Edition (SVID3)
54 * specifies that certain libm functions call matherr() when
55 * exceptions are detected. Users may define their own mechan-
56 * isms for handling exceptions, by including a function named
57 * matherr() in their programs.
61 static enum DATA_TYPES sprintf_specifier __PROTO((const char *format));
66 GP_MATHERR( STRUCT_EXCEPTION_P_X )
68 #if (defined(ATARI) || defined(MTOS)) && defined(__PUREC__)
75 c = "argument singularity";
81 c = "underflow range";
84 c = "(unknown error)";
88 math exception : %s\n\
101 return (undefined = TRUE); /* don't print error message */
105 #define BAD_DEFAULT default: int_error(NO_CARET, "internal error : type neither INT or CMPLX"); return;
108 f_push(union argument *x)
110 struct udvt_entry *udv;
113 if (udv->udv_undef) { /* undefined */
114 int_error(NO_CARET, "undefined variable: %s", udv->udv_name);
116 push(&(udv->udv_value));
120 f_pushc(union argument *x)
127 f_pushd1(union argument *x)
129 push(&(x->udf_arg->dummy_values[0]));
134 f_pushd2(union argument *x)
136 push(&(x->udf_arg->dummy_values[1]));
141 f_pushd(union argument *x)
145 push(&(x->udf_arg->dummy_values[param.v.int_val]));
151 f_call(union argument *x)
153 struct udft_entry *udf;
154 struct value save_dummy;
157 if (!udf->at) { /* undefined */
158 int_error(NO_CARET, "undefined function: %s", udf->udf_name);
160 save_dummy = udf->dummy_values[0];
161 (void) pop(&(udf->dummy_values[0]));
163 if (udf->dummy_num != 1)
164 int_error(NO_CARET, "function %s requires %d variables", udf->udf_name, udf->dummy_num);
167 gpfree_string(&udf->dummy_values[0]);
168 udf->dummy_values[0] = save_dummy;
172 /* execute a udf of n variables */
174 f_calln(union argument *x)
176 struct udft_entry *udf;
177 struct value save_dummy[MAX_NUM_VAR];
181 struct value num_params;
184 if (!udf->at) /* undefined */
185 int_error(NO_CARET, "undefined function: %s", udf->udf_name);
186 for (i = 0; i < MAX_NUM_VAR; i++)
187 save_dummy[i] = udf->dummy_values[i];
189 (void) pop(&num_params);
191 if (num_params.v.int_val != udf->dummy_num)
192 int_error(NO_CARET, "function %s requires %d variable%c",
193 udf->udf_name, udf->dummy_num, (udf->dummy_num == 1)?'\0':'s');
195 /* if there are more parameters than the function is expecting */
196 /* simply ignore the excess */
197 if (num_params.v.int_val > MAX_NUM_VAR) {
198 /* pop and discard the dummies that there is no room for */
199 num_pop = num_params.v.int_val - MAX_NUM_VAR;
200 for (i = 0; i < num_pop; i++)
201 (void) pop(&(udf->dummy_values[0]));
203 num_pop = MAX_NUM_VAR;
205 num_pop = num_params.v.int_val;
208 /* pop parameters we can use */
209 for (i = num_pop - 1; i >= 0; i--)
210 (void) pop(&(udf->dummy_values[i]));
213 for (i = 0; i < MAX_NUM_VAR; i++) {
214 gpfree_string(&udf->dummy_values[i]);
215 udf->dummy_values[i] = save_dummy[i];
221 f_lnot(union argument *arg)
225 (void) arg; /* avoid -Wunused warning */
227 push(Ginteger(&a, !a.v.int_val));
232 f_bnot(union argument *arg)
236 (void) arg; /* avoid -Wunused warning */
238 push(Ginteger(&a, ~a.v.int_val));
243 f_lor(union argument *arg)
247 (void) arg; /* avoid -Wunused warning */
250 push(Ginteger(&a, a.v.int_val || b.v.int_val));
254 f_land(union argument *arg)
258 (void) arg; /* avoid -Wunused warning */
261 push(Ginteger(&a, a.v.int_val && b.v.int_val));
266 f_bor(union argument *arg)
270 (void) arg; /* avoid -Wunused warning */
273 push(Ginteger(&a, a.v.int_val | b.v.int_val));
278 f_xor(union argument *arg)
282 (void) arg; /* avoid -Wunused warning */
285 push(Ginteger(&a, a.v.int_val ^ b.v.int_val));
290 f_band(union argument *arg)
294 (void) arg; /* avoid -Wunused warning */
297 push(Ginteger(&a, a.v.int_val & b.v.int_val));
301 #if (GP_STRING_VARS > 1)
303 * Make all the following internal routines perform autoconversion
304 * from string to numeric value.
306 #define pop(x) pop_or_convert_from_string(x)
310 f_uminus(union argument *arg)
314 (void) arg; /* avoid -Wunused warning */
318 a.v.int_val = -a.v.int_val;
333 f_eq(union argument *arg)
335 /* note: floating point equality is rare because of roundoff error! */
339 (void) arg; /* avoid -Wunused warning */
347 result = (a.v.int_val ==
351 result = (a.v.int_val ==
352 b.v.cmplx_val.real &&
353 b.v.cmplx_val.imag == 0.0);
361 result = (b.v.int_val == a.v.cmplx_val.real &&
362 a.v.cmplx_val.imag == 0.0);
365 result = (a.v.cmplx_val.real ==
366 b.v.cmplx_val.real &&
367 a.v.cmplx_val.imag ==
375 push(Ginteger(&a, result));
380 f_ne(union argument *arg)
385 (void) arg; /* avoid -Wunused warning */
392 result = (a.v.int_val !=
396 result = (a.v.int_val !=
397 b.v.cmplx_val.real ||
398 b.v.cmplx_val.imag != 0.0);
406 result = (b.v.int_val !=
407 a.v.cmplx_val.real ||
408 a.v.cmplx_val.imag != 0.0);
411 result = (a.v.cmplx_val.real !=
412 b.v.cmplx_val.real ||
413 a.v.cmplx_val.imag !=
421 push(Ginteger(&a, result));
426 f_gt(union argument *arg)
431 (void) arg; /* avoid -Wunused warning */
438 result = (a.v.int_val >
442 result = (a.v.int_val >
451 result = (a.v.cmplx_val.real >
455 result = (a.v.cmplx_val.real >
463 push(Ginteger(&a, result));
468 f_lt(union argument *arg)
473 (void) arg; /* avoid -Wunused warning */
480 result = (a.v.int_val <
484 result = (a.v.int_val <
493 result = (a.v.cmplx_val.real <
497 result = (a.v.cmplx_val.real <
505 push(Ginteger(&a, result));
510 f_ge(union argument *arg)
515 (void) arg; /* avoid -Wunused warning */
522 result = (a.v.int_val >=
526 result = (a.v.int_val >=
535 result = (a.v.cmplx_val.real >=
539 result = (a.v.cmplx_val.real >=
547 push(Ginteger(&a, result));
552 f_le(union argument *arg)
557 (void) arg; /* avoid -Wunused warning */
564 result = (a.v.int_val <=
568 result = (a.v.int_val <=
577 result = (a.v.cmplx_val.real <=
581 result = (a.v.cmplx_val.real <=
589 push(Ginteger(&a, result));
594 f_plus(union argument *arg)
596 struct value a, b, result;
598 (void) arg; /* avoid -Wunused warning */
605 (void) Ginteger(&result, a.v.int_val +
609 (void) Gcomplex(&result, a.v.int_val +
619 (void) Gcomplex(&result, b.v.int_val +
624 (void) Gcomplex(&result, a.v.cmplx_val.real +
639 f_minus(union argument *arg)
641 struct value a, b, result;
643 (void) arg; /* avoid -Wunused warning */
645 (void) pop(&a); /* now do a - b */
650 (void) Ginteger(&result, a.v.int_val -
654 (void) Gcomplex(&result, a.v.int_val -
656 -b.v.cmplx_val.imag);
664 (void) Gcomplex(&result, a.v.cmplx_val.real -
669 (void) Gcomplex(&result, a.v.cmplx_val.real -
684 f_mult(union argument *arg)
686 struct value a, b, result;
688 (void) arg; /* avoid -Wunused warning */
690 (void) pop(&a); /* now do a*b */
696 (void) Ginteger(&result, a.v.int_val *
700 (void) Gcomplex(&result, a.v.int_val *
711 (void) Gcomplex(&result, b.v.int_val *
717 (void) Gcomplex(&result, a.v.cmplx_val.real *
736 f_div(union argument *arg)
738 struct value a, b, result;
741 (void) arg; /* avoid -Wunused warning */
743 (void) pop(&a); /* now do a/b */
750 (void) Ginteger(&result, a.v.int_val /
753 (void) Ginteger(&result, 0);
758 square = b.v.cmplx_val.real *
763 (void) Gcomplex(&result, a.v.int_val *
764 b.v.cmplx_val.real / square,
766 b.v.cmplx_val.imag / square);
768 (void) Gcomplex(&result, 0.0, 0.0);
779 (void) Gcomplex(&result, a.v.cmplx_val.real /
784 (void) Gcomplex(&result, 0.0, 0.0);
789 square = b.v.cmplx_val.real *
794 (void) Gcomplex(&result, (a.v.cmplx_val.real *
797 b.v.cmplx_val.imag) / square,
798 (a.v.cmplx_val.imag *
801 b.v.cmplx_val.imag) /
804 (void) Gcomplex(&result, 0.0, 0.0);
818 f_mod(union argument *arg)
822 (void) arg; /* avoid -Wunused warning */
824 (void) pop(&a); /* now do a%b */
826 if (a.type != INTGR || b.type != INTGR)
827 int_error(NO_CARET, "can only mod ints");
829 push(Ginteger(&a, a.v.int_val % b.v.int_val));
831 push(Ginteger(&a, 0));
838 f_power(union argument *arg)
840 struct value a, b, result;
844 (void) arg; /* avoid -Wunused warning */
846 (void) pop(&a); /* now find a**b */
852 count = abs(b.v.int_val);
854 /* this ought to use bit-masks and squares, etc */
855 for (i = 0; i < count; i++)
857 if (b.v.int_val >= 0)
858 (void) Ginteger(&result, t);
860 (void) Gcomplex(&result, 1.0 / t, 0.0);
863 (void) Gcomplex(&result, 0.0, 0.0);
867 if (a.v.int_val == 0) {
868 if (b.v.cmplx_val.imag != 0 || b.v.cmplx_val.real < 0) {
871 /* return 1.0 for 0**0 */
872 Gcomplex(&result, b.v.cmplx_val.real == 0 ? 1.0 : 0.0, 0.0);
875 pow(magnitude(&a), fabs(b.v.cmplx_val.real));
876 if (b.v.cmplx_val.real < 0.0) {
882 mag *= gp_exp(-b.v.cmplx_val.imag * angle(&a));
883 ang = b.v.cmplx_val.real * angle(&a) +
884 b.v.cmplx_val.imag * log(magnitude(&a));
885 (void) Gcomplex(&result, mag * cos(ang),
895 if (a.v.cmplx_val.imag == 0.0) {
896 mag = pow(a.v.cmplx_val.real, (double) abs(b.v.int_val));
897 if (b.v.int_val < 0) {
903 (void) Gcomplex(&result, mag, 0.0);
905 /* not so good, but...! */
906 mag = pow(magnitude(&a), (double) abs(b.v.int_val));
907 if (b.v.int_val < 0) {
913 ang = angle(&a) * b.v.int_val;
914 (void) Gcomplex(&result, mag * cos(ang),
919 if (a.v.cmplx_val.real == 0 && a.v.cmplx_val.imag == 0) {
920 if (b.v.cmplx_val.imag != 0 || b.v.cmplx_val.real < 0) {
923 /* return 1.0 for 0**0 */
924 Gcomplex(&result, b.v.cmplx_val.real == 0 ? 1.0 : 0.0, 0.0);
926 mag = pow(magnitude(&a), fabs(b.v.cmplx_val.real));
927 if (b.v.cmplx_val.real < 0.0) {
933 mag *= gp_exp(-b.v.cmplx_val.imag * angle(&a));
934 ang = b.v.cmplx_val.real * angle(&a) +
935 b.v.cmplx_val.imag * log(magnitude(&a));
936 (void) Gcomplex(&result, mag * cos(ang),
950 f_factorial(union argument *arg)
956 (void) arg; /* avoid -Wunused warning */
957 (void) pop(&a); /* find a! (factorial) */
962 for (i = a.v.int_val; i > 1; i--) /*fpe's should catch overflows */
966 int_error(NO_CARET, "factorial (!) argument must be an integer");
967 return; /* avoid gcc -Wall warning about val */
970 push(Gcomplex(&a, val, 0.0));
974 #ifdef GP_STRING_VARS
976 * Terminate the autoconversion from string to numeric values
981 f_concatenate(union argument *arg)
983 struct value a, b, result;
985 (void) arg; /* avoid -Wunused warning */
989 if (b.type == INTGR) {
992 b.v.string_val = (char *)gp_alloc(32,"str_const");
994 snprintf(b.v.string_val,32,"%d",i);
996 sprintf(b.v.string_val,"%d",i);
1000 if (a.type != STRING || b.type != STRING)
1001 int_error(NO_CARET, "internal error : STRING operator applied to non-STRING type");
1003 (void) Gstring(&result, gp_stradd(a.v.string_val, b.v.string_val));
1007 gpfree_string(&result); /* free string allocated within gp_stradd() */
1011 f_eqs(union argument *arg)
1013 struct value a, b, result;
1015 (void) arg; /* avoid -Wunused warning */
1019 if(a.type != STRING || b.type != STRING)
1020 int_error(NO_CARET, "internal error : STRING operator applied to non-STRING type");
1022 (void) Ginteger(&result, !strcmp(a.v.string_val, b.v.string_val));
1029 f_nes(union argument *arg)
1031 struct value a, b, result;
1033 (void) arg; /* avoid -Wunused warning */
1037 if(a.type != STRING || b.type != STRING)
1038 int_error(NO_CARET, "internal error : STRING operator applied to non-STRING type");
1040 (void) Ginteger(&result, (int)(strcmp(a.v.string_val, b.v.string_val)!=0));
1047 f_strlen(union argument *arg)
1049 struct value a, result;
1054 if (a.type != STRING)
1055 int_error(NO_CARET, "internal error : strlen of non-STRING argument");
1057 (void) Ginteger(&result, (int)strlen(a.v.string_val));
1063 f_strstrt(union argument *arg)
1065 struct value needle, haystack, result;
1069 (void) pop(&needle);
1070 (void) pop(&haystack);
1072 if (needle.type != STRING || haystack.type != STRING)
1073 int_error(NO_CARET, "internal error : non-STRING argument to strstrt");
1075 start = strstr(haystack.v.string_val, needle.v.string_val);
1076 (void) Ginteger(&result, (int)(start ? (start-haystack.v.string_val)+1 : 0));
1077 gpfree_string(&needle);
1078 gpfree_string(&haystack);
1083 f_range(union argument *arg)
1085 struct value beg, end, full;
1086 struct value substr = {0};
1088 (void) arg; /* avoid -Wunused warning */
1093 if (end.type != INTGR || beg.type != INTGR)
1094 int_error(NO_CARET, "internal error: substring range specifiers must have integer values");
1096 if (full.type != STRING)
1097 int_error(NO_CARET, "internal error: substring range operator applied to non-STRING type");
1099 FPRINTF((stderr,"f_range( \"%s\", %d, %d)\n", full.v.string_val, beg.v.int_val, end.v.int_val));
1101 if (end.v.int_val > strlen(full.v.string_val))
1102 end.v.int_val = strlen(full.v.string_val);
1103 if (beg.v.int_val < 1)
1105 if (beg.v.int_val > end.v.int_val)
1106 beg.v.int_val = strlen(full.v.string_val)+1;
1108 full.v.string_val[end.v.int_val] = '\0';
1109 push(Gstring(&substr, &full.v.string_val[beg.v.int_val-1]));
1110 gpfree_string(&full);
1114 f_words(union argument *arg)
1116 struct value a, b, result;
1122 if (pop(&b)->type != INTGR)
1123 int_error(NO_CARET, "internal error : non-INTGR argument");
1124 ntarget = b.v.int_val;
1126 if (pop(&a)->type != STRING)
1127 int_error(NO_CARET, "internal error : non-STRING argument");
1130 Gstring(&result, "");
1132 while (isspace(*s)) s++;
1136 if (nwords == ntarget) { /* Found the one we wanted */
1138 s = result.v.string_val;
1140 while (*s && !isspace(*s)) s++;
1141 if (nwords == ntarget) { /* Terminate this word cleanly */
1148 /* words(s) = word(s,-1) = # of words in string */
1149 Ginteger(&result, nwords);
1155 /* EAM July 2004 (revised to dynamic buffer July 2005)
1156 * There are probably an infinite number of things that can
1157 * go wrong if the user mis-matches arguments and format strings
1158 * in the call to sprintf, but I hope none will do worse than
1159 * result in a garbage output string.
1162 f_sprintf(union argument *arg)
1164 struct value a[10], *args;
1165 struct value num_params;
1166 struct value result;
1169 char *next_start, *outpos, tempchar;
1175 enum DATA_TYPES spec_type;
1177 /* Retrieve number of parameters from top of stack */
1179 nargs = num_params.v.int_val;
1180 if (nargs > 10) { /* Fall back to slow but sure allocation */
1181 args = gp_alloc(sizeof(struct value)*nargs, "sprintf args");
1185 for (i=0; i<nargs; i++)
1186 pop(&args[i]); /* pop next argument */
1188 /* Make sure we got a format string of some sort */
1189 if (args[nargs-1].type != STRING)
1190 int_error(NO_CARET,"First parameter to sprintf must be a format string");
1192 /* Allocate space for the output string. If this isn't */
1193 /* long enough we can reallocate a larger space later. */
1194 bufsize = 80 + strlen(args[nargs-1].v.string_val);
1195 buffer = gp_alloc(bufsize, "f_sprintf");
1197 /* Copy leading fragment of format into output buffer */
1199 next_start = args[nargs-1].v.string_val;
1200 next_length = strcspn(next_start,"%");
1201 strncpy(outpos, next_start, next_length);
1203 next_start += next_length;
1204 outpos += next_length;
1206 /* Format the remaining sprintf() parameters one by one */
1207 prev_start = next_start;
1208 prev_pos = next_length;
1209 remaining = nargs - 1;
1211 /* Each time we start this loop we are pointing to a % character */
1212 while (remaining-->0 && next_start[0] && next_start[1]) {
1213 struct value *next_param = &args[remaining];
1215 /* Check for %%; print as literal and don't consume a parameter */
1216 if (!strncmp(next_start,"%%",2)) {
1219 *outpos++ = *next_start++;
1220 } while(*next_start && *next_start != '%');
1225 next_length = strcspn(next_start+1,"%") + 1;
1226 tempchar = next_start[next_length];
1227 next_start[next_length] = '\0';
1229 spec_type = sprintf_specifier(next_start);
1231 /* string value <-> numerical value check */
1232 if ( spec_type == STRING && next_param->type != STRING )
1233 int_error(NO_CARET,"f_sprintf: attempt to print numeric value with string format");
1234 if ( spec_type != STRING && next_param->type == STRING )
1235 int_error(NO_CARET,"f_sprintf: attempt to print string value with numeric format");
1237 #ifdef HAVE_SNPRINTF
1238 /* Use the format to print next arg */
1241 snprintf(outpos,bufsize-(outpos-buffer),
1242 next_start, (int)real(next_param));
1245 snprintf(outpos,bufsize-(outpos-buffer),
1246 next_start, real(next_param));
1249 snprintf(outpos,bufsize-(outpos-buffer),
1250 next_start, next_param->v.string_val);
1253 int_error(NO_CARET,"internal error: invalid spec_type");
1256 /* FIXME - this is bad; we should dummy up an snprintf equivalent */
1259 sprintf(outpos, next_start, (int)real(next_param));
1262 sprintf(outpos, next_start, real(next_param));
1265 sprintf(outpos, next_start, next_param->v.string_val);
1268 int_error(NO_CARET,"internal error: invalid spec_type");
1272 next_start[next_length] = tempchar;
1273 next_start += next_length;
1274 outpos = &buffer[strlen(buffer)];
1276 /* Check whether previous parameter output hit the end of the buffer */
1277 /* If so, reallocate a larger buffer, go back and try it again. */
1278 if (strlen(buffer) >= bufsize-2) {
1280 buffer = gp_realloc(buffer, bufsize, "f_sprintf");
1281 next_start = prev_start;
1282 outpos = buffer + prev_pos;
1286 prev_start = next_start;
1287 prev_pos = outpos - buffer;
1292 /* Copy the trailing portion of the format, if any */
1293 /* We could just call snprintf(), but it doesn't check for */
1294 /* whether there really are more variables to handle. */
1295 i = bufsize - (outpos-buffer);
1296 while (*next_start && --i > 0) {
1297 if (*next_start == '%' && *(next_start+1) == '%')
1299 *outpos++ = *next_start++;
1303 FPRINTF((stderr," snprintf result = \"%s\"\n",buffer));
1304 push(Gstring(&result, buffer));
1307 /* Free any strings from parameters we have now used */
1308 for (i=0; i<nargs; i++)
1309 gpfree_string(&args[i]);
1315 /* EAM July 2004 - Gnuplot's own string formatting conventions.
1316 * Currently this routine assumes base 10 representation, because
1317 * it is not clear where it could be specified to be anything else.
1320 f_gprintf(union argument *arg)
1322 struct value fmt, val, result;
1327 /* Retrieve parameters from top of stack */
1332 fprintf(stderr,"----------\nGot gprintf parameters\nfmt: ");
1333 disp_value(stderr, &fmt, TRUE);
1334 fprintf(stderr,"\nval: ");
1335 disp_value(stderr, &val, TRUE);
1336 fprintf(stderr,"\n----------\n");
1339 /* Make sure parameters are of the correct type */
1340 if (fmt.type != STRING)
1341 int_error(NO_CARET,"First parameter to gprintf must be a format string");
1343 /* EAM FIXME - I have no idea where we would learn another base is wanted */
1346 /* Make sure we have at least as much space in the output as the format itself */
1347 length = 80 + strlen(fmt.v.string_val);
1348 buffer = gp_alloc(length, "f_gprintf");
1350 /* Call the old internal routine */
1351 gprintf(buffer, length, fmt.v.string_val, base, real(&val));
1353 FPRINTF((stderr," gprintf result = \"%s\"\n",buffer));
1354 push(Gstring(&result, buffer));
1356 gpfree_string(&fmt);
1361 /* Output time given in seconds from year 2000 into string */
1363 f_strftime(union argument *arg)
1365 struct value fmt, val;
1366 char *fmtstr, *buffer;
1367 int fmtlen, buflen, length;
1369 (void) arg; /* Avoid compiler warnings */
1371 /* Retrieve parameters from top of stack */
1374 if ( fmt.type != STRING )
1376 "First parameter to strftime must be a format string");
1378 /* Prepare format string.
1379 * Make sure the resulting string not empty by adding a space.
1380 * Otherwise, the return value of gstrftime doesn't give enough
1383 fmtlen = strlen(fmt.v.string_val) + 1;
1384 fmtstr = gp_alloc(fmtlen + 1, "f_strftime: fmt");
1385 strncpy(fmtstr, fmt.v.string_val, fmtlen);
1386 strncat(fmtstr, " ", fmtlen);
1387 buflen = 80 + 2*fmtlen;
1388 buffer = gp_alloc(buflen, "f_strftime: buffer");
1391 length = gstrftime(buffer, buflen, fmtstr, real(&val));
1392 if (length == 0 || length >= buflen)
1393 int_error(NO_CARET, "Resulting string is too long");
1395 /* Remove trailing space */
1396 assert(buffer[length-1] == ' ');
1397 buffer[length-1] = NUL;
1399 gpfree_string(&val);
1400 gpfree_string(&fmt);
1403 push(Gstring(&val, buffer));
1407 /* Convert string into seconds from year 2000 */
1409 f_strptime(union argument *arg)
1411 struct value fmt, val;
1415 (void) arg; /* Avoid compiler warnings */
1420 if ( fmt.type != STRING || val.type != STRING )
1422 "Both parameters to strptime must be strings");
1423 if ( !fmt.v.string_val || !val.v.string_val )
1424 int_error(NO_CARET, "Internal error: string not allocated");
1427 /* string -> time_tm */
1428 gstrptime(val.v.string_val, fmt.v.string_val, &time_tm);
1430 /* time_tm -> result */
1431 result = gtimegm(&time_tm);
1432 FPRINTF((stderr," strptime result = %g seconds \n", result));
1434 gpfree_string(&val);
1435 gpfree_string(&fmt);
1436 push(Gcomplex(&val, result, 0.0));
1440 /* Return which argument type sprintf will need for this format string:
1444 * Should call int_err for any other type.
1445 * format is expected to start with '%'
1447 static enum DATA_TYPES
1448 sprintf_specifier(const char* format)
1450 const char string_spec[] = "s";
1451 const char real_spec[] = "aAeEfFgG";
1452 const char int_spec[] = "cdiouxX";
1453 /* The following characters are used for use of invalid types */
1454 const char illegal_spec[] = "hlLqjzZtCSpn";
1456 int string_pos, real_pos, int_pos, illegal_pos;
1458 /* check if really format specifier */
1459 if (format[0] != '%')
1461 "internal error: sprintf_specifier called without '%'\n");
1463 string_pos = strcspn(format, string_spec);
1464 real_pos = strcspn(format, real_spec);
1465 int_pos = strcspn(format, int_spec);
1466 illegal_pos = strcspn(format, illegal_spec);
1468 if ( illegal_pos < int_pos && illegal_pos < real_pos
1469 && illegal_pos < string_pos )
1471 "sprintf_specifier: used with invalid format specifier\n");
1472 else if ( string_pos < real_pos && string_pos < int_pos )
1474 else if ( real_pos < int_pos )
1476 else if ( int_pos < strlen(format) )
1480 "sprintf_specifier: no format specifier\n");
1482 return INTGR; /* Can't happen, but the compiler doesn't realize that */
1486 /* execute a system call and return stream from STDOUT */
1488 f_system(union argument *arg)
1490 struct value val, result;
1491 struct udvt_entry *errno_var;
1493 int output_len, ierr;
1495 /* Retrieve parameters from top of stack */
1498 /* Make sure parameters are of the correct type */
1499 if (val.type != STRING)
1500 int_error(NO_CARET, "non-string argument to system()");
1502 FPRINTF((stderr," f_system input = \"%s\"\n", val.v.string_val));
1504 ierr = do_system_func(val.v.string_val, &output);
1505 if ((errno_var = add_udv_by_name("ERRNO"))) {
1506 errno_var->udv_undef = FALSE;
1507 Ginteger(&errno_var->udv_value, ierr);
1509 output_len = strlen(output);
1512 if ( output_len > 0 && output[output_len-1] == '\n' )
1513 output[output_len-1] = NUL;
1515 FPRINTF((stderr," f_system result = \"%s\"\n", output));
1517 push(Gstring(&result, output));
1519 gpfree_string(&result); /* free output */
1520 gpfree_string(&val); /* free command string */