a68g-options.c
1 //! @file a68g-options.c
2 //! @author J. Marcel van der Veer
3
4 //! @section Copyright
5 //!
6 //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
7 //! Copyright 2001-2025 J. Marcel van der Veer [algol68g@xs4all.nl].
8
9 //! @section License
10 //!
11 //! This program is free software; you can redistribute it and/or modify it
12 //! under the terms of the GNU General Public License as published by the
13 //! Free Software Foundation; either version 3 of the License, or
14 //! (at your option) any later version.
15 //!
16 //! This program is distributed in the hope that it will be useful, but
17 //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 //! more details. You should have received a copy of the GNU General Public
20 //! License along with this program. If not, see [http://www.gnu.org/licenses/].
21
22 //! @section Synopsis
23 //!
24 //! Algol 68 Genie options.
25
26 #include "a68g.h"
27 #include "a68g-prelude.h"
28 #include "a68g-mp.h"
29 #include "a68g-options.h"
30 #include "a68g-parser.h"
31
32 // This code options to Algol68G.
33 //
34 // Option syntax does not follow GNU standards.
35 //
36 // Options come from:
37 // [1] A rc file (normally .a68grc).
38 // [2] The A68G_OPTIONS environment variable overrules [1].
39 // [3] Command line options overrule [2].
40 // [4] Pragmat items overrule [3].
41
42 //! @brief Strip minus preceeding a string.
43
44 char *strip_sign (char *p)
45 {
46 char *q = p;
47 while (q[0] == '-' || q[0] == '+') {
48 q++;
49 }
50 if (strlen (q) > 0) {
51 return new_string (q, NO_TEXT);
52 } else {
53 return p;
54 }
55 }
56
57 //! @brief Error handler for options.
58
59 void option_error (LINE_T * l, char *option, char *info)
60 {
61 if (option != NO_TEXT) {
62 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s", strip_sign (option)) >= 0);
63 if (info != NO_TEXT) {
64 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE, "%s at option \"%s\"", info, A68G (output_line)) >= 0);
65 } else {
66 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE, "at option \"%s\"", A68G (output_line)) >= 0);
67 }
68 } else if (info != NO_TEXT) {
69 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE, "%s", info) >= 0);
70 } else {
71 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE, "at option") >= 0);
72 }
73 scan_error (l, NO_TEXT, A68G (edit_line));
74 }
75
76 //! @brief Check overflow at integer multiplication.
77
78 BOOL_T int_mul_overflow (UNSIGNED_T u, UNSIGNED_T v, UNSIGNED_T max_int)
79 {
80 if (u == 0 || v == 0) {
81 return (A68G_FALSE);
82 } else {
83 return v > max_int / u;
84 }
85 }
86
87 //! @brief Set default core size.
88
89 void default_mem_sizes (INT_T n, LINE_T *start_l, char *start_c)
90 {
91 #define SET_SIZE(m, n) {\
92 if (int_mul_overflow (n, MEGABYTE, MAX_MEM_SIZE)) {\
93 option_error (start_l, start_c, ERROR_VALUE_TOO_LARGE);\
94 return;\
95 } else if ((n) * MEGABYTE + A68G (storage_overhead) > MAX_MEM_SIZE) {\
96 option_error (start_l, start_c, ERROR_VALUE_TOO_LARGE);\
97 return;\
98 } else {\
99 (m) = (n) * MEGABYTE + A68G (storage_overhead);\
100 }}
101
102 n = MAX (n, 1);
103 A68G (storage_overhead) = MEM_OVERHEAD;
104 SET_SIZE (A68G (frame_stack_size), 10 * n);
105 SET_SIZE (A68G (expr_stack_size), 5 * n);
106 SET_SIZE (A68G (heap_size), 65 * n);
107 SET_SIZE (A68G (handle_pool_size), 20 * n);
108 #undef SET_SIZE
109 }
110
111 //! @brief Read options from the .rc file.
112
113 void read_rc_options (void)
114 {
115 BUFFER name, new_name;
116 BUFCLR (name);
117 BUFCLR (new_name);
118 ASSERT (a68g_bufprt (name, SNPRINTF_SIZE, ".%src", A68G (a68g_cmd_name)) >= 0);
119 FILE *f = a68g_fopen (name, "r", new_name);
120 if (f != NO_FILE) {
121 while (!feof (f)) {
122 if (fgets (A68G (input_line), BUFFER_SIZE, f) != NO_TEXT) {
123 size_t len = strlen (A68G (input_line));
124 if (len > 0 && A68G (input_line)[len - 1] == NEWLINE_CHAR) {
125 A68G (input_line)[len - 1] = NULL_CHAR;
126 }
127 isolate_options (A68G (input_line), NO_LINE);
128 }
129 }
130 ASSERT (fclose (f) == 0);
131 (void) set_options (OPTION_LIST (&A68G_JOB), A68G_FALSE);
132 } else {
133 errno = 0;
134 }
135 }
136
137 //! @brief Read options from A68G_OPTIONS.
138
139 void read_env_options (void)
140 {
141 if (getenv ("A68G_OPTIONS") != NULL) {
142 isolate_options (getenv ("A68G_OPTIONS"), NO_LINE);
143 (void) set_options (OPTION_LIST (&A68G_JOB), A68G_FALSE);
144 errno = 0;
145 }
146 }
147
148 //! @brief Tokenise string 'p' that holds options.
149
150 void isolate_options (char *p, LINE_T * line)
151 {
152 while (p != NO_TEXT && p[0] != NULL_CHAR) {
153 // Skip white space etc.
154 while ((p[0] == BLANK_CHAR || p[0] == TAB_CHAR || p[0] == ',' || p[0] == NEWLINE_CHAR) && p[0] != NULL_CHAR) {
155 p++;
156 }
157 // ... then tokenise an item.
158 if (p[0] != NULL_CHAR) {
159 char *q;
160 // Item can be "string". Note that these are not A68 strings.
161 if (p[0] == QUOTE_CHAR || p[0] == '\'' || p[0] == '`') {
162 char delim = p[0];
163 p++;
164 // 'q' points at first significant char in item.
165 q = p;
166 while (p[0] != delim && p[0] != NULL_CHAR) {
167 p++;
168 }
169 if (p[0] != NULL_CHAR) {
170 p[0] = NULL_CHAR; // p[0] was delimiter
171 p++;
172 } else {
173 scan_error (line, NO_TEXT, ERROR_UNTERMINATED_STRING);
174 }
175 } else {
176 // Item is not a delimited string.
177 q = p;
178 // Tokenise symbol and gather it in the option list for later processing.
179 // Skip '='s, we accept if someone writes -prec=60 -heap=8192
180 if (*q == '=') {
181 p++;
182 } else {
183 // Skip item
184 while (p[0] != BLANK_CHAR && p[0] != NULL_CHAR && p[0] != '=' && p[0] != ',' && p[0] != NEWLINE_CHAR) {
185 p++;
186 }
187 }
188 if (p[0] != NULL_CHAR) {
189 p[0] = NULL_CHAR;
190 p++;
191 }
192 }
193 // 'q' points to first significant char in item, and 'p' points after item.
194 add_option_list (&(OPTION_LIST (&A68G_JOB)), q, line);
195 }
196 }
197 }
198
199 //! @brief Set default values for options.
200
201 void default_options (MODULE_T * p)
202 {
203 OPTION_BACKTRACE (p) = A68G_FALSE;
204 OPTION_BRACKETS (p) = A68G_FALSE;
205 OPTION_CHECK_ONLY (p) = A68G_FALSE;
206 OPTION_CLOCK (p) = A68G_FALSE;
207 OPTION_COMPILE_CHECK (p) = A68G_FALSE;
208 OPTION_COMPILE (p) = A68G_FALSE;
209 OPTION_CONSERVATIVE_GC (p) = A68G_GC_GO;
210 OPTION_CROSS_REFERENCE (p) = A68G_FALSE;
211 OPTION_DEBUG (p) = A68G_FALSE;
212 OPTION_FOLD (p) = A68G_FALSE;
213 OPTION_INDENT (p) = 2;
214 OPTION_KEEP (p) = A68G_FALSE;
215 OPTION_LICENSE (p) = A68G_FALSE;
216 OPTION_MOID_LISTING (p) = A68G_FALSE;
217 OPTION_NODEMASK (p) = (STATUS_MASK_T) (ASSERT_MASK | SOURCE_MASK);
218 OPTION_NO_NOTICES (p) = A68G_TRUE;
219 OPTION_NO_WARNINGS (p) = A68G_FALSE;
220 OPTION_OPT_LEVEL (p) = NO_OPTIMISE;
221 OPTION_PORTCHECK (p) = A68G_FALSE;
222 OPTION_PRAGMAT_SEMA (p) = A68G_TRUE;
223 OPTION_PRETTY (p) = A68G_FALSE;
224 OPTION_QUIET (p) = A68G_FALSE;
225 OPTION_REDUCTIONS (p) = A68G_FALSE;
226 OPTION_REGRESSION_TEST (p) = A68G_FALSE;
227 OPTION_RERUN (p) = A68G_FALSE;
228 OPTION_RUN (p) = A68G_FALSE;
229 OPTION_RUN_SCRIPT (p) = A68G_FALSE;
230 OPTION_SOURCE_LISTING (p) = A68G_FALSE;
231 OPTION_STANDARD_PRELUDE_LISTING (p) = A68G_FALSE;
232 OPTION_STATISTICS_LISTING (p) = A68G_FALSE;
233 OPTION_STRICT (p) = A68G_FALSE;
234 OPTION_STROPPING (p) = UPPER_STROPPING;
235 OPTION_TIME_LIMIT (p) = 0;
236 OPTION_TRACE (p) = A68G_FALSE;
237 OPTION_TREE_LISTING (p) = A68G_FALSE;
238 OPTION_UNUSED (p) = A68G_FALSE;
239 OPTION_VERBOSE (p) = A68G_FALSE;
240 OPTION_VERSION (p) = A68G_FALSE;
241 set_long_mp_digits (0);
242 }
243
244 //! @brief Add an option to the list, to be processed later.
245
246 void add_option_list (OPTION_LIST_T ** l, char *str, LINE_T * line)
247 {
248 if (*l == NO_OPTION_LIST) {
249 *l = (OPTION_LIST_T *) get_heap_space (SIZE_ALIGNED (OPTION_LIST_T));
250 SCAN (*l) = SOURCE_SCAN (&A68G_JOB);
251 STR (*l) = new_string (str, NO_TEXT);
252 PROCESSED (*l) = A68G_FALSE;
253 LINE (*l) = line;
254 NEXT (*l) = NO_OPTION_LIST;
255 } else {
256 add_option_list (&(NEXT (*l)), str, line);
257 }
258 }
259
260 //! @brief Free an option list.
261
262 void free_option_list (OPTION_LIST_T * l)
263 {
264 if (l != NO_OPTION_LIST) {
265 free_option_list (NEXT (l));
266 a68g_free (STR (l));
267 a68g_free (l);
268 }
269 }
270
271 //! @brief Initialise option handler.
272
273 void init_options (void)
274 {
275 A68G (options) = (OPTIONS_T *) a68g_alloc (SIZE_ALIGNED (OPTIONS_T), __func__, __LINE__);
276 OPTION_LIST (&A68G_JOB) = NO_OPTION_LIST;
277 }
278
279 //! @brief Test equality of p and q, upper case letters in q are mandatory.
280
281 static inline BOOL_T eq (char *p, char *q)
282 {
283 // Upper case letters in 'q' are mandatory, lower case must match.
284 if (OPTION_PRAGMAT_SEMA (&A68G_JOB)) {
285 return match_string (p, q, '=');
286 } else {
287 return A68G_FALSE;
288 }
289 }
290
291 //! @brief Process echoes gathered in the option list.
292
293 void prune_echoes (OPTION_LIST_T * ol)
294 {
295 while (ol != NO_OPTION_LIST) {
296 if (SCAN (ol) == SOURCE_SCAN (&A68G_JOB)) {
297 char *p = strip_sign (STR (ol));
298 // ECHO echoes a string.
299 if (eq (p, "ECHO")) {
300 {
301 char *car = strchr (p, '=');
302 if (car != NO_TEXT) {
303 io_close_tty_line ();
304 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s", &car[1]) >= 0);
305 WRITE (A68G_STDOUT, A68G (output_line));
306 } else {
307 FORWARD (ol);
308 if (ol != NO_OPTION_LIST) {
309 if (strcmp (STR (ol), "=") == 0) {
310 FORWARD (ol);
311 }
312 if (ol != NO_OPTION_LIST) {
313 io_close_tty_line ();
314 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s", STR (ol)) >= 0);
315 WRITE (A68G_STDOUT, A68G (output_line));
316 }
317 }
318 }
319 }
320 }
321 a68g_free (p);
322 }
323 if (ol != NO_OPTION_LIST) {
324 FORWARD (ol);
325 }
326 }
327 }
328
329 //! @brief Translate integral option argument.
330
331 static UNSIGNED_T fetch_integral (char *p, OPTION_LIST_T ** i, BOOL_T * error, UNSIGNED_T max_int)
332 {
333 LINE_T *start_l = LINE (*i);
334 char *start_c = STR (*i);
335 char *car = NO_TEXT, *num = NO_TEXT;
336 *error = A68G_FALSE;
337 // Fetch argument.
338 car = strchr (p, '=');
339 if (car == NO_TEXT) {
340 FORWARD (*i);
341 *error = (BOOL_T) (*i == NO_OPTION_LIST);
342 if (!*error && strcmp (STR (*i), "=") == 0) {
343 FORWARD (*i);
344 *error = (BOOL_T) (*i == NO_OPTION_LIST);
345 }
346 if (!*error) {
347 num = STR (*i);
348 }
349 } else {
350 num = &car[1];
351 *error = (BOOL_T) (num[0] == NULL_CHAR);
352 }
353 // Translate argument into integer.
354 if (*error) {
355 option_error (start_l, start_c, ERROR_MISSING_STUFF);
356 return 0;
357 } else {
358 if (num[0] == '-') {
359 option_error (start_l, start_c, ERROR_INVALID_VALUE);
360 return 0;
361 }
362 char *suffix;
363 errno = 0;
364 #if (A68G_LEVEL >= 3)
365 UNSIGNED_T mult = 1, value = (UNSIGNED_T) strtoul (num, &suffix, 0);
366 #else
367 UNSIGNED_T mult = 1, value = (UNSIGNED_T) strtoull (num, &suffix, 0);
368 #endif
369 *error = (BOOL_T) (suffix == num);
370 if (errno != 0 || *error) {
371 option_error (start_l, start_c, ERROR_INVALID_VALUE);
372 *error = A68G_TRUE;
373 } else if (value < 0) {
374 option_error (start_l, start_c, ERROR_INVALID_VALUE);
375 *error = A68G_TRUE;
376 } else {
377 // Accept suffix multipliers: 32k, 64M, 1G, (2T, 1P).
378 if (suffix != NO_TEXT) {
379 switch (suffix[0]) {
380 case NULL_CHAR: {
381 mult = 1;
382 break;
383 }
384 case 'k':
385 case 'K': {
386 mult = KILOBYTE;
387 break;
388 }
389 case 'm':
390 case 'M': {
391 mult = MEGABYTE;
392 break;
393 }
394 case 'g':
395 case 'G': {
396 mult = GIGABYTE;
397 break;
398 }
399 #if defined (TERABYTE)
400 case 't':
401 case 'T': {
402 mult = TERABYTE;
403 break;
404 }
405 #endif
406 #if defined (PETABYTE)
407 case 'p':
408 case 'P': {
409 mult = PETABYTE;
410 break;
411 }
412 #endif
413 default: {
414 option_error (start_l, start_c, ERROR_INVALID_VALUE);
415 *error = A68G_TRUE;
416 break;
417 }
418 }
419 if (suffix[0] != NULL_CHAR && suffix[1] != NULL_CHAR) {
420 option_error (start_l, start_c, ERROR_INVALID_VALUE);
421 *error = A68G_TRUE;
422 }
423 }
424 }
425 // Check overflow.
426 if (int_mul_overflow (value, mult, max_int)) {
427 option_error (start_l, start_c, ERROR_VALUE_TOO_LARGE);
428 return 0;
429 } else {
430 return value * mult;
431 }
432 }
433 }
434
435 //! @brief Dump technical information.
436
437 static void tech_stuff (void)
438 {
439 state_version (A68G_STDOUT);
440 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_REF) = " A68G_LU, (UNSIGNED_T) sizeof (A68G_REF)) >= 0);
441 WRITELN (A68G_STDOUT, A68G (output_line));
442 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_PROCEDURE) = " A68G_LU, (UNSIGNED_T) sizeof (A68G_PROCEDURE)) >= 0);
443 WRITELN (A68G_STDOUT, A68G (output_line));
444 #if (A68G_LEVEL >= 3)
445 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (DOUBLE_T) = " A68G_LU, (UNSIGNED_T) sizeof (DOUBLE_T)) >= 0);
446 WRITELN (A68G_STDOUT, A68G (output_line));
447 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (DOUBLE_NUM_T) = " A68G_LU, (UNSIGNED_T) sizeof (DOUBLE_NUM_T)) >= 0);
448 WRITELN (A68G_STDOUT, A68G (output_line));
449 #endif
450 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_INT) = " A68G_LU, (UNSIGNED_T) sizeof (A68G_INT)) >= 0);
451 WRITELN (A68G_STDOUT, A68G (output_line));
452 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_REAL) = " A68G_LU, (UNSIGNED_T) sizeof (A68G_REAL)) >= 0);
453 WRITELN (A68G_STDOUT, A68G (output_line));
454 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_BOOL) = " A68G_LU, (UNSIGNED_T) sizeof (A68G_BOOL)) >= 0);
455 WRITELN (A68G_STDOUT, A68G (output_line));
456 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_CHAR) = " A68G_LU, (UNSIGNED_T) sizeof (A68G_CHAR)) >= 0);
457 WRITELN (A68G_STDOUT, A68G (output_line));
458 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_BITS) = " A68G_LU, (UNSIGNED_T) sizeof (A68G_BITS)) >= 0);
459 WRITELN (A68G_STDOUT, A68G (output_line));
460 #if (A68G_LEVEL >= 3)
461 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_LONG_INT) = " A68G_LU, (UNSIGNED_T) sizeof (A68G_LONG_INT)) >= 0);
462 WRITELN (A68G_STDOUT, A68G (output_line));
463 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_LONG_REAL) = " A68G_LU, (UNSIGNED_T) sizeof (A68G_LONG_REAL)) >= 0);
464 WRITELN (A68G_STDOUT, A68G (output_line));
465 #else
466 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_LONG_REAL) = " A68G_LU, (UNSIGNED_T) size_mp ()) >= 0);
467 WRITELN (A68G_STDOUT, A68G (output_line));
468 #endif
469 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (A68G_LONG_LONG_REAL) = " A68G_LU, (UNSIGNED_T) (UNSIGNED_T) SIZE_MP (LONG_LONG_MP_DIGITS)) >= 0);
470 WRITELN (A68G_STDOUT, A68G (output_line));
471 WRITELN (A68G_STDOUT, "");
472 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (INT_T) = " A68G_LU, (UNSIGNED_T) sizeof (INT_T)) >= 0);
473 WRITELN (A68G_STDOUT, A68G (output_line));
474 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (UNSIGNED_T) = " A68G_LU, (UNSIGNED_T) sizeof (UNSIGNED_T)) >= 0);
475 WRITELN (A68G_STDOUT, A68G (output_line));
476 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (a68g_off_t) = " A68G_LU, (UNSIGNED_T) sizeof (a68g_off_t)) >= 0);
477 WRITELN (A68G_STDOUT, A68G (output_line));
478 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (size_t) = " A68G_LU, (UNSIGNED_T) sizeof (size_t)) >= 0);
479 WRITELN (A68G_STDOUT, A68G (output_line));
480 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "sizeof (ssize_t) = " A68G_LU, (UNSIGNED_T) sizeof (ssize_t)) >= 0);
481 WRITELN (A68G_STDOUT, A68G (output_line));
482 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "UPB size_t = " A68G_LU, (UNSIGNED_T) MAX_MEM_SIZE) >= 0);
483 WRITELN (A68G_STDOUT, A68G (output_line));
484 WRITELN (A68G_STDOUT, "");
485 exit (EXIT_SUCCESS);
486 }
487
488 //! @brief Process options gathered in the option list.
489
490 BOOL_T need_library (OPTION_LIST_T *i)
491 {
492 char *q = strip_sign (STR (i));
493 if (eq (q, "compiler")) {
494 #if defined (BUILD_A68G_COMPILER)
495 return (A68G_TRUE);
496 #else
497 io_close_tty_line ();
498 WRITE (A68G_STDERR, "plugin compiler required - exiting graciously");
499 a68g_exit (EXIT_SUCCESS);
500 #endif
501 }
502 if (eq (q, "curl")) {
503 #if defined (HAVE_CURL)
504 return (A68G_TRUE);
505 #else
506 io_close_tty_line ();
507 WRITE (A68G_STDERR, "curl library required - exiting graciously");
508 a68g_exit (EXIT_SUCCESS);
509 #endif
510 }
511 if (eq (q, "curses")) {
512 #if defined (HAVE_CURSES)
513 return (A68G_TRUE);
514 #else
515 io_close_tty_line ();
516 WRITE (A68G_STDERR, "curses required - exiting graciously");
517 a68g_exit (EXIT_SUCCESS);
518 #endif
519 }
520 if (eq (q, "gsl")) {
521 #if defined (HAVE_GSL)
522 return (A68G_TRUE);
523 #else
524 io_close_tty_line ();
525 WRITE (A68G_STDERR, "GNU Scientific Library required - exiting graciously");
526 a68g_exit (EXIT_SUCCESS);
527 #endif
528 }
529 if (eq (q, "http")) {
530 #if !defined (HAVE_CURL)
531 io_close_tty_line ();
532 WRITELN (A68G_STDERR, "curl required - exiting graciously");
533 a68g_exit (EXIT_SUCCESS);
534 #else
535 return (A68G_TRUE);
536 #endif
537 }
538 if (eq (q, "ieee")) {
539 #if defined (HAVE_IEEE_754)
540 return (A68G_TRUE);
541 #else
542 io_close_tty_line ();
543 WRITE (A68G_STDERR, "IEEE required - exiting graciously");
544 a68g_exit (EXIT_SUCCESS);
545 #endif
546 }
547 if (eq (q, "linux")) {
548 #if defined (BUILD_LINUX)
549 return (A68G_TRUE);
550 #else
551 io_close_tty_line ();
552 WRITE (A68G_STDERR, "linux required - exiting graciously");
553 a68g_exit (EXIT_SUCCESS);
554 #endif
555 }
556 if (eq (q, "mathlib")) {
557 #if defined (HAVE_MATHLIB)
558 return (A68G_TRUE);
559 #else
560 io_close_tty_line ();
561 WRITE (A68G_STDERR, "R mathlib required - exiting graciously");
562 a68g_exit (EXIT_SUCCESS);
563 #endif
564 }
565 if (eq (q, "mpfr")) {
566 #if defined (HAVE_GNU_MPFR)
567 return (A68G_TRUE);
568 #else
569 io_close_tty_line ();
570 WRITE (A68G_STDERR, "GNU MPFR required - exiting graciously");
571 a68g_exit (EXIT_SUCCESS);
572 #endif
573 }
574 if (eq (q, "plotutils")) {
575 #if defined (HAVE_GNU_PLOTUTILS)
576 return (A68G_TRUE);
577 #else
578 io_close_tty_line ();
579 WRITE (A68G_STDERR, "GNU plotutils required - exiting graciously");
580 a68g_exit (EXIT_SUCCESS);
581 #endif
582 }
583 if (eq (q, "postgresql")) {
584 #if defined (HAVE_POSTGRESQL)
585 return (A68G_TRUE);
586 #else
587 io_close_tty_line ();
588 WRITE (A68G_STDERR, "postgresql required - exiting graciously");
589 a68g_exit (EXIT_SUCCESS);
590 #endif
591 }
592 if (eq (q, "threads")) {
593 #if defined (BUILD_PARALLEL_CLAUSE)
594 return (A68G_TRUE);
595 #else
596 io_close_tty_line ();
597 WRITE (A68G_STDERR, "POSIX threads required - exiting graciously");
598 a68g_exit (EXIT_SUCCESS);
599 #endif
600 }
601 return A68G_FALSE;
602 }
603
604 //! @brief Process options gathered in the option list.
605
606 BOOL_T set_options (OPTION_LIST_T *i, BOOL_T cmd_line)
607 {
608 BOOL_T siga = A68G_TRUE, name_set = A68G_FALSE, skip = A68G_FALSE;
609 OPTION_LIST_T *j = i;
610 errno = 0;
611 while (i != NO_OPTION_LIST && siga) {
612 // Once SCRIPT is processed we skip options on the command line.
613 if (cmd_line && skip) {
614 FORWARD (i);
615 } else {
616 LINE_T *start_l = LINE (i);
617 char *start_c = STR (i);
618 size_t n = strlen (STR (i));
619 // Allow for spaces ending in # to have A68 comment syntax with '#!'.
620 while (n > 0 && (IS_SPACE ((STR (i))[n - 1]) || (STR (i))[n - 1] == '#')) {
621 (STR (i))[--n] = NULL_CHAR;
622 }
623 if (!(PROCESSED (i))) {
624 // Accept UNIX '-option [=] value'.
625 BOOL_T minus_sign = (BOOL_T) ((STR (i))[0] == '-');
626 char *p = strip_sign (STR (i));
627 if (!minus_sign && eq (p, "#")) {
628 ;
629 } else if (!minus_sign && cmd_line) {
630 // Item without '-'s is a filename.
631 if (!name_set) {
632 FILE_INITIAL_NAME (&A68G_JOB) = new_string (p, NO_TEXT);
633 name_set = A68G_TRUE;
634 } else {
635 option_error (NO_LINE, start_c, ERROR_MULTIPLE_SOURCE_FILES);
636 }
637 } else if (eq (p, "INCLUDE")) {
638 // Preprocessor items stop option processing.
639 siga = A68G_FALSE;
640 } else if (eq (p, "READ")) {
641 siga = A68G_FALSE;
642 } else if (eq (p, "PREPROCESSOR")) {
643 siga = A68G_FALSE;
644 } else if (eq (p, "NOPREPROCESSOR")) {
645 siga = A68G_FALSE;
646 } else if (eq (p, "TECHnicalities")) {
647 // TECH prints out some tech stuff.
648 tech_stuff ();
649 }
650 // EXIT stops option processing.
651 else if (eq (p, "EXIT")) {
652 siga = A68G_FALSE;
653 }
654 // Empty item (from specifying '-' or '--') stops option processing.
655 else if (eq (p, "-") || eq (p, "--")) {
656 siga = A68G_FALSE;
657 }
658 // FILE accepts its argument as filename.
659 else if (eq (p, "File") && cmd_line) {
660 FORWARD (i);
661 if (i != NO_OPTION_LIST && strcmp (STR (i), "=") == 0) {
662 FORWARD (i);
663 }
664 if (i != NO_OPTION_LIST) {
665 if (!name_set) {
666 FILE_INITIAL_NAME (&A68G_JOB) = new_string (STR (i), NO_TEXT);
667 name_set = A68G_TRUE;
668 } else {
669 option_error (start_l, start_c, ERROR_MULTIPLE_SOURCE_FILES);
670 }
671 } else {
672 option_error (start_l, start_c, ERROR_MISSING_STUFF);
673 }
674 }
675 // NEED or LIBrary require the argument as environ.
676 else if (eq (p, "NEED") || eq (p, "LIBrary")) {
677 FORWARD (i);
678 if (i == NO_OPTION_LIST) {
679 option_error (start_l, start_c, ERROR_MISSING_STUFF);
680 } else {
681 OPTION_LIST_T *save = i; BOOL_T good = A68G_FALSE;
682 do {
683 good = need_library (i);
684 if (good) {
685 save = i;
686 FORWARD (i);
687 } else {
688 i = save;
689 }
690 } while (good && i != NO_OPTION_LIST);
691 }
692 }
693 // SCRIPT takes next argument as filename.
694 // Further options on the command line are not processed, but stored.
695 else if (eq (p, "Script") && cmd_line) {
696 FORWARD (i);
697 if (i != NO_OPTION_LIST) {
698 if (!name_set) {
699 FILE_INITIAL_NAME (&A68G_JOB) = new_string (STR (i), NO_TEXT);
700 name_set = A68G_TRUE;
701 } else {
702 option_error (start_l, start_c, ERROR_MULTIPLE_SOURCE_FILES);
703 }
704 } else {
705 option_error (start_l, start_c, ERROR_MISSING_STUFF);
706 }
707 skip = A68G_TRUE;
708 }
709 // VERIFY checks that argument is current a68g version number.
710 else if (eq (p, "VERIFY")) {
711 FORWARD (i);
712 if (i != NO_OPTION_LIST && strcmp (STR (i), "=") == 0) {
713 FORWARD (i);
714 }
715 if (i != NO_OPTION_LIST) {
716 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s verification \"%s\" does not match script verification \"%s\"", A68G (a68g_cmd_name), PACKAGE_STRING, STR (i)) >= 0);
717 ABEND (strcmp (PACKAGE_STRING, STR (i)) != 0, new_string (A68G (output_line), __func__), "outdated script");
718 } else {
719 option_error (start_l, start_c, ERROR_MISSING_STUFF);
720 }
721 }
722 // HELP gives online help.
723 else if ((eq (p, "APropos") || eq (p, "Help") || eq (p, "INfo")) && cmd_line) {
724 FORWARD (i);
725 if (i != NO_OPTION_LIST && strcmp (STR (i), "=") == 0) {
726 FORWARD (i);
727 }
728 if (i != NO_OPTION_LIST) {
729 apropos (A68G_STDOUT, NO_TEXT, STR (i));
730 } else {
731 apropos (A68G_STDOUT, NO_TEXT, "options");
732 }
733 a68g_exit (EXIT_SUCCESS);
734 }
735 // ECHO is treated later.
736 else if (eq (p, "ECHO")) {
737 if (strchr (p, '=') == NO_TEXT) {
738 FORWARD (i);
739 if (i != NO_OPTION_LIST) {
740 if (strcmp (STR (i), "=") == 0) {
741 FORWARD (i);
742 }
743 }
744 }
745 }
746 // EXECUTE and PRINT execute their argument as Algol 68 text.
747 else if (eq (p, "Execute") || eq (p, "X") || eq (p, "Print")) {
748 if (cmd_line == A68G_FALSE) {
749 option_error (start_l, start_c, ERROR_COMMAND_LINE);
750 } else if ((FORWARD (i)) != NO_OPTION_LIST) {
751 BOOL_T error = A68G_FALSE;
752 if (strcmp (STR (i), "=") == 0) {
753 error = (BOOL_T) ((FORWARD (i)) == NO_OPTION_LIST);
754 }
755 if (!error) {
756 BUFFER name, new_name;
757 int s_errno = errno;
758 a68g_bufcpy (name, HIDDEN_TEMP_FILE_NAME, BUFFER_SIZE);
759 a68g_bufcat (name, ".a68", BUFFER_SIZE);
760 FILE *f = a68g_fopen (name, "w", new_name);
761 ABEND (f == NO_FILE, ERROR_ACTION, __func__);
762 errno = s_errno;
763 if (eq (p, "Execute") || eq (p, "X")) {
764 fprintf (f, "(%s)\n", STR (i));
765 } else {
766 fprintf (f, "(print (((%s), new line)))\n", STR (i));
767 }
768 ASSERT (fclose (f) == 0);
769 FILE_INITIAL_NAME (&A68G_JOB) = new_string (new_name, NO_TEXT);
770 } else {
771 option_error (start_l, start_c, ERROR_MISSING_STUFF);
772 }
773 } else {
774 option_error (start_l, start_c, ERROR_MISSING_STUFF);
775 }
776 }
777 // STORAGE, HEAP, HANDLES, STACK, FRAME and OVERHEAD set core allocation.
778 else if (eq (p, "STOrage")) {
779 BOOL_T error = A68G_FALSE;
780 INT_T k = fetch_integral (p, &i, &error, MAX_MEM_SIZE);
781
782 // Adjust size.
783 if (error || errno > 0) {
784 option_error (start_l, start_c, ERROR_MISSING_STUFF);
785 } else if (k > 0) {
786 default_mem_sizes (k, start_l, start_c);
787 }
788 } else if (eq (p, "HEAP") || eq (p, "HANDLES") || eq (p, "STACK") || eq (p, "FRAME") || eq (p, "OVERHEAD")) {
789 BOOL_T error = A68G_FALSE;
790 INT_T k = fetch_integral (p, &i, &error, MAX_MEM_SIZE);
791 // Adjust size.
792 if (error || errno > 0) {
793 option_error (start_l, start_c, ERROR_INVALID_VALUE);
794 } else if (k > 0) {
795 if (k < A68G (storage_overhead)) {
796 option_error (start_l, start_c, ERROR_INVALID_VALUE);
797 k = A68G (storage_overhead);
798 }
799 storage_limit (k + A68G (storage_overhead));
800 if (eq (p, "HEAP")) {
801 A68G (heap_size) = k;
802 } else if (eq (p, "HANDLES")) {
803 A68G (handle_pool_size) = k;
804 } else if (eq (p, "STACK")) {
805 A68G (expr_stack_size) = k;
806 } else if (eq (p, "FRAME")) {
807 A68G (frame_stack_size) = k;
808 } else if (eq (p, "OVERHEAD")) {
809 A68G (storage_overhead) = k;
810 }
811 }
812 }
813 // COMPILE and NOCOMPILE switch on/off compilation.
814 else if (eq (p, "Compile")) {
815 #if defined (BUILD_LINUX) || defined (BUILD_BSD)
816 OPTION_COMPILE (&A68G_JOB) = A68G_TRUE;
817 OPTION_COMPILE_CHECK (&A68G_JOB) = A68G_TRUE;
818 if (OPTION_OPT_LEVEL (&A68G_JOB) < OPTIMISE_1) {
819 OPTION_OPT_LEVEL (&A68G_JOB) = OPTIMISE_1;
820 }
821 OPTION_RUN_SCRIPT (&A68G_JOB) = A68G_FALSE;
822 #else
823 option_error (start_l, start_c, ERROR_PLATFORM);
824 #endif
825 } else if (eq (p, "NOCompile") || eq (p, "NO-Compile")) {
826 OPTION_COMPILE (&A68G_JOB) = A68G_FALSE;
827 OPTION_RUN_SCRIPT (&A68G_JOB) = A68G_FALSE;
828 }
829 // OPTIMISE and NOOPTIMISE switch on/off optimisation.
830 else if (eq (p, "NOOptimize") || eq (p, "NO-Optimize")) {
831 OPTION_OPT_LEVEL (&A68G_JOB) = NO_OPTIMISE;
832 } else if (eq (p, "O0")) {
833 OPTION_OPT_LEVEL (&A68G_JOB) = NO_OPTIMISE;
834 } else if (eq (p, "OG")) {
835 OPTION_COMPILE_CHECK (&A68G_JOB) = A68G_TRUE;
836 OPTION_OPT_LEVEL (&A68G_JOB) = OPTIMISE_0;
837 } else if (eq (p, "OPTimise") || eq (p, "OPTimize")) {
838 OPTION_COMPILE_CHECK (&A68G_JOB) = A68G_TRUE;
839 OPTION_OPT_LEVEL (&A68G_JOB) = OPTIMISE_1;
840 } else if (eq (p, "O") || eq (p, "O1")) {
841 OPTION_COMPILE_CHECK (&A68G_JOB) = A68G_TRUE;
842 OPTION_OPT_LEVEL (&A68G_JOB) = OPTIMISE_1;
843 } else if (eq (p, "O2")) {
844 OPTION_COMPILE_CHECK (&A68G_JOB) = A68G_FALSE;
845 OPTION_OPT_LEVEL (&A68G_JOB) = OPTIMISE_2;
846 } else if (eq (p, "O3")) {
847 OPTION_COMPILE_CHECK (&A68G_JOB) = A68G_FALSE;
848 OPTION_OPT_LEVEL (&A68G_JOB) = OPTIMISE_3;
849 } else if (eq (p, "Ofast")) {
850 OPTION_COMPILE_CHECK (&A68G_JOB) = A68G_FALSE;
851 OPTION_OPT_LEVEL (&A68G_JOB) = OPTIMISE_FAST;
852 }
853 // ERROR-CHECK generates (some) runtime checks for O2, O3, Ofast.
854 else if (eq (p, "ERRor-check")) {
855 OPTION_COMPILE_CHECK (&A68G_JOB) = A68G_TRUE;
856 }
857 // RUN-SCRIPT runs a compiled .sh script.
858 else if (eq (p, "RUN-SCRIPT")) {
859 #if defined (BUILD_LINUX) || defined (BUILD_BSD)
860 FORWARD (i);
861 if (i != NO_OPTION_LIST) {
862 if (!name_set) {
863 FILE_INITIAL_NAME (&A68G_JOB) = new_string (STR (i), NO_TEXT);
864 name_set = A68G_TRUE;
865 } else {
866 option_error (start_l, start_c, ERROR_MULTIPLE_SOURCE_FILES);
867 }
868 } else {
869 option_error (start_l, start_c, ERROR_MISSING_STUFF);
870 }
871 skip = A68G_TRUE;
872 OPTION_RUN_SCRIPT (&A68G_JOB) = A68G_TRUE;
873 OPTION_NO_NOTICES (&A68G_JOB) = A68G_TRUE;
874 OPTION_NO_WARNINGS (&A68G_JOB) = A68G_TRUE;
875 OPTION_COMPILE (&A68G_JOB) = A68G_FALSE;
876 #else
877 option_error (start_l, start_c, ERROR_PLATFORM);
878 #endif
879 }
880 // RUN-QUOTE-SCRIPT runs a compiled .sh script.
881 else if (eq (p, "RUN-QUOTE-SCRIPT")) {
882 #if defined (BUILD_LINUX) || defined (BUILD_BSD)
883 FORWARD (i);
884 if (i != NO_OPTION_LIST) {
885 if (!name_set) {
886 FILE_INITIAL_NAME (&A68G_JOB) = new_string (STR (i), NO_TEXT);
887 name_set = A68G_TRUE;
888 } else {
889 option_error (start_l, start_c, ERROR_MULTIPLE_SOURCE_FILES);
890 }
891 } else {
892 option_error (start_l, start_c, ERROR_MISSING_STUFF);
893 }
894 skip = A68G_TRUE;
895 OPTION_RUN_SCRIPT (&A68G_JOB) = A68G_TRUE;
896 OPTION_STROPPING (&A68G_JOB) = QUOTE_STROPPING;
897 OPTION_COMPILE (&A68G_JOB) = A68G_FALSE;
898 #else
899 option_error (start_l, start_c, ERROR_PLATFORM);
900 #endif
901 }
902 // RERUN re-uses an existing .so file.
903 else if (eq (p, "RERUN")) {
904 OPTION_COMPILE (&A68G_JOB) = A68G_FALSE;
905 OPTION_RERUN (&A68G_JOB) = A68G_TRUE;
906 if (OPTION_OPT_LEVEL (&A68G_JOB) < OPTIMISE_1) {
907 OPTION_OPT_LEVEL (&A68G_JOB) = OPTIMISE_1;
908 }
909 }
910 // KEEP and NOKEEP switch off/on object file deletion.
911 else if (eq (p, "KEEP")) {
912 OPTION_KEEP (&A68G_JOB) = A68G_TRUE;
913 } else if (eq (p, "NOKEEP")) {
914 OPTION_KEEP (&A68G_JOB) = A68G_FALSE;
915 } else if (eq (p, "NO-KEEP")) {
916 OPTION_KEEP (&A68G_JOB) = A68G_FALSE;
917 }
918 // BRACKETS extends Algol 68 syntax for brackets.
919 else if (eq (p, "BRackets")) {
920 OPTION_BRACKETS (&A68G_JOB) = A68G_TRUE;
921 }
922 // PRETTY and INDENT perform basic pretty printing.
923 // This is meant for synthetic code.
924 else if (eq (p, "PRETty-print")) {
925 OPTION_PRETTY (&A68G_JOB) = A68G_TRUE;
926 OPTION_CHECK_ONLY (&A68G_JOB) = A68G_TRUE;
927 } else if (eq (p, "INDENT")) {
928 OPTION_PRETTY (&A68G_JOB) = A68G_TRUE;
929 OPTION_CHECK_ONLY (&A68G_JOB) = A68G_TRUE;
930 }
931 // FOLD performs constant folding in basic lay-out formatting..
932 else if (eq (p, "FOLD")) {
933 OPTION_INDENT (&A68G_JOB) = A68G_TRUE;
934 OPTION_FOLD (&A68G_JOB) = A68G_TRUE;
935 OPTION_CHECK_ONLY (&A68G_JOB) = A68G_TRUE;
936 }
937 // REDUCTIONS gives parser reductions.
938 else if (eq (p, "REDuctions")) {
939 OPTION_REDUCTIONS (&A68G_JOB) = A68G_TRUE;
940 }
941 // ALGOL60STROPPING sets stropping to quote stropping.
942 else if (eq (p, "ALGOL60stropping")) {
943 OPTION_STROPPING (&A68G_JOB) = QUOTE_STROPPING;
944 } else if (eq (p, "ALGOL60-stropping")) {
945 OPTION_STROPPING (&A68G_JOB) = QUOTE_STROPPING;
946 }
947 // QUOTESTROPPING sets stropping to quote stropping.
948 else if (eq (p, "QUOTEstropping")) {
949 OPTION_STROPPING (&A68G_JOB) = QUOTE_STROPPING;
950 } else if (eq (p, "QUOTE-stropping")) {
951 OPTION_STROPPING (&A68G_JOB) = QUOTE_STROPPING;
952 }
953 // UPPERSTROPPING sets stropping to upper stropping, which is nowadays the expected default.
954 else if (eq (p, "UPPERstropping")) {
955 OPTION_STROPPING (&A68G_JOB) = UPPER_STROPPING;
956 } else if (eq (p, "UPPER-stropping")) {
957 OPTION_STROPPING (&A68G_JOB) = UPPER_STROPPING;
958 }
959 // CHECK and NORUN just check for syntax.
960 else if (eq (p, "CHeck") || eq (p, "NORun") || eq (p, "NO-Run")) {
961 OPTION_CHECK_ONLY (&A68G_JOB) = A68G_TRUE;
962 }
963 // CLOCK times program execution.
964 else if (eq (p, "CLock")) {
965 OPTION_CLOCK (&A68G_JOB) = A68G_TRUE;
966 }
967 // RUN overrides NORUN.
968 else if (eq (p, "RUN")) {
969 OPTION_RUN (&A68G_JOB) = A68G_TRUE;
970 }
971 // MONITOR or DEBUG invokes the debugger at runtime errors.
972 else if (eq (p, "MONitor") || eq (p, "DEBUG")) {
973 OPTION_DEBUG (&A68G_JOB) = A68G_TRUE;
974 }
975 // REGRESSION is an option that sets preferences when running the test suite - undocumented option.
976 else if (eq (p, "REGRession")) {
977 OPTION_NO_NOTICES (&A68G_JOB) = A68G_FALSE;
978 OPTION_NO_WARNINGS (&A68G_JOB) = A68G_FALSE;
979 OPTION_PORTCHECK (&A68G_JOB) = A68G_TRUE;
980 OPTION_REGRESSION_TEST (&A68G_JOB) = A68G_TRUE;
981 OPTION_TIME_LIMIT (&A68G_JOB) = 300;
982 OPTION_KEEP (&A68G_JOB) = A68G_TRUE;
983 A68G (term_width) = MAX_TERM_WIDTH;
984 }
985 // LICense states the license
986 else if (eq (p, "LICense")) {
987 OPTION_LICENSE (&A68G_JOB) = A68G_TRUE;
988 }
989 // NONOTICES switches notices off.
990 else if (eq (p, "NONotices")) {
991 OPTION_NO_NOTICES (&A68G_JOB) = A68G_TRUE;
992 } else if (eq (p, "NO-NOTICEs")) {
993 OPTION_NO_NOTICES (&A68G_JOB) = A68G_TRUE;
994 }
995 // NOWARNINGS switches unsuppressible warnings off.
996 else if (eq (p, "NOWarnings")) {
997 OPTION_NO_WARNINGS (&A68G_JOB) = A68G_TRUE;
998 } else if (eq (p, "NO-Warnings")) {
999 OPTION_NO_WARNINGS (&A68G_JOB) = A68G_TRUE;
1000 }
1001 // QUIET switches all warnings and notices off.
1002 else if (eq (p, "Quiet")) {
1003 OPTION_QUIET (&A68G_JOB) = A68G_TRUE;
1004 }
1005 // WARNINGS switches warnings on.
1006 else if (eq (p, "Warnings")) {
1007 OPTION_NO_WARNINGS (&A68G_JOB) = A68G_FALSE;
1008 }
1009 // NOTICES switches notices on.
1010 else if (eq (p, "NOTices")) {
1011 OPTION_NO_NOTICES (&A68G_JOB) = A68G_FALSE;
1012 }
1013 // NOPORTCHECK switches portcheck off.
1014 else if (eq (p, "NOPORTcheck")) {
1015 OPTION_PORTCHECK (&A68G_JOB) = A68G_FALSE;
1016 } else if (eq (p, "NO-PORTcheck")) {
1017 OPTION_PORTCHECK (&A68G_JOB) = A68G_FALSE;
1018 }
1019 // PORTCHECK switches portcheck on.
1020 else if (eq (p, "PORTcheck")) {
1021 OPTION_PORTCHECK (&A68G_JOB) = A68G_TRUE;
1022 }
1023 // PEDANTIC switches portcheck and warnings on.
1024 else if (eq (p, "PEDANTIC")) {
1025 OPTION_PORTCHECK (&A68G_JOB) = A68G_TRUE;
1026 OPTION_NO_NOTICES (&A68G_JOB) = A68G_FALSE;
1027 OPTION_NO_WARNINGS (&A68G_JOB) = A68G_FALSE;
1028 }
1029 // PRAGMATS and NOPRAGMATS switch on/off pragmat processing.
1030 else if (eq (p, "PRagmats")) {
1031 OPTION_PRAGMAT_SEMA (&A68G_JOB) = A68G_TRUE;
1032 } else if (eq (p, "NOPRagmats")) {
1033 OPTION_PRAGMAT_SEMA (&A68G_JOB) = A68G_FALSE;
1034 } else if (eq (p, "NO-PRagmats")) {
1035 OPTION_PRAGMAT_SEMA (&A68G_JOB) = A68G_FALSE;
1036 }
1037 // STRICT ignores A68G extensions to A68 syntax.
1038 else if (eq (p, "STRict")) {
1039 OPTION_STRICT (&A68G_JOB) = A68G_TRUE;
1040 OPTION_PORTCHECK (&A68G_JOB) = A68G_TRUE;
1041 }
1042 // VERBOSE in case you want to know what Algol68G is doing.
1043 else if (eq (p, "VERBose")) {
1044 OPTION_VERBOSE (&A68G_JOB) = A68G_TRUE;
1045 }
1046 // VERSION lists the current version at an appropriate time in the future.
1047 else if (eq (p, "Version")) {
1048 OPTION_VERSION (&A68G_JOB) = A68G_TRUE;
1049 } else if (eq (p, "MODular-arithmetic")) {
1050 // MODULAR-ARITHMETIC makes A68G permissive towards BITS values corresponding
1051 // to negative INT values. RR forbids these BITS values.
1052 OPTION_NODEMASK (&A68G_JOB) |= MODULAR_MASK;
1053 } else if (eq (p, "NOMODular-arithmetic")) {
1054 OPTION_NODEMASK (&A68G_JOB) &= ~MODULAR_MASK;
1055 } else if (eq (p, "NO-MODular-arithmetic")) {
1056 OPTION_NODEMASK (&A68G_JOB) &= ~MODULAR_MASK;
1057 }
1058 // XREF and NOXREF switch on/off a cross reference.
1059 else if (eq (p, "XREF")) {
1060 OPTION_SOURCE_LISTING (&A68G_JOB) = A68G_TRUE;
1061 OPTION_CROSS_REFERENCE (&A68G_JOB) = A68G_TRUE;
1062 OPTION_NODEMASK (&A68G_JOB) |= (CROSS_REFERENCE_MASK | SOURCE_MASK);
1063 } else if (eq (p, "NOXREF")) {
1064 OPTION_NODEMASK (&A68G_JOB) &= ~(CROSS_REFERENCE_MASK | SOURCE_MASK);
1065 } else if (eq (p, "NO-Xref")) {
1066 OPTION_NODEMASK (&A68G_JOB) &= ~(CROSS_REFERENCE_MASK | SOURCE_MASK);
1067 }
1068 // PRELUDELISTING cross references preludes, if they ever get implemented ...
1069 else if (eq (p, "PRELUDElisting") || eq (p, "PRELUDE-listing")) {
1070 OPTION_SOURCE_LISTING (&A68G_JOB) = A68G_TRUE;
1071 OPTION_CROSS_REFERENCE (&A68G_JOB) = A68G_TRUE;
1072 OPTION_STATISTICS_LISTING (&A68G_JOB) = A68G_TRUE;
1073 OPTION_NODEMASK (&A68G_JOB) |= (SOURCE_MASK | CROSS_REFERENCE_MASK);
1074 OPTION_STANDARD_PRELUDE_LISTING (&A68G_JOB) = A68G_TRUE;
1075 }
1076 // STATISTICS prints process statistics.
1077 else if (eq (p, "STatistics")) {
1078 OPTION_STATISTICS_LISTING (&A68G_JOB) = A68G_TRUE;
1079 }
1080 // TREE and NOTREE switch on/off printing of the syntax tree. This gets bulky!.
1081 else if (eq (p, "TREE")) {
1082 OPTION_SOURCE_LISTING (&A68G_JOB) = A68G_TRUE;
1083 OPTION_TREE_LISTING (&A68G_JOB) = A68G_TRUE;
1084 OPTION_NODEMASK (&A68G_JOB) |= (TREE_MASK | SOURCE_MASK);
1085 } else if (eq (p, "NOTREE")) {
1086 OPTION_NODEMASK (&A68G_JOB) ^= (TREE_MASK | SOURCE_MASK);
1087 } else if (eq (p, "NO-TREE")) {
1088 OPTION_NODEMASK (&A68G_JOB) ^= (TREE_MASK | SOURCE_MASK);
1089 }
1090 // UNUSED indicates unused tags.
1091 else if (eq (p, "UNUSED")) {
1092 OPTION_UNUSED (&A68G_JOB) = A68G_TRUE;
1093 }
1094 // EXTENSIVE set of options for an extensive listing.
1095 else if (eq (p, "EXTensive")) {
1096 OPTION_SOURCE_LISTING (&A68G_JOB) = A68G_TRUE;
1097 OPTION_OBJECT_LISTING (&A68G_JOB) = A68G_TRUE;
1098 OPTION_TREE_LISTING (&A68G_JOB) = A68G_TRUE;
1099 OPTION_CROSS_REFERENCE (&A68G_JOB) = A68G_TRUE;
1100 OPTION_MOID_LISTING (&A68G_JOB) = A68G_TRUE;
1101 OPTION_STANDARD_PRELUDE_LISTING (&A68G_JOB) = A68G_TRUE;
1102 OPTION_STATISTICS_LISTING (&A68G_JOB) = A68G_TRUE;
1103 OPTION_UNUSED (&A68G_JOB) = A68G_TRUE;
1104 OPTION_NODEMASK (&A68G_JOB) |= (CROSS_REFERENCE_MASK | TREE_MASK | CODE_MASK | SOURCE_MASK);
1105 }
1106 // LISTING set of options for a default listing.
1107 else if (eq (p, "Listing")) {
1108 OPTION_SOURCE_LISTING (&A68G_JOB) = A68G_TRUE;
1109 OPTION_CROSS_REFERENCE (&A68G_JOB) = A68G_TRUE;
1110 OPTION_STATISTICS_LISTING (&A68G_JOB) = A68G_TRUE;
1111 OPTION_NODEMASK (&A68G_JOB) |= (SOURCE_MASK | CROSS_REFERENCE_MASK);
1112 }
1113 // TTY send listing to standout. Remnant from my mainframe past.
1114 else if (eq (p, "TTY")) {
1115 OPTION_CROSS_REFERENCE (&A68G_JOB) = A68G_TRUE;
1116 OPTION_STATISTICS_LISTING (&A68G_JOB) = A68G_TRUE;
1117 OPTION_NODEMASK (&A68G_JOB) |= (SOURCE_MASK | CROSS_REFERENCE_MASK);
1118 }
1119 // SOURCE and NOSOURCE print source lines.
1120 else if (eq (p, "SOURCE")) {
1121 OPTION_SOURCE_LISTING (&A68G_JOB) = A68G_TRUE;
1122 OPTION_NODEMASK (&A68G_JOB) |= SOURCE_MASK;
1123 } else if (eq (p, "NOSOURCE")) {
1124 OPTION_NODEMASK (&A68G_JOB) &= ~SOURCE_MASK;
1125 } else if (eq (p, "NO-SOURCE")) {
1126 OPTION_NODEMASK (&A68G_JOB) &= ~SOURCE_MASK;
1127 }
1128 // OBJECT and NOOBJECT print object lines.
1129 else if (eq (p, "OBJECT")) {
1130 OPTION_OBJECT_LISTING (&A68G_JOB) = A68G_TRUE;
1131 } else if (eq (p, "NOOBJECT")) {
1132 OPTION_OBJECT_LISTING (&A68G_JOB) = A68G_FALSE;
1133 } else if (eq (p, "NO-OBJECT")) {
1134 OPTION_OBJECT_LISTING (&A68G_JOB) = A68G_FALSE;
1135 }
1136 // MOIDS prints an overview of moids used in the program.
1137 else if (eq (p, "MOIDS")) {
1138 OPTION_MOID_LISTING (&A68G_JOB) = A68G_TRUE;
1139 }
1140 // ASSERTIONS and NOASSERTIONS switch on/off the processing of assertions.
1141 else if (eq (p, "Assertions")) {
1142 OPTION_NODEMASK (&A68G_JOB) |= ASSERT_MASK;
1143 } else if (eq (p, "NOAssertions")) {
1144 OPTION_NODEMASK (&A68G_JOB) &= ~ASSERT_MASK;
1145 } else if (eq (p, "NO-Assertions")) {
1146 OPTION_NODEMASK (&A68G_JOB) &= ~ASSERT_MASK;
1147 }
1148 // PRECISION sets the LONG LONG precision.
1149 else if (eq (p, "PRECision")) {
1150 BOOL_T error = A68G_FALSE;
1151 INT_T N = fetch_integral (p, &i, &error, A68G_MAX_INT);
1152 int k = width_to_mp_digits (N);
1153 if (k <= 0 || error || errno > 0) {
1154 option_error (start_l, start_c, ERROR_INVALID_VALUE);
1155 } else if (long_mp_digits () > 0 && long_mp_digits () != k) {
1156 option_error (start_l, start_c, ERROR_PRECISION_SET);
1157 } else if (k > mp_digits ()) {
1158 set_long_mp_digits (k);
1159 } else {
1160 option_error (start_l, start_c, ERROR_PRECISION_TOO_LOW);
1161 }
1162 }
1163 // BACKTRACE and NOBACKTRACE switch on/off stack backtracing.
1164 else if (eq (p, "BACKtrace")) {
1165 OPTION_BACKTRACE (&A68G_JOB) = A68G_TRUE;
1166 } else if (eq (p, "NOBACKtrace")) {
1167 OPTION_BACKTRACE (&A68G_JOB) = A68G_FALSE;
1168 } else if (eq (p, "NO-BACKtrace")) {
1169 OPTION_BACKTRACE (&A68G_JOB) = A68G_FALSE;
1170 }
1171 // BREAK and NOBREAK switch on/off tracing of the running program.
1172 else if (eq (p, "BReakpoint")) {
1173 OPTION_NODEMASK (&A68G_JOB) |= BREAKPOINT_MASK;
1174 } else if (eq (p, "NOBReakpoint")) {
1175 OPTION_NODEMASK (&A68G_JOB) &= ~BREAKPOINT_MASK;
1176 } else if (eq (p, "NO-BReakpoint")) {
1177 OPTION_NODEMASK (&A68G_JOB) &= ~BREAKPOINT_MASK;
1178 }
1179 // TRACE and NOTRACE switch on/off tracing of the running program.
1180 else if (eq (p, "TRace")) {
1181 OPTION_TRACE (&A68G_JOB) = A68G_TRUE;
1182 OPTION_NODEMASK (&A68G_JOB) |= BREAKPOINT_TRACE_MASK;
1183 } else if (eq (p, "NOTRace")) {
1184 OPTION_NODEMASK (&A68G_JOB) &= ~BREAKPOINT_TRACE_MASK;
1185 } else if (eq (p, "NO-TRace")) {
1186 OPTION_NODEMASK (&A68G_JOB) &= ~BREAKPOINT_TRACE_MASK;
1187 }
1188 // TIMELIMIT lets the interpreter stop after so-many seconds.
1189 else if (eq (p, "TImelimit") || eq (p, "TIME-Limit")) {
1190 BOOL_T error = A68G_FALSE;
1191 INT_T k = fetch_integral (p, &i, &error, A68G_MAX_INT);
1192 if (error || errno > 0) {
1193 option_error (start_l, start_c, ERROR_INVALID_VALUE);
1194 } else if (k < 1) {
1195 option_error (start_l, start_c, ERROR_INVALID_VALUE);
1196 } else {
1197 OPTION_TIME_LIMIT (&A68G_JOB) = k;
1198 }
1199 }
1200 // Next undocumented option is for a68g development purposes.
1201 else if (eq (p, "SAFEGC") || eq (p, "SAFE-GC")) {
1202 OPTION_CONSERVATIVE_GC (&A68G_JOB) = A68G_GC_SAFE;
1203 } else if (eq (p, "NOGC") || eq (p, "NO-GC")) {
1204 OPTION_CONSERVATIVE_GC (&A68G_JOB) = A68G_GC_HALT;
1205 } else {
1206 // Unrecognised.
1207 option_error (start_l, start_c, ERROR_UNRECOGNISED_OPTION);
1208 }
1209 }
1210 // Go processing next item, if present.
1211 if (i != NO_OPTION_LIST) {
1212 FORWARD (i);
1213 }
1214 }
1215 }
1216 // Mark options as processed.
1217 for (; j != NO_OPTION_LIST; FORWARD (j)) {
1218 PROCESSED (j) = A68G_TRUE;
1219 }
1220 return (BOOL_T) (errno == 0);
1221 }
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
