1 /*
2 * gretl -- Gnu Regression, Econometrics and Time-series Library
3 * Copyright (C) 2001 Allin Cottrell and Riccardo "Jack" Lucchetti
4 *
5 * This program is free software: you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation, either version 3 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 *
18 */
19
20 /* libset.c for gretl */
21
22 #include "libgretl.h"
23 #include "libset.h"
24 #include "usermat.h"
25 #include "uservar.h"
26 #include "matrix_extra.h"
27 #include "gretl_func.h"
28 #include "gretl_string_table.h"
29 #include "gretl_mt.h"
30
31 #ifdef HAVE_MPI
32 # include "gretl_mpi.h"
33 #endif
34
35 #include <stddef.h>
36 #include <unistd.h>
37 #include <errno.h>
38
39 #include <glib.h>
40
41 #define PDEBUG 0
42 #define SVDEBUG 0
43
44 enum {
45 AUTO_LAG_STOCK_WATSON,
46 AUTO_LAG_WOOLDRIDGE,
47 AUTO_LAG_NEWEYWEST
48 };
49
50 enum {
51 CAT_BEHAVE = 1,
52 CAT_NUMERIC,
53 CAT_RNG,
54 CAT_ROBUST,
55 CAT_TS,
56 CAT_SPECIAL
57 };
58
59 typedef enum {
60 SV_ALL,
61 SV_INT,
62 SV_DOUBLE
63 } SVType;
64
65 /* for values that really want a non-negative integer */
66 #define UNSET_INT -9
67 #define is_unset(i) (i == UNSET_INT)
68
69 typedef struct set_state_ set_state;
70
71 struct set_state_ {
72 int flags;
73 /* small integer values */
74 gint8 optim; /* code for preferred optimizer */
75 gint8 vecm_norm; /* VECM beta normalization */
76 gint8 garch_vcv; /* GARCH vcv variant */
77 gint8 garch_alt_vcv; /* GARCH vcv variant, robust estimation */
78 gint8 arma_vcv; /* ARMA vcv variant */
79 gint8 wildboot_d; /* distribution for wild bootstrap */
80 gint8 fdjac_qual; /* quality of "fdjac" function */
81 gint8 max_verbose; /* optimizer verbosity level */
82 gint8 hc_version; /* HCCME version */
83 gint8 hac_kernel; /* HAC kernel type */
84 gint8 auto_hac_lag; /* HAC automatic lag-length formula */
85 gint8 user_hac_lag; /* fixed user-set HAC lag length */
86 gint8 lbfgs_mem; /* memory span for L-BFGS-B */
87 gint8 quantile_type; /* Formula for computing quantiles */
88 /* potentially larger integers */
89 int horizon; /* for VAR impulse responses */
90 int bootrep; /* bootstrap replications */
91 int loop_maxiter; /* max no. of iterations in non-for loops */
92 int bfgs_maxiter; /* max iterations, BFGS */
93 int bfgs_verbskip; /* BFGS: show one in n iterations */
94 int boot_iters; /* max iterations, IRF bootstrap */
95 int bhhh_maxiter; /* max iterations, BHHH */
96 int rq_maxiter; /* max iterations for quantreg, simplex */
97 int gmm_maxiter; /* max iterations for iterated GMM */
98 /* floating-point values */
99 double conv_huge; /* conventional value for $huge */
100 double nls_toler; /* NLS convergence criterion */
101 double bfgs_toler; /* convergence tolerance, BFGS */
102 double bfgs_maxgrad; /* max acceptable gradient norm, BFGS */
103 double bhhh_toler; /* convergence tolerance, BHHH */
104 double qs_bandwidth; /* bandwidth for QS HAC kernel */
105 double nadarwat_trim; /* multiple of h to use in nadarwat() for trimming */
106 /* strings */
107 char csv_write_na[8]; /* representation of NA in CSV output */
108 char csv_read_na[8]; /* representation of NA in CSV input */
109 /* matrices */
110 gretl_matrix *initvals; /* parameter initializer */
111 gretl_matrix *initcurv; /* initial curvature matrix for BFGS */
112 gretl_matrix *matmask; /* mask for series -> matrix conversion */
113 };
114
115 typedef struct global_vars_ global_vars;
116
117 static struct global_vars_ {
118 gint8 gretl_debug;
119 gint8 gretl_assert;
120 gint8 datacols;
121 gint8 plot_collect;
122 gint8 R_functions;
123 gint8 R_lib;
124 gint8 loglevel;
125 gint8 logstamp;
126 gint8 csv_digits;
127 int gmp_bits;
128 } globals = {0, 0, 5, 0, 0, 1, 2, 0, UNSET_INT, 256};
129
130 /* globals for internal use */
131 static int seed_is_set;
132 static int comments_on;
133 static char data_delim = ',';
134 static char export_decpoint = '.';
135
136 typedef struct setvar_ setvar;
137
138 struct setvar_ {
139 SetKey key; /* internal integer key */
140 const char *name; /* userspace name */
141 gint8 category; /* for printing purposes */
142 size_t offset; /* byte offset into state or globals struct,
143 where applicable */
144 };
145
146 setvar setvars[] = {
147 /* booleans (bitflags) */
148 { USE_CWD, "use_cwd", CAT_BEHAVE },
149 { ECHO_ON, "echo", CAT_BEHAVE },
150 { MSGS_ON, "messages", CAT_BEHAVE },
151 { FORCE_DECPOINT, "force_decpoint", CAT_BEHAVE },
152 { USE_PCSE, "pcse", CAT_ROBUST },
153 { USE_SVD, "svd", CAT_NUMERIC },
154 { USE_QR, "force_qr", CAT_NUMERIC },
155 { PREWHITEN, "hac_prewhiten", CAT_ROBUST },
156 { FORCE_HC, "force_hc", CAT_ROBUST },
157 { USE_LBFGS, "lbfgs", CAT_NUMERIC },
158 { SHELL_OK, "shell_ok", CAT_SPECIAL },
159 { WARNINGS, "warnings", CAT_BEHAVE },
160 { SKIP_MISSING, "skip_missing", CAT_BEHAVE },
161 { BFGS_RSTEP, "bfgs_richardson", CAT_NUMERIC },
162 { ROBUST_Z, "robust_z", CAT_ROBUST },
163 { MWRITE_G, "mwrite_g", CAT_BEHAVE },
164 { MPI_USE_SMT, "mpi_use_smt", CAT_BEHAVE },
165 { STATE_FLAG_MAX, NULL },
166 /* small integers */
167 { GRETL_OPTIM, "optimizer", CAT_NUMERIC, offsetof(set_state,optim) },
168 { VECM_NORM, "vecm_norm", CAT_TS, offsetof(set_state,vecm_norm) },
169 { GARCH_VCV, "garch_vcv", CAT_ROBUST, offsetof(set_state,garch_vcv) },
170 { GARCH_ALT_VCV, "garch_alt_vcv", CAT_ROBUST, offsetof(set_state,garch_alt_vcv) },
171 { ARMA_VCV, "arma_vcv", CAT_ROBUST, offsetof(set_state,arma_vcv) },
172 { WILDBOOT_DIST, "wildboot", CAT_BEHAVE, offsetof(set_state,wildboot_d) },
173 { FDJAC_QUAL, "fdjac_quality", CAT_NUMERIC, offsetof(set_state,fdjac_qual) },
174 { MAX_VERBOSE, "max_verbose", CAT_BEHAVE, offsetof(set_state,max_verbose) },
175 { HC_VERSION, "hc_version", CAT_ROBUST, offsetof(set_state,hc_version) },
176 { HAC_KERNEL, "hac_kernel", CAT_ROBUST, offsetof(set_state,hac_kernel) },
177 { HAC_LAG, "hac_lag", CAT_ROBUST },
178 { USER_HAC_LAG, NULL },
179 { LBFGS_MEM, "lbfgs_mem", CAT_NUMERIC, offsetof(set_state,lbfgs_mem) },
180 { QUANTILE_TYPE, "quantile_type", CAT_BEHAVE, offsetof(set_state,quantile_type) },
181 { STATE_SMALL_INT_MAX, NULL },
182 /* larger integers */
183 { HORIZON, "horizon", CAT_TS, offsetof(set_state,horizon) },
184 { BOOTREP, "bootrep", CAT_BEHAVE, offsetof(set_state,bootrep) },
185 { LOOP_MAXITER, "loop_maxiter", CAT_BEHAVE, offsetof(set_state,loop_maxiter) },
186 { BFGS_MAXITER, "bfgs_maxiter", CAT_NUMERIC, offsetof(set_state,bfgs_maxiter) },
187 { BFGS_VERBSKIP, "bfgs_verbskip", CAT_BEHAVE, offsetof(set_state,bfgs_verbskip) },
188 { BOOT_ITERS, "boot_iters", CAT_TS, offsetof(set_state,boot_iters) },
189 { BHHH_MAXITER, "bhhh_maxiter", CAT_NUMERIC, offsetof(set_state,bhhh_maxiter) },
190 { RQ_MAXITER, "rq_maxiter", CAT_NUMERIC, offsetof(set_state,rq_maxiter) },
191 { GMM_MAXITER, "gmm_maxiter", CAT_NUMERIC, offsetof(set_state,gmm_maxiter) },
192 { STATE_INT_MAX, NULL },
193 /* doubles */
194 { CONV_HUGE, "huge", CAT_BEHAVE, offsetof(set_state,conv_huge) },
195 { NLS_TOLER, "nls_toler", CAT_NUMERIC, offsetof(set_state,nls_toler) },
196 { BFGS_TOLER, "bfgs_toler", CAT_NUMERIC, offsetof(set_state,bfgs_toler) },
197 { BFGS_MAXGRAD, "bfgs_maxgrad", CAT_NUMERIC, offsetof(set_state,bfgs_maxgrad) },
198 { BHHH_TOLER, "bhhh_toler", CAT_NUMERIC, offsetof(set_state,bhhh_toler) },
199 { QS_BANDWIDTH, "qs_bandwidth", CAT_ROBUST, offsetof(set_state,qs_bandwidth) },
200 { NADARWAT_TRIM, "nadarwat_trim", CAT_NUMERIC, offsetof(set_state,nadarwat_trim) },
201 { STATE_FLOAT_MAX, NULL },
202 /* strings */
203 { CSV_WRITE_NA, "csv_write_na", CAT_SPECIAL },
204 { CSV_READ_NA, "csv_read_na", CAT_SPECIAL },
205 /* matrices */
206 { INITVALS, "initvals", CAT_NUMERIC },
207 { INITCURV, "initcurv", CAT_NUMERIC },
208 { MATMASK, "matrix_mask", CAT_BEHAVE },
209 { STATE_VARS_MAX, NULL },
210 /* global ints */
211 { GRETL_DEBUG, "debug", CAT_BEHAVE, offsetof(global_vars,gretl_debug) },
212 { GRETL_ASSERT, "assert", CAT_BEHAVE, offsetof(global_vars,gretl_assert) },
213 { DATACOLS, "datacols", CAT_BEHAVE, offsetof(global_vars,datacols) },
214 { PLOT_COLLECT, "plot_collection", CAT_BEHAVE, offsetof(global_vars,plot_collect) },
215 { R_FUNCTIONS, "R_functions", CAT_BEHAVE, offsetof(global_vars,R_functions) },
216 { R_LIB, "R_lib", CAT_BEHAVE, offsetof(global_vars,R_lib) },
217 { LOGLEVEL, "loglevel", CAT_BEHAVE, offsetof(global_vars,loglevel) },
218 { LOGSTAMP, "logstamp", CAT_BEHAVE, offsetof(global_vars,logstamp) },
219 { CSV_DIGITS, "csv_digits", CAT_BEHAVE, offsetof(global_vars,csv_digits) },
220 { NS_SMALL_INT_MAX, NULL },
221 { GMP_BITS, "gmp_bits", CAT_BEHAVE, offsetof(global_vars,gmp_bits) },
222 { NS_MAX, NULL },
223 /* delegated ints */
224 { BLAS_MNK_MIN, "blas_mnk_min", CAT_BEHAVE },
225 { OMP_MNK_MIN, "omp_mnk_min", CAT_BEHAVE },
226 { OMP_N_THREADS, "omp_num_threads", CAT_SPECIAL },
227 { SIMD_K_MAX, "simd_k_max", CAT_BEHAVE },
228 { SIMD_MN_MIN, "simd_mn_min", CAT_BEHAVE },
229 { USE_DCMT, "use_dcmt", CAT_RNG },
230 /* specials */
231 { SEED, "seed", CAT_RNG },
232 { CSV_DELIM, "csv_delim", CAT_SPECIAL },
233 { STOPWATCH, "stopwatch", CAT_SPECIAL },
234 { VERBOSE, "verbose", CAT_SPECIAL },
235 { SV_WORKDIR, "workdir", CAT_SPECIAL },
236 { SV_LOGFILE, "logfile", CAT_SPECIAL },
237 { GRAPH_THEME, "graph_theme", CAT_SPECIAL },
238 { DISP_DIGITS, "display_digits", CAT_SPECIAL }
239 };
240
241 #define libset_boolvar(k) (k < STATE_FLAG_MAX || k==R_FUNCTIONS || \
242 k==R_LIB || k==LOGSTAMP)
243 #define libset_double(k) (k > STATE_INT_MAX && k < STATE_FLOAT_MAX)
244 #define libset_int(k) ((k > STATE_FLAG_MAX && k < STATE_INT_MAX) || \
245 (k > STATE_VARS_MAX && k < NS_INT_MAX))
246
247 #define libset_small_int(k) (k < STATE_SMALL_INT_MAX || \
248 (k > STATE_VARS_MAX && k < NS_SMALL_INT_MAX))
249
250 #define coded_intvar(k) (k == GARCH_VCV || \
251 k == GARCH_ALT_VCV || \
252 k == ARMA_VCV || \
253 k == HAC_LAG || \
254 k == HAC_KERNEL || \
255 k == HC_VERSION || \
256 k == VECM_NORM || \
257 k == GRETL_OPTIM || \
258 k == MAX_VERBOSE || \
259 k == WILDBOOT_DIST || \
260 k == QUANTILE_TYPE || \
261 k == GRETL_ASSERT || \
262 k == PLOT_COLLECT || \
263 k == LOGLEVEL)
264
265 /* the current set of state variables */
266 set_state *state;
267
268 static const char *hac_lag_string (void);
269 static int real_libset_read_script (const char *fname,
270 PRN *prn);
271 static int libset_get_scalar (SetKey key, const char *arg,
272 int *pi, double *px);
273 static int libset_int_min (SetKey key);
274
275 /* In case we have a SetKey and want to print the
276 associated userspace keyword. */
277
setkey_get_name(SetKey key)278 static const char *setkey_get_name (SetKey key)
279 {
280 int i;
281
282 for (i=0; i<G_N_ELEMENTS(setvars); i++) {
283 if (setvars[i].key == key) {
284 return setvars[i].name;
285 }
286 }
287 return NULL;
288 }
289
290 /* Set up a hash table to map from userspace keywords
291 to setvar structs.
292 */
293
libset_hash_init(void)294 static GHashTable *libset_hash_init (void)
295 {
296 GHashTable *ht = g_hash_table_new(g_str_hash, g_str_equal);
297 int i;
298
299 for (i=0; i<G_N_ELEMENTS(setvars); i++) {
300 if (setvars[i].name != NULL) {
301 g_hash_table_insert(ht, (gpointer) setvars[i].name, &setvars[i]);
302 }
303 }
304
305 return ht;
306 }
307
308 static GHashTable *svht;
309
get_setvar_by_name(const char * name)310 static setvar *get_setvar_by_name (const char *name)
311 {
312 setvar *ret = NULL;
313
314 if (svht == NULL) {
315 svht = libset_hash_init();
316 }
317
318 ret = g_hash_table_lookup(svht, name);
319
320 if (ret == NULL) {
321 /* backward compatibility */
322 if (!strcmp(name, "csv_na")) {
323 ret = g_hash_table_lookup(svht, "csv_write_na");
324 } else if (!strcmp(name, "mp_mnk_min")) {
325 ret = g_hash_table_lookup(svht, "omp_mnk_min");
326 }
327 }
328
329 return ret;
330 }
331
setvar_get_target(setvar * sv)332 static void *setvar_get_target (setvar *sv)
333 {
334 void *p;
335
336 if (sv->offset == 0 || sv->key > GMP_BITS) {
337 /* FIXME criterion? (0 offset is legit for "debug") */
338 if (sv->key != GRETL_DEBUG) {
339 return NULL;
340 }
341 }
342
343 p = (sv->key < STATE_VARS_MAX)? (void *) state : (void *) &globals;
344 #if SVDEBUG
345 fprintf(stderr, "setvar_get_target: '%s': %s=%p, offset=%lu, ret=%p\n",
346 sv->name, sv->key < STATE_VARS_MAX ? "state" : "globals",
347 (void *) p, sv->offset, p + sv->offset);
348 #endif
349 return p + sv->offset;
350 }
351
352 #define INTS_OFFSET (1 + log2(STATE_FLAG_MAX))
353
setkey_get_target(SetKey key,SVType t)354 static void *setkey_get_target (SetKey key, SVType t)
355 {
356 int i = INTS_OFFSET + key - GRETL_OPTIM;
357 setvar *sv = &setvars[i];
358
359 if (sv->key != key) {
360 fprintf(stderr, "*** internal error, looking for %s, found %s ***\n",
361 setkey_get_name(key), sv->name);
362 return NULL;
363 } else if ((t == SV_INT && !libset_int(key)) ||
364 (t == SV_DOUBLE && !libset_double(key))) {
365 fprintf(stderr, "*** type mismatch in setkey_get_target for %s ***\n",
366 sv->name);
367 return NULL;
368 } else {
369 return setvar_get_target(sv);
370 }
371 }
372
373 /* value strings for integer-coded variables */
374
375 static const char *gvc_strs[] = {"unset", "hessian", "im", "op", "qml", "bw", NULL};
376 static const char *gvr_strs[] = {"qml", "bw", NULL};
377 static const char *avc_strs[] = {"hessian", "op", NULL};
378 static const char *hkn_strs[] = {"bartlett", "parzen", "qs", NULL};
379 static const char *hcv_strs[] = {"0", "1", "2", "3", "3a", NULL};
380 static const char *vnm_strs[] = {"phillips", "diag", "first", "none", NULL};
381 static const char *opt_strs[] = {"auto", "BFGS", "newton", NULL};
382 static const char *mxv_strs[] = {"off", "on", "full", NULL};
383 static const char *wbt_strs[] = {"rademacher", "mammen", NULL};
384 static const char *qnt_strs[] = {"Q6", "Q7", "Q8", NULL};
385 static const char *ast_strs[] = {"off", "warn", "stop", NULL};
386 static const char *plc_strs[] = {"off", "auto", "on", NULL};
387 static const char *csv_strs[] = {"comma", "space", "tab", "semicolon", NULL};
388 static const char *ahl_strs[] = {"nw1", "nw2", "nw3", NULL};
389 static const char *llv_strs[] = {"debug", "info", "warn", "error", "critical", NULL};
390
391 struct codevar_info {
392 SetKey key;
393 const char **strvals;
394 };
395
396 /* look-up table for sets of value strings */
397
398 struct codevar_info coded[] = {
399 { GARCH_VCV, gvc_strs },
400 { GARCH_ALT_VCV, gvr_strs },
401 { ARMA_VCV, avc_strs },
402 { HAC_KERNEL, hkn_strs },
403 { HC_VERSION, hcv_strs },
404 { VECM_NORM, vnm_strs },
405 { GRETL_OPTIM, opt_strs },
406 { MAX_VERBOSE, mxv_strs },
407 { WILDBOOT_DIST, wbt_strs },
408 { CSV_DELIM, csv_strs },
409 { QUANTILE_TYPE, qnt_strs },
410 { GRETL_ASSERT, ast_strs },
411 { PLOT_COLLECT, plc_strs },
412 { HAC_LAG, ahl_strs },
413 { LOGLEVEL, llv_strs }
414 };
415
libset_option_strings(SetKey key)416 static const char **libset_option_strings (SetKey key)
417 {
418 int i;
419
420 for (i=0; i<G_N_ELEMENTS(coded); i++) {
421 if (coded[i].key == key) {
422 return coded[i].strvals;
423 }
424 }
425 return NULL;
426 }
427
coded_var_show_opts(SetKey key,PRN * prn)428 static void coded_var_show_opts (SetKey key, PRN *prn)
429 {
430 const char **S = libset_option_strings(key);
431
432 if (S != NULL) {
433 pputs(prn, "valid settings:");
434 while (*S != NULL) {
435 pprintf(prn, " %s", *S);
436 S++;
437 }
438 pputc(prn, '\n');
439 }
440 }
441
garch_alt_vcv_string(void)442 static const char *garch_alt_vcv_string (void)
443 {
444 if (state->garch_alt_vcv == ML_QML) {
445 return gvr_strs[0];
446 } else if (state->garch_alt_vcv == ML_BW) {
447 return gvr_strs[1];
448 } else {
449 return "unset";
450 }
451 }
452
arma_vcv_string(void)453 static const char *arma_vcv_string (void)
454 {
455 if (state->arma_vcv == ML_HESSIAN) {
456 return avc_strs[0];
457 } else if (state->arma_vcv == ML_OP) {
458 return avc_strs[1];
459 } else {
460 return "unset";
461 }
462 }
463
libset_option_string(SetKey key)464 static const char *libset_option_string (SetKey key)
465 {
466 if (key == HAC_LAG) {
467 return hac_lag_string(); /* special */
468 } else if (key == GARCH_ALT_VCV) {
469 return garch_alt_vcv_string(); /* special */
470 } else if (key == ARMA_VCV) {
471 return arma_vcv_string(); /* special */
472 } else {
473 const char **strs = libset_option_strings(key);
474 void *valp = setkey_get_target(key, SV_INT);
475
476 return strs[*(gint8 *) valp];
477 }
478 }
479
print_state_matrix(SetKey key,PRN * prn,gretlopt opt)480 static void print_state_matrix (SetKey key, PRN *prn, gretlopt opt)
481 {
482 gretl_matrix *m;
483 char *name;
484
485 if (key == INITVALS) {
486 name = "initvals";
487 m = state->initvals;
488 } else {
489 name = "initcurv";
490 m = state->initcurv;
491 }
492
493 if (opt & OPT_D) {
494 if (m == NULL) {
495 pprintf(prn, " %s = auto\n", name);
496 } else {
497 gretl_matrix_print_to_prn(m, name, prn);
498 }
499 }
500 }
501
502 /* check_for_state() returns non-zero if the program options
503 state is not readable */
504
check_for_state(void)505 static int check_for_state (void)
506 {
507 if (state == NULL) {
508 return libset_init();
509 } else {
510 #if PDEBUG > 1
511 fprintf(stderr, "check_for_state: state = %p\n", (void *) state);
512 #endif
513 return 0;
514 }
515 }
516
flag_to_bool(set_state * sv,SetKey key)517 static int flag_to_bool (set_state *sv, SetKey key)
518 {
519 if (sv == NULL) {
520 return 0;
521 } else {
522 return (sv->flags & key)? 1 : 0;
523 }
524 }
525
state_vars_copy(set_state * sv)526 static void state_vars_copy (set_state *sv)
527 {
528 #if PDEBUG
529 fprintf(stderr, "state_vars_copy() called\n");
530 #endif
531 /* copy everything */
532 *sv = *state;
533 /* but set matrix pointers to NULL */
534 sv->initvals = NULL;
535 sv->initcurv = NULL;
536 sv->matmask = NULL;
537 }
538
539 static set_state default_state = {
540 ECHO_ON | MSGS_ON | WARNINGS | SKIP_MISSING, /* .flags */
541 OPTIM_AUTO, /* .optim */
542 NORM_PHILLIPS, /* .vecm_norm */
543 ML_UNSET, /* .garch_vcv */
544 ML_UNSET, /* .garch_alt_vcv */
545 ML_HESSIAN, /* .arma_vcv */
546 0, /* .wildboot_dist */
547 0, /* .fdjac_qual */
548 0, /* .max_verbose */
549 0, /* .hc_version */
550 KERNEL_BARTLETT, /* .hac_kernel */
551 AUTO_LAG_STOCK_WATSON, /* .auto_hac_lag */
552 UNSET_INT, /* .user_hac_lag */
553 8, /* .lbfgs_mem */
554 0, /* .quantile_type */
555 UNSET_INT, /* .horizon */
556 1000, /* .bootrep */
557 100000, /* .loop_maxiter */
558 UNSET_INT, /* .bfgs_maxiter */
559 1, /* .bfgs_verbskip */
560 1999, /* .boot_iters */
561 500, /* .bhhh_maxiter */
562 1000, /* .rq_maxiter */
563 250, /* .gmm_maxiter */
564 1.0e100, /* .conv_huge */
565 NADBL, /* .nls_toler */
566 NADBL, /* .bfgs_toler */
567 5.0, /* .bfgs_maxgrad */
568 1.0e-6, /* .bhhh_toler */
569 2.0, /* .qs_bandwidth */
570 4.0, /* .nadarwat_trim */
571 "NA", /* .csv_write_na */
572 "default", /* .csv_read_na */
573 NULL, /* .initvals */
574 NULL, /* .initcurv */
575 NULL /* .matmask */
576 };
577
state_vars_init(set_state * sv)578 static void state_vars_init (set_state *sv)
579 {
580 *sv = default_state;
581 }
582
get_bkbp_k(const DATASET * dset)583 int get_bkbp_k (const DATASET *dset)
584 {
585 if (dset->pd == 1) {
586 return 3;
587 } else if (dset->pd == 4) {
588 return 12;
589 } else if (dset->pd == 12) {
590 return 36;
591 } else {
592 return 3;
593 }
594 }
595
get_bkbp_periods(const DATASET * dset,int * l,int * u)596 void get_bkbp_periods (const DATASET *dset, int *l, int *u)
597 {
598 *l = (dset->pd == 4)? 6 :
599 (dset->pd == 12)? 18 : 2;
600
601 *u = (dset->pd == 4)? 32 :
602 (dset->pd == 12)? 96 : 8;
603 }
604
set_gretl_echo(int e)605 void set_gretl_echo (int e)
606 {
607 if (check_for_state()) return;
608
609 if (e) {
610 state->flags |= ECHO_ON;
611 } else {
612 state->flags &= ~ECHO_ON;
613 }
614 }
615
gretl_echo_on(void)616 int gretl_echo_on (void)
617 {
618 if (check_for_state()) {
619 return 1;
620 } else {
621 return flag_to_bool(state, ECHO_ON);
622 }
623 }
624
gretl_comments_on(void)625 int gretl_comments_on (void)
626 {
627 if (gretl_function_depth() > 0) {
628 return 0;
629 } else {
630 return comments_on;
631 }
632 }
633
set_gretl_messages(int e)634 void set_gretl_messages (int e)
635 {
636 if (check_for_state()) return;
637
638 if (e) {
639 state->flags |= MSGS_ON;
640 } else {
641 state->flags &= ~MSGS_ON;
642 }
643 }
644
gretl_messages_on(void)645 int gretl_messages_on (void)
646 {
647 if (check_for_state()) {
648 return 1;
649 } else {
650 return flag_to_bool(state, MSGS_ON);
651 }
652 }
653
gretl_warnings_on(void)654 int gretl_warnings_on (void)
655 {
656 if (check_for_state()) return 1;
657 return flag_to_bool(state, WARNINGS);
658 }
659
gretl_debugging_on(void)660 int gretl_debugging_on (void)
661 {
662 return globals.gretl_debug;
663 }
664
665 #define DEFAULT_MP_BITS 256
666 #define mp_bits_ok(b) (b >= 256 && b <= 8192)
667
668 /* Called from the mp_ols plugin, also gretl_utils.c and
669 the GUI model specification dialog.
670 */
671
get_mp_bits(void)672 int get_mp_bits (void)
673 {
674 if (globals.gmp_bits > DEFAULT_MP_BITS) {
675 return globals.gmp_bits;
676 } else {
677 char *s = getenv("GRETL_MP_BITS");
678 int b;
679
680 if (s != NULL) {
681 b = atoi(s);
682 if (mp_bits_ok(b)) {
683 return b;
684 }
685 }
686 }
687
688 return DEFAULT_MP_BITS;
689 }
690
691 /* start accessors for libset matrices */
692
get_initvals(void)693 gretl_matrix *get_initvals (void)
694 {
695 gretl_matrix *iv;
696
697 /* note: we nullify initvals after first use */
698 check_for_state();
699 iv = state->initvals;
700 state->initvals = NULL;
701 return iv;
702 }
703
n_initvals(void)704 int n_initvals (void)
705 {
706 check_for_state();
707 if (state->initvals != NULL) {
708 return gretl_vector_get_length(state->initvals);
709 } else {
710 return 0;
711 }
712 }
713
get_initcurv(void)714 gretl_matrix *get_initcurv (void)
715 {
716 gretl_matrix *ic;
717
718 /* note: like initvals, we nullify initcurv after first use */
719 check_for_state();
720 ic = state->initcurv;
721 state->initcurv = NULL;
722 return ic;
723 }
724
n_initcurv(void)725 int n_initcurv (void)
726 {
727 check_for_state();
728 if (state->initcurv != NULL) {
729 return gretl_vector_get_length(state->initcurv);
730 } else {
731 return 0;
732 }
733 }
734
get_matrix_mask(void)735 const gretl_matrix *get_matrix_mask (void)
736 {
737 check_for_state();
738 return state->matmask;
739 }
740
get_matrix_mask_nobs(void)741 int get_matrix_mask_nobs (void)
742 {
743 int n = 0;
744
745 check_for_state();
746
747 if (state->matmask != NULL) {
748 int i;
749
750 for (i=0; i<state->matmask->rows; i++) {
751 if (state->matmask->val[i] != 0.0) {
752 n++;
753 }
754 }
755 }
756
757 return n;
758 }
759
760 /* end accessors for libset matrices */
761
get_hac_lag(int T)762 int get_hac_lag (int T)
763 {
764 int h = 0;
765
766 check_for_state();
767
768 /* Variants of Newey-West */
769
770 if (state->user_hac_lag >= 0 && state->user_hac_lag < T - 2) {
771 /* FIXME upper limit? */
772 h = state->user_hac_lag;
773 } else if (state->auto_hac_lag == AUTO_LAG_WOOLDRIDGE) {
774 h = 4.0 * pow(T / 100.0, 2.0 / 9.0);
775 } else {
776 /* Stock-Watson default */
777 h = 0.75 * pow(T, 1.0 / 3.0);
778 }
779
780 return h;
781 }
782
783 /* prewhitening implies nw3, but not vice versa */
784
data_based_hac_bandwidth(void)785 int data_based_hac_bandwidth (void)
786 {
787 if (is_unset(state->user_hac_lag)) {
788 if (state->auto_hac_lag == AUTO_LAG_NEWEYWEST ||
789 (state->flags & PREWHITEN)) {
790 return 1;
791 }
792 }
793
794 return 0;
795 }
796
hac_lag_string(void)797 static const char *hac_lag_string (void)
798 {
799 check_for_state();
800
801 if (state->user_hac_lag >= 0 && state->user_hac_lag < 127) {
802 static char lagstr[6];
803
804 sprintf(lagstr, "%d", state->user_hac_lag);
805 return lagstr;
806 } else {
807 return ahl_strs[state->auto_hac_lag];
808 }
809 }
810
811 /* set max lag for HAC estimation */
812
parse_hac_lag_variant(const char * s)813 static int parse_hac_lag_variant (const char *s)
814 {
815 int i, err = 0;
816
817 for (i=0; ahl_strs[i] != NULL; i++) {
818 if (!strcmp(s, ahl_strs[i])) {
819 state->auto_hac_lag = i;
820 state->user_hac_lag = UNSET_INT;
821 return 0;
822 }
823 }
824
825 err = libset_get_scalar(HAC_LAG, s, &i, NULL);
826 if (!err) {
827 state->user_hac_lag = i;
828 }
829
830 return err;
831 }
832
833 enum {
834 NUMERIC_OK,
835 NUMERIC_BAD,
836 NON_NUMERIC
837 };
838
839 /* Test @s for being a string representation of a numeric value
840 in the C locale, using strtod() and/or strtol(). This can be
841 used to retrieve a floating-point value (if @px is non-NULL)
842 or an integer value (@pi non-NULL); exactly one of these
843 pointers should be non-NULL.
844
845 A return value of NUMERIC_OK means that @s is indeed numeric
846 and the converted value is within range for a double (if @px
847 is non-NULL) or a 32-bit integer (if @pi is non-NULL).
848
849 A return of NUMERIC_BAD means that @s is numeric but out of
850 range for the target type.
851
852 A return of NON_NUMERIC means that @s is not a numeric string;
853 one may then proceed to test whether it's the name of a scalar
854 variable.
855 */
856
857 static int
libset_numeric_test(const char * s,int * pi,double * px)858 libset_numeric_test (const char *s, int *pi, double *px)
859 {
860 int ret = NUMERIC_OK;
861 char *test;
862
863 if (!strcmp(s, "inf") || !strcmp(s, "nan")) {
864 return NUMERIC_BAD;
865 } else if (isalpha(*s)) {
866 return NON_NUMERIC;
867 }
868
869 errno = 0;
870 gretl_push_c_numeric_locale();
871
872 if (px != NULL) {
873 /* looking for a floating-point value */
874 *px = strtod(s, &test);
875 if (*test != '\0') {
876 ret = NON_NUMERIC;
877 } else if (errno == ERANGE) {
878 gretl_errmsg_set_from_errno(s, errno);
879 ret = NUMERIC_BAD;
880 }
881 } else {
882 /* looking for an integer value */
883 long li = strtol(s, &test, 10);
884
885 if (*test != '\0') {
886 /* try for a floating-point value that's also a valid int? */
887 char *testx;
888 double x;
889
890 errno = 0;
891 x = strtod(s, &testx);
892
893 if (*testx != '\0') {
894 ret = NON_NUMERIC;
895 } else if (errno == ERANGE) {
896 ret = NUMERIC_BAD;
897 } else {
898 /* numeric, but does it work as an int? */
899 if (x == floor(x) && fabs(x) <= INT_MAX) {
900 *pi = (int) x;
901 } else {
902 ret = NUMERIC_BAD;
903 }
904 }
905 } else if (errno == ERANGE) {
906 gretl_errmsg_set_from_errno(s, errno);
907 ret = NUMERIC_BAD;
908 } else if (labs(li) > INT_MAX) {
909 /* OK as a long but too big for 32-bit int */
910 ret = NUMERIC_BAD;
911 } else {
912 *pi = (int) li;
913 }
914 }
915
916 gretl_pop_c_numeric_locale();
917
918 return ret;
919 }
920
negval_invalid(SetKey key)921 static int negval_invalid (SetKey key)
922 {
923 int ret = 1; /* presume invalid */
924
925 if (key > 0) {
926 if (key == BLAS_MNK_MIN || key == OMP_MNK_MIN ||
927 key == SIMD_K_MAX || key == SIMD_MN_MIN) {
928 /* these can all be set to -1 */
929 ret = 0;
930 }
931 }
932
933 return ret;
934 }
935
libset_get_scalar(SetKey key,const char * arg,int * pi,double * px)936 static int libset_get_scalar (SetKey key, const char *arg,
937 int *pi, double *px)
938 {
939 double x = NADBL;
940 int nstatus, err = 0;
941
942 if (arg == NULL || *arg == '\0') {
943 return E_ARGS;
944 }
945
946 nstatus = libset_numeric_test(arg, pi, px);
947
948 if (nstatus == NUMERIC_BAD) {
949 return E_INVARG; /* handled */
950 } else if (nstatus == NUMERIC_OK) {
951 if (pi != NULL && negval_invalid(key) && *pi < 0) {
952 err = E_INVARG;
953 } else if (px != NULL && *px < 0.0) {
954 err = E_INVARG;
955 }
956 return err; /* handled */
957 }
958
959 /* handle the non-numeric case */
960 x = get_scalar_value_by_name(arg, &err);
961
962 if (!err) {
963 if (negval_invalid(key) && x < 0.0) {
964 err = E_INVARG;
965 } else if (px != NULL) {
966 *px = x;
967 } else if (pi != NULL) {
968 if (na(x) || fabs(x) > (double) INT_MAX) {
969 err = E_INVARG;
970 } else {
971 *pi = (int) x;
972 }
973 }
974 }
975
976 return err;
977 }
978
libset_get_unsigned(const char * arg,unsigned int * pu)979 static int libset_get_unsigned (const char *arg, unsigned int *pu)
980 {
981 unsigned long lu = 0;
982 char *test = NULL;
983 double x = NADBL;
984 int err = 0;
985
986 errno = 0;
987 lu = strtoul(arg, &test, 10);
988
989 if (*test == '\0' && errno == 0) {
990 if (lu <= UINT_MAX) {
991 *pu = (unsigned) lu;
992 return 0;
993 } else {
994 return E_DATA;
995 }
996 }
997
998 x = get_scalar_value_by_name(arg, &err);
999 if (err) {
1000 return err;
1001 }
1002
1003 if (x < 0.0 || na(x) || x > (double) UINT_MAX) {
1004 err = E_DATA;
1005 } else {
1006 *pu = (unsigned) x;
1007 }
1008
1009 return err;
1010 }
1011
n_strvals(const char ** s)1012 static int n_strvals (const char **s)
1013 {
1014 int n = 0;
1015
1016 while (*s != NULL) {
1017 n++; s++;
1018 }
1019 return n;
1020 }
1021
parse_libset_int_code(SetKey key,const char * val)1022 static int parse_libset_int_code (SetKey key, const char *val)
1023 {
1024 int i, err = E_DATA;
1025
1026 if (key == HAC_LAG) {
1027 err = parse_hac_lag_variant(val);
1028 } else if (coded_intvar(key)) {
1029 const char **strs = libset_option_strings(key);
1030 void *valp = setkey_get_target(key, SV_INT);
1031 int ival = -1;
1032
1033 for (i=0; strs[i] != NULL; i++) {
1034 if (!g_ascii_strcasecmp(val, strs[i])) {
1035 ival = i;
1036 break;
1037 }
1038 }
1039 if (ival >= 0) {
1040 void *valp = setkey_get_target(key, SV_INT);
1041
1042 err = 0;
1043 if (key == GARCH_ALT_VCV) {
1044 ival = (ival == 1)? ML_BW : ML_QML;
1045 } else if (key == ARMA_VCV) {
1046 ival = (ival == 1)? ML_OP : ML_HESSIAN;
1047 }
1048 *(gint8 *) valp = ival;
1049 } else if (key == MAX_VERBOSE || key == LOGLEVEL) {
1050 /* special: bare integers allowed? */
1051 int n = n_strvals(strs);
1052
1053 for (i=0; i<n; i++) {
1054 if (val[0] == i + 48 && val[1] == '\0') {
1055 *(gint8 *) valp = i;
1056 err = 0;
1057 break;
1058 }
1059 }
1060 }
1061 }
1062
1063 #if 0
1064 fprintf(stderr, "parse_libset_int_code: %s, %s, err = %d\n",
1065 setkey_get_name(key), val, err);
1066 #endif
1067
1068 if (err) {
1069 gretl_errmsg_sprintf(_("%s: invalid value '%s'"),
1070 setkey_get_name(key), val);
1071 }
1072
1073 return err;
1074 }
1075
1076 /* start public functions called from gui/settings.c */
1077
set_xsect_hccme(const char * s)1078 void set_xsect_hccme (const char *s)
1079 {
1080 if (check_for_state()) return;
1081
1082 if (!strncmp(s, "HC", 2)) {
1083 s += 2;
1084 }
1085 parse_libset_int_code(HC_VERSION, s);
1086 }
1087
set_tseries_hccme(const char * s)1088 void set_tseries_hccme (const char *s)
1089 {
1090 if (check_for_state()) return;
1091
1092 if (!strcmp(s, "HAC")) {
1093 libset_set_bool(FORCE_HC, 0);
1094 } else {
1095 if (!strncmp(s, "HC", 2)) {
1096 s += 2;
1097 }
1098 if (parse_libset_int_code(HC_VERSION, s) == 0) {
1099 /* non-HAC variant chosen */
1100 libset_set_bool(FORCE_HC, 1);
1101 }
1102 }
1103 }
1104
set_panel_hccme(const char * s)1105 void set_panel_hccme (const char *s)
1106 {
1107 if (check_for_state()) return;
1108
1109 if (!strcmp(s, "Arellano")) {
1110 state->flags &= ~USE_PCSE;
1111 } else if (!strcmp(s, "PCSE")) {
1112 state->flags |= USE_PCSE;
1113 }
1114 }
1115
set_garch_alt_vcv(const char * s)1116 void set_garch_alt_vcv (const char *s)
1117 {
1118 if (check_for_state()) return;
1119
1120 parse_libset_int_code(GARCH_ALT_VCV, s);
1121 }
1122
1123 /* end public functions called from gui/settings.c */
1124
set_init_matrix(SetKey key,const char * name,PRN * prn)1125 static int set_init_matrix (SetKey key, const char *name,
1126 PRN *prn)
1127 {
1128 gretl_matrix **targ;
1129
1130 targ = (key == INITVALS)? &state->initvals : &state->initcurv;
1131
1132 gretl_matrix_free(*targ);
1133 *targ = NULL;
1134
1135 if (strcmp(name, "auto")) {
1136 gretl_matrix *m = get_matrix_by_name(name);
1137
1138 if (m == NULL) {
1139 pprintf(prn, _("'%s': no such matrix"), name);
1140 pputc(prn, '\n');
1141 return E_DATA;
1142 }
1143 *targ = gretl_matrix_copy(m);
1144 if (*targ == NULL) {
1145 return E_ALLOC;
1146 }
1147 }
1148
1149 return 0;
1150 }
1151
set_matrix_mask(const char * name,DATASET * dset)1152 static int set_matrix_mask (const char *name, DATASET *dset)
1153 {
1154 gretl_matrix_free(state->matmask);
1155 state->matmask = NULL;
1156
1157 if (strcmp(name, "null")) {
1158 int t, v = current_series_index(dset, name);
1159
1160 if (v < 0) {
1161 return E_UNKVAR;
1162 }
1163 state->matmask = gretl_column_vector_alloc(dset->n);
1164 if (state->matmask == NULL) {
1165 return E_ALLOC;
1166 }
1167 for (t=0; t<dset->n; t++) {
1168 state->matmask->val[t] = dset->Z[v][t];
1169 }
1170 }
1171
1172 return 0;
1173 }
1174
destroy_matrix_mask(void)1175 void destroy_matrix_mask (void)
1176 {
1177 check_for_state();
1178 gretl_matrix_free(state->matmask);
1179 state->matmask = NULL;
1180 }
1181
1182 static int (*workdir_callback)();
1183
set_workdir_callback(int (* callback)())1184 void set_workdir_callback (int (*callback)())
1185 {
1186 workdir_callback = callback;
1187 }
1188
set_workdir(const char * s)1189 static int set_workdir (const char *s)
1190 {
1191 int err = 0;
1192
1193 if (gretl_function_depth() > 0) {
1194 gretl_errmsg_set("set workdir: cannot be done inside a function");
1195 return 1;
1196 } else if (*s == '\0') {
1197 return E_DATA;
1198 } else {
1199 char workdir[MAXLEN];
1200
1201 *workdir = '\0';
1202 strncat(workdir, s, MAXLEN - 1);
1203 if (!err && workdir_callback != NULL) {
1204 err = (*workdir_callback)(workdir);
1205 } else if (!err) {
1206 err = gretl_set_path_by_name("workdir", workdir);
1207 }
1208 }
1209
1210 return err;
1211 }
1212
set_logfile(const char * s)1213 static int set_logfile (const char *s)
1214 {
1215 int err = 0;
1216
1217 if (gretl_function_depth() > 0) {
1218 gretl_errmsg_set("set logfile: cannot be done inside a function");
1219 return E_DATA;
1220 } else if (*s == '\0' || !strcmp(s, "null")) {
1221 gretl_insert_builtin_string("logfile", "");
1222 } else if (!strcmp(s, "stdout") || !strcmp(s, "stderr")) {
1223 gretl_insert_builtin_string("logfile", s);
1224 } else {
1225 char outname[FILENAME_MAX];
1226
1227 /* switch to workdir if needed */
1228 strcpy(outname, s);
1229 gretl_maybe_prepend_dir(outname);
1230 err = gretl_test_fopen(outname, "w");
1231 if (!err) {
1232 gretl_insert_builtin_string("logfile", outname);
1233 } else {
1234 gretl_errmsg_sprintf("Couldn't write to %s", outname);
1235 err = E_FOPEN;
1236 }
1237 }
1238
1239 return err;
1240 }
1241
1242 const char *csv_delims = ", \t;";
1243
delim_from_arg(const char * s)1244 static char delim_from_arg (const char *s)
1245 {
1246 int i;
1247
1248 for (i=0; csv_strs[i] != NULL; i++) {
1249 if (!strcmp(s, csv_strs[i])) {
1250 return csv_delims[i];
1251 }
1252 }
1253
1254 return 0;
1255 }
1256
arg_from_delim(char c)1257 static const char *arg_from_delim (char c)
1258 {
1259 int i;
1260
1261 for (i=0; csv_delims[i] != '\0'; i++) {
1262 if (c == csv_delims[i]) {
1263 return csv_strs[i];
1264 }
1265 }
1266
1267 return "unset";
1268 }
1269
libset_print_bool(SetKey key,const char * s,PRN * prn,gretlopt opt)1270 static void libset_print_bool (SetKey key, const char *s,
1271 PRN *prn, gretlopt opt)
1272 {
1273 int v = libset_get_bool(key);
1274
1275 if (s == NULL) {
1276 s = setkey_get_name(key);
1277 }
1278
1279 if (opt & OPT_D) {
1280 pprintf(prn, " %s = %d\n", s, v);
1281 } else {
1282 pprintf(prn, "set %s %s\n", s, v? "on" : "off");
1283 }
1284 }
1285
libset_print_int(SetKey key,const char * s,PRN * prn,gretlopt opt)1286 static void libset_print_int (SetKey key, const char *s,
1287 PRN *prn, gretlopt opt)
1288 {
1289 if (s == NULL) {
1290 s = setkey_get_name(key);
1291 }
1292
1293 if (coded_intvar(key)) {
1294 if (opt & OPT_D) {
1295 pprintf(prn, " %s = %s\n", s, libset_option_string(key));
1296 } else {
1297 pprintf(prn, "set %s %s\n", s, libset_option_string(key));
1298 }
1299 } else {
1300 int k = libset_get_int(key);
1301
1302 if (opt & OPT_D) {
1303 if (is_unset(k)) {
1304 pprintf(prn, " %s = auto\n", s);
1305 } else {
1306 pprintf(prn, " %s = %d\n", s, k);
1307 }
1308 } else if (!is_unset(k)) {
1309 pprintf(prn, "set %s %d\n", s, k);
1310 }
1311 }
1312 }
1313
libset_print_double(SetKey key,const char * s,PRN * prn,gretlopt opt)1314 static void libset_print_double (SetKey key, const char *s,
1315 PRN *prn, gretlopt opt)
1316 {
1317 double x = libset_get_double(key);
1318
1319 if (s == NULL) {
1320 s = setkey_get_name(key);
1321 }
1322
1323 if (opt & OPT_D) {
1324 if (na(x)) {
1325 pprintf(prn, " %s = auto\n", s);
1326 } else {
1327 pprintf(prn, " %s = %.15g\n", s, x);
1328 }
1329 } else if (!na(x)) {
1330 pprintf(prn, "set %s %.15g\n", s, x);
1331 }
1332 }
1333
libset_header(char * s,PRN * prn,gretlopt opt)1334 static void libset_header (char *s, PRN *prn, gretlopt opt)
1335 {
1336 if (opt & OPT_D) {
1337 pputs(prn, "\n --- ");
1338 pputs(prn, _(s));
1339 pputs(prn, " ---\n");
1340 } else {
1341 pprintf(prn, "# %s\n", s);
1342 }
1343 }
1344
print_vars_for_category(int category,PRN * prn,gretlopt opt)1345 static void print_vars_for_category (int category, PRN *prn,
1346 gretlopt opt)
1347 {
1348 setvar *v;
1349 int i;
1350
1351 for (i=0; i<G_N_ELEMENTS(setvars); i++) {
1352 if (setvars[i].category != category) {
1353 continue;
1354 }
1355 v = &setvars[i];
1356 if (libset_boolvar(v->key)) {
1357 libset_print_bool(v->key, v->name, prn, opt);
1358 } else if (libset_int(setvars[i].key)) {
1359 libset_print_int(v->key, v->name, prn, opt);
1360 } else if (libset_double(v->key)) {
1361 libset_print_double(v->key, v->name, prn, opt);
1362 }
1363 }
1364 }
1365
1366 /* print_settings: use OPT_D for "display", otherwise
1367 this gives script-type output */
1368
print_settings(PRN * prn,gretlopt opt)1369 static int print_settings (PRN *prn, gretlopt opt)
1370 {
1371 const char *workdir = gretl_workdir();
1372
1373 if (opt & OPT_D) {
1374 pputs(prn, _("Variables that can be set using \"set\""));
1375 pputs(prn, " (");
1376 pputs(prn, _("\"help set\" for details"));
1377 pputs(prn, "):\n");
1378 }
1379
1380 libset_header(N_("Program interaction and behavior"), prn, opt);
1381
1382 if (opt & OPT_D) {
1383 pprintf(prn, " workdir = '%s'\n", workdir);
1384 } else if (0) {
1385 /* non-portable? */
1386 if (strchr(workdir, ' ')) {
1387 pprintf(prn, "set workdir \"%s\"\n", workdir);
1388 } else {
1389 pprintf(prn, "set workdir %s\n", workdir);
1390 }
1391 }
1392
1393 if (opt & OPT_D) {
1394 pprintf(prn, " csv_delim = %s\n", arg_from_delim(data_delim));
1395 pprintf(prn, " csv_write_na = %s\n", get_csv_na_write_string());
1396 pprintf(prn, " csv_read_na = %s\n", get_csv_na_read_string());
1397 pprintf(prn, " display_digits = %d\n", get_gretl_digits());
1398 pprintf(prn, " graph_theme = %s\n", get_plotstyle());
1399 } else {
1400 const char *dl = arg_from_delim(data_delim);
1401
1402 if (strcmp(dl, "unset")) {
1403 pprintf(prn, "set csv_delim %s\n", arg_from_delim(data_delim));
1404 }
1405 pprintf(prn, "set csv_write_na %s\n", get_csv_na_write_string());
1406 pprintf(prn, "set csv_read_na %s\n", get_csv_na_read_string());
1407 pprintf(prn, "set graph_theme %s\n", get_plotstyle());
1408 }
1409
1410 print_vars_for_category(CAT_BEHAVE, prn, opt);
1411 if (opt & OPT_D) {
1412 /* display only */
1413 libset_print_bool(SHELL_OK, NULL, prn, opt);
1414 }
1415
1416 libset_header(N_("Numerical methods"), prn, opt);
1417 print_vars_for_category(CAT_NUMERIC, prn, opt);
1418 if (opt & OPT_D) {
1419 /* script version of this? */
1420 print_state_matrix(INITVALS, prn, opt);
1421 print_state_matrix(INITCURV, prn, opt);
1422 }
1423
1424 libset_header(N_("Random number generation"), prn, opt);
1425 if (opt & OPT_D) {
1426 pprintf(prn, " seed = %u\n", gretl_rand_get_seed());
1427 } else {
1428 if (seed_is_set) {
1429 pprintf(prn, "set seed %u\n", gretl_rand_get_seed());
1430 }
1431 }
1432 if (gretl_mpi_initialized()) {
1433 libset_print_bool(USE_DCMT, NULL, prn, opt);
1434 }
1435
1436 libset_header(N_("Robust estimation"), prn, opt);
1437 print_vars_for_category(CAT_ROBUST, prn, opt);
1438
1439 libset_header(N_("Time series"), prn, opt);
1440 print_vars_for_category(CAT_TS, prn, opt);
1441
1442 pputc(prn, '\n');
1443
1444 return 0;
1445 }
1446
libset_query_settings(setvar * sv,PRN * prn)1447 static int libset_query_settings (setvar *sv, PRN *prn)
1448 {
1449 int err = 0;
1450
1451 if (libset_boolvar(sv->key)) {
1452 pprintf(prn, "%s: boolean (on/off), currently %s\n",
1453 sv->name, libset_get_bool(sv->key)? "on" : "off");
1454 } else if (coded_intvar(sv->key)) {
1455 pprintf(prn, "%s: code, currently \"%s\"\n", sv->name,
1456 libset_option_string(sv->key));
1457 coded_var_show_opts(sv->key, prn);
1458 } else if (libset_int(sv->key)) {
1459 int k = libset_get_int(sv->key);
1460
1461 if (is_unset(k)) {
1462 pprintf(prn, "%s: positive integer, currently unset\n", sv->name);
1463 } else if (libset_int_min(sv->key) == 0) {
1464 pprintf(prn, "%s: non-negative integer, currently %d\n", sv->name, k);
1465 } else {
1466 pprintf(prn, "%s: positive integer, currently %d\n", sv->name, k);
1467 }
1468 } else if (libset_double(sv->key)) {
1469 double x = libset_get_double(sv->key);
1470
1471 if (na(x)) {
1472 pprintf(prn, "%s: positive floating-point value, "
1473 "currently automatic\n", sv->name);
1474 } else {
1475 pprintf(prn, "%s: positive floating-point value, "
1476 "currently %g\n", sv->name, x);
1477 }
1478 } else if (sv->key == INITVALS || sv->key == INITCURV ||
1479 sv->key == MATMASK) {
1480 gretl_matrix *m =
1481 (sv->key == INITVALS)? state->initvals :
1482 (sv->key == INITCURV)? state->initcurv : state->matmask;
1483
1484 if (m != NULL) {
1485 pprintf(prn, "%s: matrix, currently\n", sv->name);
1486 gretl_matrix_print_to_prn(m, NULL, prn);
1487 } else {
1488 pprintf(prn, "%s: matrix, currently null\n", sv->name);
1489 }
1490 } else if (sv->key == SEED) {
1491 pprintf(prn, "%s: unsigned int, currently %u (%s)\n",
1492 sv->name, gretl_rand_get_seed(),
1493 seed_is_set ? "set by user" : "automatic");
1494 } else if (sv->key == CSV_DELIM) {
1495 pprintf(prn, "%s: named character, currently \"%s\"\n", sv->name,
1496 arg_from_delim(data_delim));
1497 coded_var_show_opts(sv->key, prn);
1498 } else if (sv->key == SV_WORKDIR) {
1499 pprintf(prn, "%s: string, currently \"%s\"\n", sv->name,
1500 gretl_workdir());
1501 } else if (sv->key == CSV_WRITE_NA) {
1502 pprintf(prn, "%s: string, currently \"%s\"\n", sv->name,
1503 state->csv_write_na);
1504 } else if (sv->key == CSV_READ_NA) {
1505 pprintf(prn, "%s: string, currently \"%s\"\n", sv->name,
1506 state->csv_read_na);
1507 } else if (sv->key == DISP_DIGITS) {
1508 pprintf(prn, "%s: integer, currently %d\n", sv->name,
1509 get_gretl_digits());
1510 } else if (sv->key == GRAPH_THEME) {
1511 pprintf(prn, "%s: keyword, currently \"%s\"\n", sv->name,
1512 get_plotstyle());
1513 } else if (sv->key == VERBOSE) {
1514 pprintf(prn, "%s: boolean (on/off), currently %s\n", sv->name,
1515 (libset_get_bool(ECHO_ON) || libset_get_bool(MSGS_ON)) ?
1516 "on" : "off");
1517 err = 0;
1518 } else {
1519 err = 1;
1520 }
1521
1522 return err;
1523 }
1524
is_libset_var(const char * s)1525 int is_libset_var (const char *s)
1526 {
1527 setvar *sv = get_setvar_by_name(s);
1528 int err = (sv == NULL);
1529
1530 if (!err) {
1531 err = libset_query_settings(sv, NULL);
1532 }
1533
1534 return (err == 0);
1535 }
1536
1537 #define default_ok(k) (k == BFGS_TOLER || k == BHHH_TOLER || k == NLS_TOLER)
1538
1539 #define default_str(s) (!strcmp(s, "auto") || !strcmp(s, "default"))
1540
1541 #define boolean_on(s) (!strcmp(s, "on") || !strcmp(s, "1") || \
1542 !strcmp(s, "true") || !strcmp(s, "TRUE"))
1543
1544 #define boolean_off(s) (!strcmp(s, "off") || !strcmp(s, "0") || \
1545 !strcmp(s, "false") || !strcmp(s, "FALSE"))
1546
write_or_read_settings(gretlopt opt,PRN * prn)1547 static int write_or_read_settings (gretlopt opt, PRN *prn)
1548 {
1549 int err = incompatible_options(opt, (OPT_T | OPT_F));
1550
1551 if (!err) {
1552 const char *fname = get_optval_string(SET, opt);
1553
1554 if (fname == NULL) {
1555 err = E_DATA;
1556 } else if (opt == OPT_T) {
1557 err = libset_write_script(fname);
1558 } else {
1559 err = real_libset_read_script(fname, prn);
1560 }
1561 }
1562
1563 return err;
1564 }
1565
check_set_bool(SetKey key,const char * name,const char * arg)1566 static int check_set_bool (SetKey key, const char *name,
1567 const char *arg)
1568 {
1569 if (boolean_on(arg)) {
1570 return libset_set_bool(key, 1);
1571 } else if (boolean_off(arg)) {
1572 return libset_set_bool(key, 0);
1573 } else {
1574 gretl_errmsg_sprintf(_("%s: invalid value '%s'"), name, arg);
1575 return E_PARSE;
1576 }
1577 }
1578
set_display_digits(const char * arg)1579 static int set_display_digits (const char *arg)
1580 {
1581 if (gretl_function_depth() > 0) {
1582 gretl_errmsg_sprintf("'%s': cannot be set inside a function",
1583 "display_digits");
1584 return E_INVARG;
1585 } else {
1586 return set_gretl_digits(atoi(arg));
1587 }
1588 }
1589
set_verbosity(const char * arg)1590 static int set_verbosity (const char *arg)
1591 {
1592 int err = 0;
1593
1594 if (!strcmp(arg, "on")) {
1595 set_gretl_messages(1);
1596 set_gretl_echo(1);
1597 } else if (!strcmp(arg, "off")) {
1598 set_gretl_messages(0);
1599 set_gretl_echo(0);
1600 comments_on = 0;
1601 } else if (!strcmp(arg, "comments")) {
1602 set_gretl_messages(0);
1603 set_gretl_echo(0);
1604 comments_on = 1;
1605 } else {
1606 err = E_INVARG;
1607 }
1608
1609 return err;
1610 }
1611
execute_set(const char * setobj,const char * setarg,DATASET * dset,gretlopt opt,PRN * prn)1612 int execute_set (const char *setobj, const char *setarg,
1613 DATASET *dset, gretlopt opt, PRN *prn)
1614 {
1615 setvar *sv = NULL;
1616 int k, argc, err;
1617 unsigned int u;
1618
1619 check_for_state();
1620
1621 if (opt != OPT_NONE) {
1622 return write_or_read_settings(opt, prn);
1623 }
1624
1625 argc = (setobj != NULL) + (setarg != NULL);
1626 if (argc == 0) {
1627 return print_settings(prn, OPT_D);
1628 }
1629
1630 sv = get_setvar_by_name(setobj);
1631 if (sv == NULL) {
1632 gretl_errmsg_sprintf(_("set: unknown variable '%s'"), setobj);
1633 return E_DATA;
1634 }
1635
1636 /* set error default */
1637 err = E_PARSE;
1638
1639 if (argc == 1) {
1640 if (sv->key == STOPWATCH) {
1641 gretl_stopwatch();
1642 return 0;
1643 } else {
1644 return libset_query_settings(sv, prn);
1645 }
1646 } else if (argc == 2) {
1647 /* specials first */
1648 if (sv->key == CSV_WRITE_NA) {
1649 return set_csv_na_write_string(setarg);
1650 } else if (sv->key == CSV_READ_NA) {
1651 return set_csv_na_read_string(setarg);
1652 } else if (sv->key == INITVALS || sv->key == INITCURV) {
1653 return set_init_matrix(sv->key, setarg, prn);
1654 } else if (sv->key == MATMASK) {
1655 return set_matrix_mask(setarg, dset);
1656 } else if (sv->key == SV_WORKDIR) {
1657 return set_workdir(setarg);
1658 } else if (sv->key == SV_LOGFILE) {
1659 return set_logfile(setarg);
1660 } else if (sv->key == GRAPH_THEME) {
1661 return set_plotstyle(setarg);
1662 } else if (sv->key == DISP_DIGITS) {
1663 return set_display_digits(setarg);
1664 } else if (sv->key == VERBOSE) {
1665 return set_verbosity(setarg);
1666 } else if (sv->key == OMP_MNK_MIN) {
1667 #if defined(_OPENMP)
1668 return set_omp_mnk_min(atoi(setarg));
1669 #else
1670 pprintf(prn, "Warning: openmp not supported\n");
1671 #endif
1672 }
1673
1674 if (libset_boolvar(sv->key)) {
1675 if (sv->key == SHELL_OK) {
1676 pprintf(prn, "'%s': this must be set via the gretl GUI\n", setobj);
1677 err = E_DATA;
1678 } else {
1679 err = check_set_bool(sv->key, setobj, setarg);
1680 }
1681 } else if (libset_double(sv->key)) {
1682 if (default_ok(sv->key) && default_str(setarg)) {
1683 libset_set_double(sv->key, NADBL);
1684 err = 0;
1685 } else {
1686 double x;
1687
1688 err = libset_get_scalar(sv->key, setarg, NULL, &x);
1689 if (!err) {
1690 err = libset_set_double(sv->key, x);
1691 }
1692 }
1693 } else if (sv->key == CSV_DELIM) {
1694 char c = delim_from_arg(setarg);
1695
1696 if (c > 0) {
1697 data_delim = c;
1698 err = 0;
1699 }
1700 } else if (sv->key == SEED) {
1701 err = libset_get_unsigned(setarg, &u);
1702 if (!err) {
1703 gretl_rand_set_seed(u);
1704 if (gretl_messages_on()) {
1705 pprintf(prn,
1706 _("Pseudo-random number generator seeded with %u\n"), u);
1707 }
1708 seed_is_set = 1;
1709 }
1710 } else if (sv->key == HORIZON) {
1711 /* horizon for VAR impulse responses */
1712 if (!strcmp(setarg, "auto")) {
1713 state->horizon = UNSET_INT;
1714 err = 0;
1715 } else {
1716 err = libset_get_scalar(sv->key, setarg, &k, NULL);
1717 if (!err) {
1718 state->horizon = k;
1719 } else {
1720 state->horizon = UNSET_INT;
1721 }
1722 }
1723 } else if (coded_intvar(sv->key)) {
1724 err = parse_libset_int_code(sv->key, setarg);
1725 } else if (libset_int(sv->key)) {
1726 err = libset_get_scalar(sv->key, setarg, &k, NULL);
1727 if (!err) {
1728 err = libset_set_int(sv->key, k);
1729 }
1730 } else {
1731 gretl_errmsg_sprintf(_("set: unknown variable '%s'"), setobj);
1732 err = E_UNKVAR;
1733 }
1734 }
1735
1736 return err;
1737 }
1738
libset_get_double(SetKey key)1739 double libset_get_double (SetKey key)
1740 {
1741 void *valp;
1742
1743 if (check_for_state()) {
1744 return NADBL;
1745 }
1746
1747 valp = setkey_get_target(key, SV_DOUBLE);
1748 if (valp != NULL) {
1749 double x = *(double *) valp;
1750
1751 if (na(x) && (key == NLS_TOLER || key == BFGS_TOLER)) {
1752 x = get_default_nls_toler();
1753 }
1754 return x;
1755 } else {
1756 fprintf(stderr, "libset_get_double: unrecognized "
1757 "key %d\n", key);
1758 return 0;
1759 }
1760 }
1761
libset_get_user_tolerance(SetKey key)1762 double libset_get_user_tolerance (SetKey key)
1763 {
1764 if (key >= NLS_TOLER && key <= BHHH_TOLER) {
1765 void *valp = setkey_get_target(key, SV_ALL);
1766
1767 return *(double *) valp;
1768 } else {
1769 return NADBL;
1770 }
1771 }
1772
libset_set_double(SetKey key,double val)1773 int libset_set_double (SetKey key, double val)
1774 {
1775 void *valp;
1776 int err = 0;
1777
1778 if (check_for_state()) {
1779 return 1;
1780 }
1781
1782 /* all the libset double vals must be positive */
1783 if (val <= 0.0 || na(val)) {
1784 return E_DATA;
1785 }
1786
1787 valp = setkey_get_target(key, SV_DOUBLE);
1788 if (valp != NULL) {
1789 *(double *) valp = val;
1790 } else {
1791 fprintf(stderr, "libset_set_double: unrecognized key %d (%s)\n",
1792 key, setkey_get_name(key));
1793 err = E_UNKVAR;
1794 }
1795
1796 return err;
1797 }
1798
libset_get_int(SetKey key)1799 int libset_get_int (SetKey key)
1800 {
1801 void *valp;
1802
1803 if (check_for_state()) {
1804 return 0;
1805 }
1806
1807 valp = setkey_get_target(key, SV_INT);
1808
1809 if (valp != NULL) {
1810 #if SVDEBUG
1811 fprintf(stderr, "libset_get_int: valp %p\n", valp);
1812 #endif
1813 if (libset_small_int(key)) {
1814 return *(gint8 *) valp;
1815 } else {
1816 return *(int *) valp;
1817 }
1818 } else if (key == BLAS_MNK_MIN) {
1819 return get_blas_mnk_min();
1820 } else if (key == OMP_N_THREADS) {
1821 return get_omp_n_threads();
1822 } else if (key == OMP_MNK_MIN) {
1823 return get_omp_mnk_min();
1824 } else if (key == SIMD_K_MAX) {
1825 return get_simd_k_max();
1826 } else if (key == SIMD_MN_MIN) {
1827 return get_simd_mn_min();
1828 } else {
1829 fprintf(stderr, "libset_get_int: unrecognized "
1830 "key %d\n", key);
1831 return 0;
1832 }
1833 }
1834
1835 struct int_limits {
1836 SetKey key;
1837 int min;
1838 int max;
1839 };
1840
get_int_limits(SetKey key,int * min,int * max)1841 static int get_int_limits (SetKey key, int *min, int *max)
1842 {
1843 static struct int_limits ilims[] = {
1844 { HC_VERSION, 0, 4 },
1845 { FDJAC_QUAL, 0, 2 },
1846 { LBFGS_MEM, 3, 20 },
1847 { GRETL_DEBUG, 0, 4 },
1848 { DATACOLS, 1, 15 },
1849 { PLOT_COLLECT, 0, 2 },
1850 { CSV_DIGITS, 1, 25 },
1851 { BOOT_ITERS, 499, 999999 },
1852 { BFGS_VERBSKIP, 0, 1000 },
1853 { BOOTREP, 1, 99999 },
1854 { HORIZON, 1, 1000 },
1855 { LOOP_MAXITER, 1, INT_MAX - 1 },
1856 { GMP_BITS, 256, 8192 }
1857 };
1858 int i;
1859
1860 for (i=0; i<G_N_ELEMENTS(ilims); i++) {
1861 if (ilims[i].key == key) {
1862 *min = ilims[i].min;
1863 *max = ilims[i].max;
1864 return 1;
1865 break;
1866 }
1867 }
1868
1869 return 0;
1870 }
1871
libset_int_min(SetKey key)1872 static int libset_int_min (SetKey key)
1873 {
1874 int m1, m0 = 1;
1875
1876 get_int_limits(key, &m0, &m1);
1877 return m0;
1878 }
1879
1880 /* Called from within libset.c and also from various places in
1881 libgretl. It's primarily designed for "real" integer variables
1882 (not int-coded categories), but for now we make an exception
1883 for HC_VERSION and PLOT_COLLECT, to support existing calls
1884 from lib/src/estimate.c and gui/settings.c.
1885 */
1886
libset_set_int(SetKey key,int val)1887 int libset_set_int (SetKey key, int val)
1888 {
1889 int err = 0;
1890
1891 if (check_for_state()) {
1892 return 1;
1893 }
1894
1895 if (key == BLAS_MNK_MIN) {
1896 set_blas_mnk_min(val);
1897 } else if (key == SIMD_K_MAX) {
1898 set_simd_k_max(val);
1899 } else if (key == SIMD_MN_MIN) {
1900 set_simd_mn_min(val);
1901 } else if (key == OMP_N_THREADS) {
1902 err = set_omp_n_threads(val);
1903 } else {
1904 int min = 1, max = 100000;
1905 void *valp;
1906
1907 get_int_limits(key, &min, &max);
1908 if (val < min || val > max) {
1909 err = E_DATA;
1910 } else {
1911 valp = setkey_get_target(key, SV_INT);
1912 if (valp == NULL) {
1913 err = E_DATA;
1914 } else if (libset_small_int(key)) {
1915 *(gint8 *) valp = val;
1916 } else {
1917 *(int *) valp = val;
1918 }
1919 }
1920 }
1921
1922 return err;
1923 }
1924
set_flag_from_env(SetKey flag,const char * s,int neg)1925 static void set_flag_from_env (SetKey flag, const char *s, int neg)
1926 {
1927 char *e = getenv(s);
1928 int action = 0;
1929
1930 if (e != NULL) {
1931 if (*e != '\0' && *e != '0') {
1932 action = (neg)? -1 : 1;
1933 } else {
1934 action = (neg)? 1 : -1;
1935 }
1936 }
1937
1938 if (action > 0) {
1939 state->flags |= flag;
1940 } else if (action < 0) {
1941 state->flags &= ~flag;
1942 }
1943 }
1944
maybe_check_env(SetKey key)1945 static void maybe_check_env (SetKey key)
1946 {
1947 if (key == USE_SVD) {
1948 set_flag_from_env(USE_SVD, "GRETL_USE_SVD", 0);
1949 } else if (key == USE_QR) {
1950 set_flag_from_env(USE_QR, "GRETL_USE_QR", 0);
1951 } else if (key == USE_LBFGS) {
1952 set_flag_from_env(USE_LBFGS, "GRETL_USE_LBFGS", 0);
1953 }
1954 }
1955
libset_get_bool(SetKey key)1956 int libset_get_bool (SetKey key)
1957 {
1958 /* global specials */
1959 if (key == R_FUNCTIONS) {
1960 return globals.R_functions;
1961 } else if (key == R_LIB) {
1962 return globals.R_lib;
1963 } else if (key == USE_DCMT) {
1964 return gretl_rand_get_dcmt();
1965 } else if (key == LOGSTAMP) {
1966 return globals.logstamp;
1967 }
1968
1969 if (check_for_state()) {
1970 return 0;
1971 } else {
1972 maybe_check_env(key);
1973 return flag_to_bool(state, key);
1974 }
1975 }
1976
libset_set_decpoint(int on)1977 static void libset_set_decpoint (int on)
1978 {
1979 #ifdef ENABLE_NLS
1980 if (on) {
1981 /* force use of the decimal dot */
1982 setlocale(LC_NUMERIC, "C");
1983 } else {
1984 /* revert to whatever is the local default */
1985 char *current = get_built_in_string_by_name("lang");
1986
1987 if (current != NULL && strcmp(current, "unknown")) {
1988 setlocale(LC_NUMERIC, current);
1989 } else {
1990 setlocale(LC_NUMERIC, "");
1991 }
1992 }
1993
1994 reset_local_decpoint();
1995 #endif
1996 }
1997
set_data_export_decimal_comma(int s)1998 void set_data_export_decimal_comma (int s)
1999 {
2000 if (s) {
2001 export_decpoint = ',';
2002 } else {
2003 export_decpoint = '.';
2004 }
2005 }
2006
get_data_export_decpoint(void)2007 char get_data_export_decpoint (void)
2008 {
2009 char c = export_decpoint;
2010
2011 /* revert to '.' on access */
2012 export_decpoint = '.';
2013 return c;
2014 }
2015
set_data_export_delimiter(char c)2016 void set_data_export_delimiter (char c)
2017 {
2018 data_delim = c;
2019 }
2020
get_data_export_delimiter(void)2021 char get_data_export_delimiter (void)
2022 {
2023 return data_delim;
2024 }
2025
check_R_setting(gint8 * var,SetKey key,int val)2026 static int check_R_setting (gint8 *var, SetKey key, int val)
2027 {
2028 int err = 0;
2029
2030 #ifdef USE_RLIB
2031 if (key == R_FUNCTIONS && val != 0) {
2032 /* This depends on having R_lib on, so in case
2033 it's off we should turn it on too.
2034 */
2035 libset_set_bool(R_LIB, val);
2036 }
2037 *var = val;
2038 #else
2039 if (val) {
2040 const char *s = (key == R_FUNCTIONS)? "R_functions" : "R_lib";
2041
2042 gretl_errmsg_sprintf("%s: not supported", s);
2043 err = E_EXTERNAL;
2044 }
2045 #endif
2046
2047 return err;
2048 }
2049
libset_set_bool(SetKey key,int val)2050 int libset_set_bool (SetKey key, int val)
2051 {
2052 if (check_for_state()) {
2053 return E_ALLOC;
2054 }
2055
2056 /* global specials */
2057 if (key == R_FUNCTIONS) {
2058 return check_R_setting(&globals.R_functions, key, val);
2059 } else if (key == R_LIB) {
2060 return check_R_setting(&globals.R_lib, key, val);
2061 } else if (key == USE_DCMT) {
2062 return gretl_rand_set_dcmt(val);
2063 } else if (key == LOGSTAMP) {
2064 globals.logstamp = val;
2065 return 0;
2066 }
2067
2068 if (val) {
2069 state->flags |= key;
2070 } else {
2071 state->flags &= ~key;
2072 }
2073
2074 if (key == FORCE_DECPOINT) {
2075 libset_set_decpoint(val);
2076 }
2077
2078 return 0;
2079 }
2080
2081 /* Mechanism for pushing and popping program state for user-defined
2082 functions. push_program_state() is used when a function starts
2083 execution: the function gets a copy of the current program state,
2084 while that state is pushed onto the stack for restoration when the
2085 function exits.
2086 */
2087
2088 #define PPDEBUG 0
2089
2090 static int n_states;
2091 static GPtrArray *state_stack;
2092 static int state_idx = -1;
2093
2094 #if PPDEBUG
print_state_stack(int pop)2095 static void print_state_stack (int pop)
2096 {
2097 set_state *sv;
2098 int i;
2099
2100 fputs(pop ? "\nafter pop:\n" : "\nafter push:\n", stderr);
2101 for (i=0; i<n_states; i++) {
2102 sv = g_ptr_array_index(state_stack, i);
2103 fprintf(stderr, "%d: %p", i, (void *) sv);
2104 fputs(sv == state ? " *\n" : "\n", stderr);
2105 }
2106 }
2107 #endif
2108
push_program_state(void)2109 int push_program_state (void)
2110 {
2111 set_state *newstate;
2112 int err = 0;
2113
2114 #if SVDEBUG
2115 fprintf(stderr, "push_program_state: n_states = %d\n", n_states);
2116 #endif
2117
2118 if (n_states == 0) {
2119 state_stack = g_ptr_array_new();
2120 }
2121
2122 state_idx++;
2123
2124 if (state_idx < n_states) {
2125 newstate = g_ptr_array_index(state_stack, state_idx);
2126 } else {
2127 newstate = malloc(sizeof *newstate);
2128 if (newstate == NULL) {
2129 err = E_ALLOC;
2130 } else {
2131 g_ptr_array_add(state_stack, newstate);
2132 n_states++;
2133 }
2134 }
2135
2136 if (newstate != NULL) {
2137 if (n_states == 1) {
2138 state_vars_init(newstate);
2139 } else {
2140 state_vars_copy(newstate);
2141 }
2142 state = newstate;
2143 }
2144
2145 #if SVDEBUG
2146 fprintf(stderr, " newstate = %p, state = %p\n",
2147 (void *) newstate, (void *) state);
2148 fprintf(stderr, " gmm_maxiter at %p, value %d\n",
2149 (void *) &(state->gmm_maxiter), state->gmm_maxiter);
2150 #endif
2151
2152 #if PPDEBUG
2153 print_state_stack(0);
2154 #endif
2155
2156 return err;
2157 }
2158
free_state(set_state * sv)2159 static void free_state (set_state *sv)
2160 {
2161 if (sv != NULL) {
2162 gretl_matrix_free(sv->initvals);
2163 gretl_matrix_free(sv->initcurv);
2164 gretl_matrix_free(sv->matmask);
2165 free(sv);
2166 }
2167 }
2168
2169 /* Called when a user-defined function exits: restores the program
2170 state that was in force when the function started executing.
2171 */
2172
pop_program_state(void)2173 int pop_program_state (void)
2174 {
2175 int err = 0;
2176
2177 if (n_states < 2) {
2178 err = 1;
2179 } else {
2180 int fdp = state->flags & FORCE_DECPOINT;
2181
2182 state_idx--;
2183 state = g_ptr_array_index(state_stack, state_idx);
2184
2185 if (fdp && !(state->flags & FORCE_DECPOINT)) {
2186 libset_set_decpoint(0);
2187 }
2188 }
2189
2190 #if PPDEBUG
2191 print_state_stack(1);
2192 #endif
2193
2194 return err;
2195 }
2196
2197 /* initialization of all user-settable settings */
2198
libset_init(void)2199 int libset_init (void)
2200 {
2201 static int done;
2202 int err = 0;
2203
2204 if (!done) {
2205 err = push_program_state();
2206 done = 1;
2207 }
2208
2209 return err;
2210 }
2211
2212 /* state variables for looping */
2213 static char *looping;
2214 static int looplen;
2215
libset_cleanup(void)2216 void libset_cleanup (void)
2217 {
2218 int i;
2219
2220 #if PDEBUG
2221 fprintf(stderr, "libset_cleanup called\n");
2222 #endif
2223
2224 for (i=0; i<n_states; i++) {
2225 free_state(g_ptr_array_index(state_stack, i));
2226 }
2227
2228 g_ptr_array_free(state_stack, TRUE);
2229 state_stack = NULL;
2230 n_states = 0;
2231 state_idx = -1;
2232
2233 free(looping);
2234 looping = NULL;
2235 looplen = 0;
2236 }
2237
2238 /* switches for looping and batch mode: output: these depend on the
2239 state of the program calling libgretl, they are not user-settable
2240 */
2241
2242 #define LDEBUG 0
2243
2244 #if LDEBUG
2245
print_looping(int on)2246 static void print_looping (int on)
2247 {
2248 char c;
2249 int i;
2250
2251 fputs(on ? "loop on: " : "loop off: ", stderr);
2252 for (i=0; i<looplen; i++) {
2253 c = looping[i] ? '1' : '0';
2254 if (i == gretl_function_depth()) {
2255 fprintf(stderr, "[%c]", c);
2256 } else {
2257 fputc(c, stderr);
2258 }
2259 }
2260 fputc('\n', stderr);
2261 }
2262
2263 #endif
2264
2265 #define LMIN 8
2266
set_loop_on(void)2267 void set_loop_on (void)
2268 {
2269 int fd = gretl_function_depth();
2270
2271 if (looping == NULL) {
2272 looplen = fd+1 < LMIN ? LMIN : fd+1;
2273 looping = calloc(1, looplen);
2274 } else if (looplen < fd+1) {
2275 int n = looplen * 2;
2276
2277 n = n < fd+1 ? fd+1 : n;
2278 looping = realloc(looping, n);
2279 memset(looping + looplen, 0, n - looplen);
2280 looplen = n;
2281 }
2282 looping[fd] = 1;
2283 #if LDEBUG
2284 print_looping(1);
2285 #endif
2286 }
2287
set_loop_off(void)2288 void set_loop_off (void)
2289 {
2290 if (looping != NULL) {
2291 looping[gretl_function_depth()] = 0;
2292 }
2293 #if LDEBUG
2294 print_looping(0);
2295 #endif
2296 }
2297
2298 /* returns 1 if there's a loop going on anywhere in the "caller
2299 ancestry" of the current execution level, else 0.
2300 */
2301
gretl_looping(void)2302 int gretl_looping (void)
2303 {
2304 int i, fd = gretl_function_depth();
2305 int n = MIN(fd+1, looplen);
2306
2307 for (i=0; i<n; i++) {
2308 if (looping[i]) {
2309 return 1;
2310 }
2311 }
2312 return 0;
2313 }
2314
2315 /* returns 1 if there's a loop going on at the current execution
2316 stack level, else 0.
2317 */
2318
gretl_looping_currently(void)2319 int gretl_looping_currently (void)
2320 {
2321 int fd = gretl_function_depth();
2322
2323 return looplen >= fd+1 && looping[fd];
2324 }
2325
2326 static int iter_depth;
2327
gretl_iteration_push(void)2328 void gretl_iteration_push (void)
2329 {
2330 iter_depth++;
2331 }
2332
gretl_iteration_pop(void)2333 void gretl_iteration_pop (void)
2334 {
2335 if (iter_depth > 0) {
2336 iter_depth--;
2337 }
2338 }
2339
gretl_iteration_depth(void)2340 int gretl_iteration_depth (void)
2341 {
2342 return iter_depth;
2343 }
2344
batch_mode_switch(int set,int val)2345 static int batch_mode_switch (int set, int val)
2346 {
2347 static int bmode;
2348
2349 if (set) {
2350 bmode = val;
2351 }
2352
2353 return bmode;
2354 }
2355
gretl_set_batch_mode(int b)2356 void gretl_set_batch_mode (int b)
2357 {
2358 batch_mode_switch(1, b);
2359 }
2360
2361 /* Returns 1 if we're running a script, otherwise 0.
2362 Note: a 0 return indicates that we're in an interactive
2363 mode, whether GUI or CLI.
2364 */
2365
gretl_in_batch_mode(void)2366 int gretl_in_batch_mode (void)
2367 {
2368 return batch_mode_switch(0, 0);
2369 }
2370
2371 static int gui_mode;
2372
2373 /* set by the GUI program at start-up */
2374
gretl_set_gui_mode(void)2375 void gretl_set_gui_mode (void)
2376 {
2377 gui_mode = 1;
2378 }
2379
2380 /* Returns 1 if we're running the GUI program. The current
2381 usage may be interactive (menu-driven or typing at the
2382 GUI "console") or script/batch. See also
2383 gretl_in_batch_mode().
2384 */
2385
gretl_in_gui_mode(void)2386 int gretl_in_gui_mode (void)
2387 {
2388 return gui_mode;
2389 }
2390
2391 /* "tool_mode" is set when gretlcli is being used as
2392 a build tool */
2393
2394 static int tool_mode;
2395
gretl_set_tool_mode(void)2396 void gretl_set_tool_mode (void)
2397 {
2398 set_gretl_echo(0);
2399 set_gretl_messages(0);
2400 tool_mode = 1;
2401 }
2402
gretl_in_tool_mode(void)2403 int gretl_in_tool_mode (void)
2404 {
2405 return tool_mode;
2406 }
2407
2408 /* mechanism to support callback for representing ongoing
2409 activity in the GUI */
2410
2411 static SHOW_ACTIVITY_FUNC sfunc;
2412
set_show_activity_func(SHOW_ACTIVITY_FUNC func)2413 void set_show_activity_func (SHOW_ACTIVITY_FUNC func)
2414 {
2415 sfunc = func;
2416 }
2417
show_activity_func_installed(void)2418 int show_activity_func_installed (void)
2419 {
2420 return sfunc != NULL;
2421 }
2422
show_activity_callback(void)2423 void show_activity_callback (void)
2424 {
2425 if (sfunc != NULL) {
2426 (*sfunc)();
2427 }
2428 }
2429
2430 /* mechanism for interactive debugging */
2431
2432 static DEBUG_READLINE dbg_readline;
2433
set_debug_read_func(DEBUG_READLINE dfunc)2434 void set_debug_read_func (DEBUG_READLINE dfunc)
2435 {
2436 dbg_readline = dfunc;
2437 }
2438
get_debug_read_func(void)2439 DEBUG_READLINE get_debug_read_func (void)
2440 {
2441 return dbg_readline;
2442 }
2443
2444 static DEBUG_OUTPUT dbg_output;
2445
set_debug_output_func(DEBUG_OUTPUT dout)2446 void set_debug_output_func (DEBUG_OUTPUT dout)
2447 {
2448 dbg_output = dout;
2449 }
2450
get_debug_output_func(void)2451 DEBUG_OUTPUT get_debug_output_func (void)
2452 {
2453 return dbg_output;
2454 }
2455
2456 /* support for GUI "Stop" button */
2457
2458 static QUERY_STOP query_stop;
2459
set_query_stop_func(QUERY_STOP query)2460 void set_query_stop_func (QUERY_STOP query)
2461 {
2462 query_stop = query;
2463 }
2464
check_for_stop(void)2465 int check_for_stop (void)
2466 {
2467 if (query_stop != NULL) {
2468 return (*query_stop)();
2469 } else {
2470 return 0;
2471 }
2472 }
2473
set_string_setvar(char * targ,const char * s,int len)2474 static int set_string_setvar (char *targ, const char *s, int len)
2475 {
2476 *targ = '\0';
2477
2478 if (*s == '"') {
2479 const char *p = strchr(s+1, '"');
2480
2481 if (p == NULL) {
2482 return E_PARSE;
2483 } else {
2484 strncat(targ, s+1, p-s-1);
2485 }
2486 } else {
2487 strncat(targ, s, len);
2488 }
2489
2490 return 0;
2491 }
2492
2493 /* for setting what we print for NAs on CSV output */
2494
get_csv_na_write_string(void)2495 const char *get_csv_na_write_string (void)
2496 {
2497 if (check_for_state()) {
2498 return "NA";
2499 } else {
2500 return state->csv_write_na;
2501 }
2502 }
2503
set_csv_na_write_string(const char * s)2504 int set_csv_na_write_string (const char *s)
2505 {
2506 if (check_for_state()) {
2507 return E_DATA;
2508 } else {
2509 return set_string_setvar(state->csv_write_na, s, 7);
2510 }
2511 }
2512
2513 /* and for setting what we read as NA on CSV input */
2514
get_csv_na_read_string(void)2515 const char *get_csv_na_read_string (void)
2516 {
2517 if (check_for_state()) {
2518 return "default";
2519 } else {
2520 return state->csv_read_na;
2521 }
2522 }
2523
set_csv_na_read_string(const char * s)2524 int set_csv_na_read_string (const char *s)
2525 {
2526 if (check_for_state()) {
2527 return E_DATA;
2528 } else {
2529 return set_string_setvar(state->csv_read_na, s, 7);
2530 }
2531 }
2532
libset_write_script(const char * fname)2533 int libset_write_script (const char *fname)
2534 {
2535 PRN *prn;
2536 int err = 0;
2537
2538 /* FIXME maybe adjust path for fname? */
2539
2540 prn = gretl_print_new_with_filename(fname, &err);
2541
2542 if (!err) {
2543 print_settings(prn, OPT_NONE);
2544 gretl_print_destroy(prn);
2545 }
2546
2547 return err;
2548 }
2549
get_quoted_arg(const char * s,int * err)2550 static char *get_quoted_arg (const char *s, int *err)
2551 {
2552 const char *p;
2553 int n = 0, matched = 0;
2554 char *ret = NULL;
2555
2556 p = s = strchr(s, '"') + 1;
2557
2558 while (*p) {
2559 if (*p == '"') {
2560 matched = 1;
2561 break;
2562 } else {
2563 n++;
2564 }
2565 p++;
2566 }
2567
2568 if (!matched) {
2569 *err = E_PARSE;
2570 } else {
2571 ret = gretl_strndup(s, n);
2572 if (ret == NULL) {
2573 *err = E_ALLOC;
2574 }
2575 }
2576
2577 return ret;
2578 }
2579
2580 /* If @prn is non-NULL we're called via the "set" command.
2581 Otherwise we're called by the gretl session apparatus.
2582 */
2583
real_libset_read_script(const char * fname,PRN * prn)2584 static int real_libset_read_script (const char *fname,
2585 PRN *prn)
2586 {
2587 FILE *fp;
2588 int err = 0;
2589
2590 fp = gretl_fopen(fname, "r");
2591
2592 if (fp == NULL) {
2593 char fullname[FILENAME_MAX];
2594
2595 strcpy(fullname, fname);
2596 gretl_addpath(fullname, 0);
2597 fp = gretl_fopen(fname, "r");
2598 if (fp == NULL) {
2599 err = E_FOPEN;
2600 }
2601 }
2602
2603 if (!err) {
2604 char setobj[32], setarg[32], line[1024];
2605 int nf;
2606
2607 while (fgets(line, sizeof line, fp)) {
2608 if (*line == '#' || string_is_blank(line)) {
2609 continue;
2610 }
2611 tailstrip(line);
2612 nf = sscanf(line, "%*s %31s %31s", setobj, setarg);
2613 if (nf == 1) {
2614 err = execute_set(setobj, NULL, NULL, OPT_NONE, prn);
2615 } else if (nf == 2) {
2616 if (*setarg == '"') {
2617 char *q = get_quoted_arg(line, &err);
2618
2619 if (!err) {
2620 err = execute_set(setobj, q, NULL, OPT_NONE, prn);
2621 free(q);
2622 }
2623 } else {
2624 err = execute_set(setobj, setarg, NULL, OPT_NONE, prn);
2625 }
2626 }
2627 if (err && prn != NULL) {
2628 break;
2629 }
2630 }
2631
2632 fclose(fp);
2633 }
2634
2635 return err;
2636 }
2637
libset_read_script(const char * fname)2638 int libset_read_script (const char *fname)
2639 {
2640 return real_libset_read_script(fname, NULL);
2641 }
2642