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