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-genie.h"
30 #include "a68g-options.h"
31 #include "a68g-parser.h"
32
33 // This code options to Algol68G.
34 //
35 // Option syntax does not follow GNU standards.
36 //
37 // Options come from:
38 // [1] A rc file (normally .a68grc).
39 // [2] The A68G_OPTIONS environment variable overrules [1].
40 // [3] Command line options overrule [2].
41 // [4] Pragmat items overrule [3].
42
43 //! @brief Set default core size.
44
45 void default_mem_sizes (int n)
46 {
47 #define SET_SIZE(m, n) {\
48 ABEND (OVER_2G (n), ERROR_OUT_OF_CORE_2G, __func__);\
49 (m) = (n);\
50 }
51
52 if (n < 0) {
53 n = 1;
54 }
55 SET_SIZE (A68 (frame_stack_size), 12 * n * MEGABYTE);
56 SET_SIZE (A68 (expr_stack_size), 4 * n * MEGABYTE);
57 SET_SIZE (A68 (heap_size), 32 * n * MEGABYTE);
58 SET_SIZE (A68 (handle_pool_size), 16 * n * MEGABYTE);
59 SET_SIZE (A68 (storage_overhead), MIN_MEM_SIZE);
60 #undef SET_SIZE
61 }
62
63 //! @brief Read options from the .rc file.
64
65 void read_rc_options (void)
66 {
67 FILE *f;
68 BUFFER name, new_name;
69 ASSERT (snprintf (name, SNPRINTF_SIZE, ".%src", A68 (a68_cmd_name)) >= 0);
70 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 char *q;
103 // 'q' points at first significant char in item.
104 while (p[0] != NULL_CHAR) {
105 // Skip white space etc.
106 while ((p[0] == BLANK_CHAR || p[0] == TAB_CHAR || p[0] == ',' || p[0] == NEWLINE_CHAR) && p[0] != NULL_CHAR) {
107 p++;
108 }
109 // ... then tokenise an item.
110 if (p[0] != NULL_CHAR) {
111 // Item can be "string". Note that these are not A68 strings.
112 if (p[0] == QUOTE_CHAR || p[0] == '\'' || p[0] == '`') {
113 char delim = p[0];
114 p++;
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 (STDOUT_FILENO, 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 (STDOUT_FILENO, 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 INT_T k, mult = 1;
308 *error = A68_FALSE;
309 // Fetch argument.
310 car = strchr (p, '=');
311 if (car == NO_TEXT) {
312 FORWARD (*i);
313 *error = (BOOL_T) (*i == NO_OPTION_LIST);
314 if (!error && strcmp (STR (*i), "=") == 0) {
315 FORWARD (*i);
316 *error = (BOOL_T) (*i == NO_OPTION_LIST);
317 }
318 if (!*error) {
319 num = STR (*i);
320 }
321 } else {
322 num = &car[1];
323 *error = (BOOL_T) (num[0] == NULL_CHAR);
324 }
325 // Translate argument into integer.
326 if (*error) {
327 option_error (start_l, start_c, "integer value required by");
328 return 0;
329 } else {
330 char *suffix;
331 errno = 0;
332 k = (int) strtol (num, &suffix, 0); // Accept also octal and hex
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 {
346 mult = 1;
347 break;
348 }
349 case 'k':
350 case 'K':
351 {
352 mult = KILOBYTE;
353 break;
354 }
355 case 'm':
356 case 'M':
357 {
358 mult = MEGABYTE;
359 break;
360 }
361 case 'g':
362 case 'G':
363 {
364 mult = GIGABYTE;
365 break;
366 }
367 default:
368 {
369 option_error (start_l, start_c, "unknown suffix in");
370 *error = A68_TRUE;
371 break;
372 }
373 }
374 if (suffix[0] != NULL_CHAR && suffix[1] != NULL_CHAR) {
375 option_error (start_l, start_c, "unknown suffix in");
376 *error = A68_TRUE;
377 }
378 }
379 }
380 if (OVER_2G ((REAL_T) k * (REAL_T) mult)) {
381 errno = ERANGE;
382 option_error (start_l, start_c, ERROR_OVER_2G);
383 }
384 return k * mult;
385 }
386 }
387
388 //! @brief Process options gathered in the option list.
389
390 BOOL_T set_options (OPTION_LIST_T * i, BOOL_T cmd_line)
391 {
392 BOOL_T go_on = A68_TRUE, name_set = A68_FALSE, skip = A68_FALSE;
393 OPTION_LIST_T *j = i;
394 errno = 0;
395 while (i != NO_OPTION_LIST && go_on) {
396 // Once SCRIPT is processed we skip options on the command line.
397 if (cmd_line && skip) {
398 FORWARD (i);
399 } else {
400 LINE_T *start_l = LINE (i);
401 char *start_c = STR (i);
402 int n = (int) strlen (STR (i));
403 // Allow for spaces ending in # to have A68 comment syntax with '#!'.
404 while (n > 0 && (IS_SPACE ((STR (i))[n - 1]) || (STR (i))[n - 1] == '#')) {
405 (STR (i))[--n] = NULL_CHAR;
406 }
407 if (!(PROCESSED (i))) {
408 // Accept UNIX '-option [=] value'.
409 BOOL_T minus_sign = (BOOL_T) ((STR (i))[0] == '-');
410 char *p = strip_sign (STR (i));
411 char *stale = p;
412 if (!minus_sign && eq (p, "#")) {
413 ;
414 } else if (!minus_sign && cmd_line) {
415 // Item without '-'s is a filename.
416 if (!name_set) {
417 FILE_INITIAL_NAME (&A68_JOB) = new_string (p, NO_TEXT);
418 name_set = A68_TRUE;
419 } else {
420 option_error (NO_LINE, start_c, "multiple source file names at");
421 }
422 } else if (eq (p, "INCLUDE")) {
423 // Preprocessor items stop option processing.
424 go_on = A68_FALSE;
425 } else if (eq (p, "READ")) {
426 go_on = A68_FALSE;
427 } else if (eq (p, "PREPROCESSOR")) {
428 go_on = A68_FALSE;
429 } else if (eq (p, "NOPREPROCESSOR")) {
430 go_on = A68_FALSE;
431 } else if (eq (p, "TECHnicalities")) {
432 // TECH prints out some tech stuff.
433 state_version (STDOUT_FILENO);
434 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (A68_REF) = %u", (unt) sizeof (A68_REF)) >= 0);
435 WRITELN (STDOUT_FILENO, A68 (output_line));
436 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (A68_PROCEDURE) = %u", (unt) sizeof (A68_PROCEDURE)) >= 0);
437 WRITELN (STDOUT_FILENO, A68 (output_line));
438 #if (A68_LEVEL >= 3)
439 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (DOUBLE_T) = %u", (unt) sizeof (DOUBLE_T)) >= 0);
440 WRITELN (STDOUT_FILENO, A68 (output_line));
441 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (DOUBLE_NUM_T) = %u", (unt) sizeof (DOUBLE_NUM_T)) >= 0);
442 WRITELN (STDOUT_FILENO, A68 (output_line));
443 #endif
444 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (A68_INT) = %u", (unt) sizeof (A68_INT)) >= 0);
445 WRITELN (STDOUT_FILENO, A68 (output_line));
446 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (A68_REAL) = %u", (unt) sizeof (A68_REAL)) >= 0);
447 WRITELN (STDOUT_FILENO, A68 (output_line));
448 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (A68_BOOL) = %u", (unt) sizeof (A68_BOOL)) >= 0);
449 WRITELN (STDOUT_FILENO, A68 (output_line));
450 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (A68_CHAR) = %u", (unt) sizeof (A68_CHAR)) >= 0);
451 WRITELN (STDOUT_FILENO, A68 (output_line));
452 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (A68_BITS) = %u", (unt) sizeof (A68_BITS)) >= 0);
453 WRITELN (STDOUT_FILENO, A68 (output_line));
454 #if (A68_LEVEL >= 3)
455 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (A68_LONG_REAL) = %u", (unt) sizeof (A68_LONG_REAL)) >= 0);
456 WRITELN (STDOUT_FILENO, A68 (output_line));
457 #else
458 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (A68_LONG_REAL) = %u", (unt) size_mp ()) >= 0);
459 WRITELN (STDOUT_FILENO, A68 (output_line));
460 #endif
461 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "sizeof (A68_LONG_LONG_REAL) = %u", (unt) size_long_mp ()) >= 0);
462 WRITELN (STDOUT_FILENO, A68 (output_line));
463 WRITELN (STDOUT_FILENO, "");
464 exit (EXIT_SUCCESS);
465 }
466 // EXIT stops option processing.
467 else if (eq (p, "EXIT")) {
468 go_on = A68_FALSE;
469 }
470 // Empty item (from specifying '-' or '--') stops option processing.
471 else if (eq (p, "")) {
472 go_on = A68_FALSE;
473 }
474 // FILE accepts its argument as filename.
475 else if (eq (p, "File") && cmd_line) {
476 FORWARD (i);
477 if (i != NO_OPTION_LIST && strcmp (STR (i), "=") == 0) {
478 FORWARD (i);
479 }
480 if (i != NO_OPTION_LIST) {
481 if (!name_set) {
482 FILE_INITIAL_NAME (&A68_JOB) = new_string (STR (i), NO_TEXT);
483 name_set = A68_TRUE;
484 } else {
485 option_error (start_l, start_c, "multiple source file names at");
486 }
487 } else {
488 option_error (start_l, start_c, "missing argument in");
489 }
490 }
491 // NEED or LIBrary require the argument as environ.
492 else if (eq (p, "NEED") || eq (p, "LIBrary")) {
493 FORWARD (i);
494 if (i != NO_OPTION_LIST && strcmp (STR (i), "=") == 0) {
495 FORWARD (i);
496 }
497 if (i == NO_OPTION_LIST) {
498 option_error (start_l, start_c, "missing argument in");
499 } else {
500 char *q = strip_sign (STR (i));
501 if (eq (q, "MVS")) {
502 WRITELN (STDOUT_FILENO, "mvs required - exiting graciously");
503 a68_exit (EXIT_SUCCESS);
504 }
505 if (eq (q, "mpfr")) {
506 #if !defined (HAVE_GNU_MPFR)
507 io_close_tty_line ();
508 WRITE (STDOUT_FILENO, "GNU MPFR required - exiting graciously");
509 a68_exit (EXIT_SUCCESS);
510 #endif
511 }
512 if (eq (q, "mathlib")) {
513 #if !defined (HAVE_MATHLIB)
514 io_close_tty_line ();
515 WRITE (STDOUT_FILENO, "R mathlib required - exiting graciously");
516 a68_exit (EXIT_SUCCESS);
517 #endif
518 }
519 if (eq (q, "quadmath")) {
520 #if !defined (HAVE_QUADMATH)
521 io_close_tty_line ();
522 WRITE (STDOUT_FILENO, "quadmath required - exiting graciously");
523 a68_exit (EXIT_SUCCESS);
524 #endif
525 }
526 if (eq (q, "gsl")) {
527 #if !defined (HAVE_GSL)
528 io_close_tty_line ();
529 WRITE (STDOUT_FILENO, "GNU Scientific Library required - exiting graciously");
530 a68_exit (EXIT_SUCCESS);
531 #endif
532 }
533 if (eq (q, "plotutils")) {
534 #if !defined (HAVE_GNU_PLOTUTILS)
535 io_close_tty_line ();
536 WRITE (STDOUT_FILENO, "plotutils required - exiting graciously");
537 a68_exit (EXIT_SUCCESS);
538 #endif
539 }
540 if (eq (q, "curses")) {
541 #if !defined (HAVE_CURSES)
542 io_close_tty_line ();
543 WRITE (STDOUT_FILENO, "curses required - exiting graciously");
544 a68_exit (EXIT_SUCCESS);
545 #endif
546 }
547 if (eq (q, "ieee")) {
548 #if !defined (HAVE_IEEE_754)
549 io_close_tty_line ();
550 WRITE (STDOUT_FILENO, "IEEE required - exiting graciously");
551 a68_exit (EXIT_SUCCESS);
552 #endif
553 }
554 if (eq (q, "linux")) {
555 #if !defined (BUILD_LINUX)
556 io_close_tty_line ();
557 WRITE (STDOUT_FILENO, "linux required - exiting graciously");
558 a68_exit (EXIT_SUCCESS);
559 #endif
560 }
561 if (eq (q, "threads")) {
562 #if !defined (BUILD_PARALLEL_CLAUSE)
563 io_close_tty_line ();
564 WRITE (STDOUT_FILENO, "threads required - exiting graciously");
565 a68_exit (EXIT_SUCCESS);
566 #endif
567 }
568 if (eq (q, "postgresql")) {
569 #if !defined (HAVE_POSTGRESQL)
570 io_close_tty_line ();
571 WRITE (STDOUT_FILENO, "postgresql required - exiting graciously");
572 a68_exit (EXIT_SUCCESS);
573 #endif
574 }
575 if (eq (q, "compiler")) {
576 #if !defined (BUILD_A68_COMPILER)
577 io_close_tty_line ();
578 WRITE (STDOUT_FILENO, "compiler required - exiting graciously");
579 a68_exit (EXIT_SUCCESS);
580 #endif
581 }
582 #if !defined (BUILD_HTTP)
583 if (eq (q, "http")) {
584 io_close_tty_line ();
585 WRITELN (STDOUT_FILENO, "HTTP support required - exiting graciously");
586 a68_exit (EXIT_SUCCESS);
587 }
588 #endif
589 }
590 }
591 // SCRIPT takes next argument as filename.
592 // Further options on the command line are not processed, but stored.
593 else if (eq (p, "Script") && cmd_line) {
594 FORWARD (i);
595 if (i != NO_OPTION_LIST) {
596 if (!name_set) {
597 FILE_INITIAL_NAME (&A68_JOB) = new_string (STR (i), NO_TEXT);
598 name_set = A68_TRUE;
599 } else {
600 option_error (start_l, start_c, "multiple source file names at");
601 }
602 } else {
603 option_error (start_l, start_c, "missing argument in");
604 }
605 skip = A68_TRUE;
606 }
607 // VERIFY checks that argument is current a68g version number.
608 else if (eq (p, "VERIFY")) {
609 FORWARD (i);
610 if (i != NO_OPTION_LIST && strcmp (STR (i), "=") == 0) {
611 FORWARD (i);
612 }
613 if (i != NO_OPTION_LIST) {
614 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);
615 ABEND (strcmp (PACKAGE_STRING, STR (i)) != 0, new_string (A68 (output_line), __func__), "outdated script");
616 } else {
617 option_error (start_l, start_c, "missing argument in");
618 }
619 }
620 // HELP gives online help.
621 else if ((eq (p, "APropos") || eq (p, "Help") || eq (p, "INfo")) && cmd_line) {
622 FORWARD (i);
623 if (i != NO_OPTION_LIST && strcmp (STR (i), "=") == 0) {
624 FORWARD (i);
625 }
626 if (i != NO_OPTION_LIST) {
627 apropos (STDOUT_FILENO, NO_TEXT, STR (i));
628 } else {
629 apropos (STDOUT_FILENO, NO_TEXT, "options");
630 }
631 a68_exit (EXIT_SUCCESS);
632 }
633 // ECHO is treated later.
634 else if (eq (p, "ECHO")) {
635 if (strchr (p, '=') == NO_TEXT) {
636 FORWARD (i);
637 if (i != NO_OPTION_LIST) {
638 if (strcmp (STR (i), "=") == 0) {
639 FORWARD (i);
640 }
641 }
642 }
643 }
644 // EXECUTE and PRINT execute their argument as Algol 68 text.
645 else if (eq (p, "Execute") || eq (p, "X") || eq (p, "Print")) {
646 if (cmd_line == A68_FALSE) {
647 option_error (start_l, start_c, "command-line-only");
648 } else if ((FORWARD (i)) != NO_OPTION_LIST) {
649 BOOL_T error = A68_FALSE;
650 if (strcmp (STR (i), "=") == 0) {
651 error = (BOOL_T) ((FORWARD (i)) == NO_OPTION_LIST);
652 }
653 if (!error) {
654 BUFFER name, new_name;
655 FILE *f;
656 int s_errno = errno;
657 bufcpy (name, HIDDEN_TEMP_FILE_NAME, BUFFER_SIZE);
658 bufcat (name, ".a68", BUFFER_SIZE);
659 f = a68_fopen (name, "w", new_name);
660 ABEND (f == NO_FILE, ERROR_ACTION, __func__);
661 errno = s_errno;
662 if (eq (p, "Execute") || eq (p, "X")) {
663 fprintf (f, "(%s)\n", STR (i));
664 } else {
665 fprintf (f, "(print (((%s), new line)))\n", STR (i));
666 }
667 ASSERT (fclose (f) == 0);
668 FILE_INITIAL_NAME (&A68_JOB) = new_string (new_name, NO_TEXT);
669 } else {
670 option_error (start_l, start_c, "unit required by");
671 }
672 } else {
673 option_error (start_l, start_c, "missing argument in");
674 }
675 }
676 // STORAGE, HEAP, HANDLES, STACK, FRAME and OVERHEAD set core allocation.
677 else if (eq (p, "STOrage")) {
678 BOOL_T error = A68_FALSE;
679 int k = fetch_integral (p, &i, &error);
680 // Adjust size.
681 if (error || errno > 0) {
682 option_error (start_l, start_c, "conversion error in");
683 } else if (k > 0) {
684 default_mem_sizes (k);
685 }
686 } else if (eq (p, "HEAP") || eq (p, "HANDLES") || eq (p, "STACK") || eq (p, "FRAME") || eq (p, "OVERHEAD")) {
687 BOOL_T error = A68_FALSE;
688 int k = fetch_integral (p, &i, &error);
689 // Adjust size.
690 if (error || errno > 0) {
691 option_error (start_l, start_c, "conversion error in");
692 } else if (k > 0) {
693 if (k < MIN_MEM_SIZE) {
694 option_error (start_l, start_c, "value less than minimum in");
695 k = MIN_MEM_SIZE;
696 }
697 if (eq (p, "HEAP")) {
698 A68 (heap_size) = k;
699 } else if (eq (p, "HANDLES")) {
700 A68 (handle_pool_size) = k;
701 } else if (eq (p, "STACK")) {
702 A68 (expr_stack_size) = k;
703 } else if (eq (p, "FRAME")) {
704 A68 (frame_stack_size) = k;
705 } else if (eq (p, "OVERHEAD")) {
706 A68 (storage_overhead) = k;
707 }
708 }
709 }
710 // COMPILE and NOCOMPILE switch on/off compilation.
711 else if (eq (p, "Compile")) {
712 #if defined (BUILD_LINUX) || defined (BUILD_BSD)
713 OPTION_COMPILE (&A68_JOB) = A68_TRUE;
714 OPTION_COMPILE_CHECK (&A68_JOB) = A68_TRUE;
715 if (OPTION_OPT_LEVEL (&A68_JOB) < OPTIMISE_1) {
716 OPTION_OPT_LEVEL (&A68_JOB) = OPTIMISE_1;
717 }
718 OPTION_RUN_SCRIPT (&A68_JOB) = A68_FALSE;
719 #else
720 option_error (start_l, start_c, "linux-only option");
721 #endif
722 } else if (eq (p, "NOCompile") || eq (p, "NO-Compile")) {
723 OPTION_COMPILE (&A68_JOB) = A68_FALSE;
724 OPTION_RUN_SCRIPT (&A68_JOB) = A68_FALSE;
725 }
726 // OPTIMISE and NOOPTIMISE switch on/off optimisation.
727 else if (eq (p, "NOOptimize") || eq (p, "NO-Optimize")) {
728 OPTION_OPT_LEVEL (&A68_JOB) = NO_OPTIMISE;
729 } else if (eq (p, "O0")) {
730 OPTION_OPT_LEVEL (&A68_JOB) = NO_OPTIMISE;
731 } else if (eq (p, "OG")) {
732 OPTION_COMPILE_CHECK (&A68_JOB) = A68_TRUE;
733 OPTION_OPT_LEVEL (&A68_JOB) = OPTIMISE_0;
734 } else if (eq (p, "OPTimise") || eq (p, "OPTimize")) {
735 OPTION_COMPILE_CHECK (&A68_JOB) = A68_TRUE;
736 OPTION_OPT_LEVEL (&A68_JOB) = OPTIMISE_1;
737 } else if (eq (p, "O") || eq (p, "O1")) {
738 OPTION_COMPILE_CHECK (&A68_JOB) = A68_TRUE;
739 OPTION_OPT_LEVEL (&A68_JOB) = OPTIMISE_1;
740 } else if (eq (p, "O2")) {
741 OPTION_COMPILE_CHECK (&A68_JOB) = A68_FALSE;
742 OPTION_OPT_LEVEL (&A68_JOB) = OPTIMISE_2;
743 } else if (eq (p, "O3")) {
744 OPTION_COMPILE_CHECK (&A68_JOB) = A68_FALSE;
745 OPTION_OPT_LEVEL (&A68_JOB) = OPTIMISE_3;
746 } else if (eq (p, "Ofast")) {
747 OPTION_COMPILE_CHECK (&A68_JOB) = A68_FALSE;
748 OPTION_OPT_LEVEL (&A68_JOB) = OPTIMISE_FAST;
749 }
750 // ERROR-CHECK generates (some) runtime checks for O2, O3, Ofast.
751 else if (eq (p, "ERRor-check")) {
752 OPTION_COMPILE_CHECK (&A68_JOB) = A68_TRUE;
753 }
754 // RUN-SCRIPT runs a compiled .sh script.
755 else if (eq (p, "RUN-SCRIPT")) {
756 #if defined (BUILD_LINUX) || defined (BUILD_BSD)
757 FORWARD (i);
758 if (i != NO_OPTION_LIST) {
759 if (!name_set) {
760 FILE_INITIAL_NAME (&A68_JOB) = new_string (STR (i), NO_TEXT);
761 name_set = A68_TRUE;
762 } else {
763 option_error (start_l, start_c, "multiple source file names at");
764 }
765 } else {
766 option_error (start_l, start_c, "missing argument in");
767 }
768 skip = A68_TRUE;
769 OPTION_RUN_SCRIPT (&A68_JOB) = A68_TRUE;
770 OPTION_NO_WARNINGS (&A68_JOB) = A68_TRUE;
771 OPTION_COMPILE (&A68_JOB) = A68_FALSE;
772 #else
773 option_error (start_l, start_c, "linux-only option");
774 #endif
775 }
776 // RUN-QUOTE-SCRIPT runs a compiled .sh script.
777 else if (eq (p, "RUN-QUOTE-SCRIPT")) {
778 #if defined (BUILD_LINUX) || defined (BUILD_BSD)
779 FORWARD (i);
780 if (i != NO_OPTION_LIST) {
781 if (!name_set) {
782 FILE_INITIAL_NAME (&A68_JOB) = new_string (STR (i), NO_TEXT);
783 name_set = A68_TRUE;
784 } else {
785 option_error (start_l, start_c, "multiple source file names at");
786 }
787 } else {
788 option_error (start_l, start_c, "missing argument in");
789 }
790 skip = A68_TRUE;
791 OPTION_RUN_SCRIPT (&A68_JOB) = A68_TRUE;
792 OPTION_STROPPING (&A68_JOB) = QUOTE_STROPPING;
793 OPTION_COMPILE (&A68_JOB) = A68_FALSE;
794 #else
795 option_error (start_l, start_c, "linux-only option");
796 #endif
797 }
798 // RERUN re-uses an existing .so file.
799 else if (eq (p, "RERUN")) {
800 OPTION_COMPILE (&A68_JOB) = A68_FALSE;
801 OPTION_RERUN (&A68_JOB) = A68_TRUE;
802 if (OPTION_OPT_LEVEL (&A68_JOB) < OPTIMISE_1) {
803 OPTION_OPT_LEVEL (&A68_JOB) = OPTIMISE_1;
804 }
805 }
806 // KEEP and NOKEEP switch off/on object file deletion.
807 else if (eq (p, "KEEP")) {
808 OPTION_KEEP (&A68_JOB) = A68_TRUE;
809 } else if (eq (p, "NOKEEP")) {
810 OPTION_KEEP (&A68_JOB) = A68_FALSE;
811 } else if (eq (p, "NO-KEEP")) {
812 OPTION_KEEP (&A68_JOB) = A68_FALSE;
813 }
814 // BRACKETS extends Algol 68 syntax for brackets.
815 else if (eq (p, "BRackets")) {
816 OPTION_BRACKETS (&A68_JOB) = A68_TRUE;
817 }
818 // PRETTY and INDENT perform basic pretty printing.
819 // This is meant for synthetic code.
820 else if (eq (p, "PRETty-print")) {
821 OPTION_PRETTY (&A68_JOB) = A68_TRUE;
822 OPTION_CHECK_ONLY (&A68_JOB) = A68_TRUE;
823 } else if (eq (p, "INDENT")) {
824 OPTION_PRETTY (&A68_JOB) = A68_TRUE;
825 OPTION_CHECK_ONLY (&A68_JOB) = A68_TRUE;
826 }
827 // FOLD performs constant folding in basic lay-out formatting..
828 else if (eq (p, "FOLD")) {
829 OPTION_INDENT (&A68_JOB) = A68_TRUE;
830 OPTION_FOLD (&A68_JOB) = A68_TRUE;
831 OPTION_CHECK_ONLY (&A68_JOB) = A68_TRUE;
832 }
833 // REDUCTIONS gives parser reductions.
834 else if (eq (p, "REDuctions")) {
835 OPTION_REDUCTIONS (&A68_JOB) = A68_TRUE;
836 }
837 // QUOTESTROPPING sets stropping to quote stropping.
838 else if (eq (p, "QUOTEstropping")) {
839 OPTION_STROPPING (&A68_JOB) = QUOTE_STROPPING;
840 } else if (eq (p, "QUOTE-stropping")) {
841 OPTION_STROPPING (&A68_JOB) = QUOTE_STROPPING;
842 }
843 // UPPERSTROPPING sets stropping to upper stropping, which is nowadays the expected default.
844 else if (eq (p, "UPPERstropping")) {
845 OPTION_STROPPING (&A68_JOB) = UPPER_STROPPING;
846 } else if (eq (p, "UPPER-stropping")) {
847 OPTION_STROPPING (&A68_JOB) = UPPER_STROPPING;
848 }
849 // CHECK and NORUN just check for syntax.
850 else if (eq (p, "CHeck") || eq (p, "NORun") || eq (p, "NO-Run")) {
851 OPTION_CHECK_ONLY (&A68_JOB) = A68_TRUE;
852 }
853 // CLOCK times program execution.
854 else if (eq (p, "CLock")) {
855 OPTION_CLOCK (&A68_JOB) = A68_TRUE;
856 }
857 // RUN overrides NORUN.
858 else if (eq (p, "RUN")) {
859 OPTION_RUN (&A68_JOB) = A68_TRUE;
860 }
861 // MONITOR or DEBUG invokes the debugger at runtime errors.
862 else if (eq (p, "MONitor") || eq (p, "DEBUG")) {
863 OPTION_DEBUG (&A68_JOB) = A68_TRUE;
864 }
865 // REGRESSION is an option that sets preferences when running the test suite - undocumented option.
866 else if (eq (p, "REGRESSION")) {
867 OPTION_NO_WARNINGS (&A68_JOB) = A68_FALSE;
868 OPTION_PORTCHECK (&A68_JOB) = A68_TRUE;
869 OPTION_REGRESSION_TEST (&A68_JOB) = A68_TRUE;
870 OPTION_TIME_LIMIT (&A68_JOB) = 300;
871 OPTION_KEEP (&A68_JOB) = A68_TRUE;
872 A68 (term_width) = MAX_TERM_WIDTH;
873 }
874 // LICense states the license
875 else if (eq (p, "LICense")) {
876 OPTION_LICENSE (&A68_JOB) = A68_TRUE;
877 }
878 // NOWARNINGS switches unsuppressible warnings off.
879 else if (eq (p, "NOWarnings")) {
880 OPTION_NO_WARNINGS (&A68_JOB) = A68_TRUE;
881 } else if (eq (p, "NO-Warnings")) {
882 OPTION_NO_WARNINGS (&A68_JOB) = A68_TRUE;
883 }
884 // QUIET switches all warnings off.
885 else if (eq (p, "Quiet")) {
886 OPTION_QUIET (&A68_JOB) = A68_TRUE;
887 }
888 // WARNINGS switches warnings on.
889 else if (eq (p, "Warnings")) {
890 OPTION_NO_WARNINGS (&A68_JOB) = A68_FALSE;
891 }
892 // NOPORTCHECK switches portcheck off.
893 else if (eq (p, "NOPORTcheck")) {
894 OPTION_PORTCHECK (&A68_JOB) = A68_FALSE;
895 } else if (eq (p, "NO-PORTcheck")) {
896 OPTION_PORTCHECK (&A68_JOB) = A68_FALSE;
897 }
898 // PORTCHECK switches portcheck on.
899 else if (eq (p, "PORTcheck")) {
900 OPTION_PORTCHECK (&A68_JOB) = A68_TRUE;
901 }
902 // PEDANTIC switches portcheck and warnings on.
903 else if (eq (p, "PEDANTIC")) {
904 OPTION_PORTCHECK (&A68_JOB) = A68_TRUE;
905 OPTION_NO_WARNINGS (&A68_JOB) = A68_FALSE;
906 }
907 // PRAGMATS and NOPRAGMATS switch on/off pragmat processing.
908 else if (eq (p, "PRagmats")) {
909 OPTION_PRAGMAT_SEMA (&A68_JOB) = A68_TRUE;
910 } else if (eq (p, "NOPRagmats")) {
911 OPTION_PRAGMAT_SEMA (&A68_JOB) = A68_FALSE;
912 } else if (eq (p, "NO-PRagmats")) {
913 OPTION_PRAGMAT_SEMA (&A68_JOB) = A68_FALSE;
914 }
915 // STRICT ignores A68G extensions to A68 syntax.
916 else if (eq (p, "STRict")) {
917 OPTION_STRICT (&A68_JOB) = A68_TRUE;
918 OPTION_PORTCHECK (&A68_JOB) = A68_TRUE;
919 }
920 // VERBOSE in case you want to know what Algol68G is doing.
921 else if (eq (p, "VERBose")) {
922 OPTION_VERBOSE (&A68_JOB) = A68_TRUE;
923 }
924 // VERSION lists the current version at an appropriate time in the future.
925 else if (eq (p, "Version")) {
926 OPTION_VERSION (&A68_JOB) = A68_TRUE;
927 } else if (eq (p, "MODular-arithmetic")) {
928 OPTION_NODEMASK (&A68_JOB) |= MODULAR_MASK;
929 } else if (eq (p, "NOMODular-arithmetic")) {
930 OPTION_NODEMASK (&A68_JOB) &= ~MODULAR_MASK;
931 } else if (eq (p, "NO-MODular-arithmetic")) {
932 OPTION_NODEMASK (&A68_JOB) &= ~MODULAR_MASK;
933 }
934 // XREF and NOXREF switch on/off a cross reference.
935 else if (eq (p, "XREF")) {
936 OPTION_SOURCE_LISTING (&A68_JOB) = A68_TRUE;
937 OPTION_CROSS_REFERENCE (&A68_JOB) = A68_TRUE;
938 OPTION_NODEMASK (&A68_JOB) |= (CROSS_REFERENCE_MASK | SOURCE_MASK);
939 } else if (eq (p, "NOXREF")) {
940 OPTION_NODEMASK (&A68_JOB) &= ~(CROSS_REFERENCE_MASK | SOURCE_MASK);
941 } else if (eq (p, "NO-Xref")) {
942 OPTION_NODEMASK (&A68_JOB) &= ~(CROSS_REFERENCE_MASK | SOURCE_MASK);
943 }
944 // PRELUDELISTING cross references preludes, if they ever get implemented ...
945 else if (eq (p, "PRELUDElisting")) {
946 OPTION_SOURCE_LISTING (&A68_JOB) = A68_TRUE;
947 OPTION_CROSS_REFERENCE (&A68_JOB) = A68_TRUE;
948 OPTION_STATISTICS_LISTING (&A68_JOB) = A68_TRUE;
949 OPTION_NODEMASK (&A68_JOB) |= (SOURCE_MASK | CROSS_REFERENCE_MASK);
950 OPTION_STANDARD_PRELUDE_LISTING (&A68_JOB) = A68_TRUE;
951 }
952 // STATISTICS prints process statistics.
953 else if (eq (p, "STatistics")) {
954 OPTION_STATISTICS_LISTING (&A68_JOB) = A68_TRUE;
955 }
956 // TREE and NOTREE switch on/off printing of the syntax tree. This gets bulky!.
957 else if (eq (p, "TREE")) {
958 OPTION_SOURCE_LISTING (&A68_JOB) = A68_TRUE;
959 OPTION_TREE_LISTING (&A68_JOB) = A68_TRUE;
960 OPTION_NODEMASK (&A68_JOB) |= (TREE_MASK | SOURCE_MASK);
961 } else if (eq (p, "NOTREE")) {
962 OPTION_NODEMASK (&A68_JOB) ^= (TREE_MASK | SOURCE_MASK);
963 } else if (eq (p, "NO-TREE")) {
964 OPTION_NODEMASK (&A68_JOB) ^= (TREE_MASK | SOURCE_MASK);
965 }
966 // UNUSED indicates unused tags.
967 else if (eq (p, "UNUSED")) {
968 OPTION_UNUSED (&A68_JOB) = A68_TRUE;
969 }
970 // EXTENSIVE set of options for an extensive listing.
971 else if (eq (p, "EXTensive")) {
972 OPTION_SOURCE_LISTING (&A68_JOB) = A68_TRUE;
973 OPTION_OBJECT_LISTING (&A68_JOB) = A68_TRUE;
974 OPTION_TREE_LISTING (&A68_JOB) = A68_TRUE;
975 OPTION_CROSS_REFERENCE (&A68_JOB) = A68_TRUE;
976 OPTION_MOID_LISTING (&A68_JOB) = A68_TRUE;
977 OPTION_STANDARD_PRELUDE_LISTING (&A68_JOB) = A68_TRUE;
978 OPTION_STATISTICS_LISTING (&A68_JOB) = A68_TRUE;
979 OPTION_UNUSED (&A68_JOB) = A68_TRUE;
980 OPTION_NODEMASK (&A68_JOB) |= (CROSS_REFERENCE_MASK | TREE_MASK | CODE_MASK | SOURCE_MASK);
981 }
982 // LISTING set of options for a default listing.
983 else if (eq (p, "Listing")) {
984 OPTION_SOURCE_LISTING (&A68_JOB) = A68_TRUE;
985 OPTION_CROSS_REFERENCE (&A68_JOB) = A68_TRUE;
986 OPTION_STATISTICS_LISTING (&A68_JOB) = A68_TRUE;
987 OPTION_NODEMASK (&A68_JOB) |= (SOURCE_MASK | CROSS_REFERENCE_MASK);
988 }
989 // TTY send listing to standout. Remnant from my mainframe past.
990 else if (eq (p, "TTY")) {
991 OPTION_CROSS_REFERENCE (&A68_JOB) = A68_TRUE;
992 OPTION_STATISTICS_LISTING (&A68_JOB) = A68_TRUE;
993 OPTION_NODEMASK (&A68_JOB) |= (SOURCE_MASK | CROSS_REFERENCE_MASK);
994 }
995 // SOURCE and NOSOURCE print source lines.
996 else if (eq (p, "SOURCE")) {
997 OPTION_SOURCE_LISTING (&A68_JOB) = A68_TRUE;
998 OPTION_NODEMASK (&A68_JOB) |= SOURCE_MASK;
999 } else if (eq (p, "NOSOURCE")) {
1000 OPTION_NODEMASK (&A68_JOB) &= ~SOURCE_MASK;
1001 } else if (eq (p, "NO-SOURCE")) {
1002 OPTION_NODEMASK (&A68_JOB) &= ~SOURCE_MASK;
1003 }
1004 // OBJECT and NOOBJECT print object lines.
1005 else if (eq (p, "OBJECT")) {
1006 OPTION_OBJECT_LISTING (&A68_JOB) = A68_TRUE;
1007 } else if (eq (p, "NOOBJECT")) {
1008 OPTION_OBJECT_LISTING (&A68_JOB) = A68_FALSE;
1009 } else if (eq (p, "NO-OBJECT")) {
1010 OPTION_OBJECT_LISTING (&A68_JOB) = A68_FALSE;
1011 }
1012 // MOIDS prints an overview of moids used in the program.
1013 else if (eq (p, "MOIDS")) {
1014 OPTION_MOID_LISTING (&A68_JOB) = A68_TRUE;
1015 }
1016 // ASSERTIONS and NOASSERTIONS switch on/off the processing of assertions.
1017 else if (eq (p, "Assertions")) {
1018 OPTION_NODEMASK (&A68_JOB) |= ASSERT_MASK;
1019 } else if (eq (p, "NOAssertions")) {
1020 OPTION_NODEMASK (&A68_JOB) &= ~ASSERT_MASK;
1021 } else if (eq (p, "NO-Assertions")) {
1022 OPTION_NODEMASK (&A68_JOB) &= ~ASSERT_MASK;
1023 }
1024 // PRECISION sets the LONG LONG precision.
1025 else if (eq (p, "PRECision")) {
1026 BOOL_T error = A68_FALSE;
1027 int N = fetch_integral (p, &i, &error);
1028 int k = width_to_mp_digits (N);
1029 if (k <= 0 || error || errno > 0) {
1030 option_error (start_l, start_c, "invalid value in");
1031 } else if (long_mp_digits () > 0 && long_mp_digits () != k) {
1032 option_error (start_l, start_c, "different precision was already specified in");
1033 } else if (k > mp_digits ()) {
1034 set_long_mp_digits (k);
1035 } else {
1036 option_error (start_l, start_c, "attempt to set LONG LONG precision lower than LONG precision");
1037 }
1038 }
1039 // BACKTRACE and NOBACKTRACE switch on/off stack backtracing.
1040 else if (eq (p, "BACKtrace")) {
1041 OPTION_BACKTRACE (&A68_JOB) = A68_TRUE;
1042 } else if (eq (p, "NOBACKtrace")) {
1043 OPTION_BACKTRACE (&A68_JOB) = A68_FALSE;
1044 } else if (eq (p, "NO-BACKtrace")) {
1045 OPTION_BACKTRACE (&A68_JOB) = A68_FALSE;
1046 }
1047 // BREAK and NOBREAK switch on/off tracing of the running program.
1048 else if (eq (p, "BReakpoint")) {
1049 OPTION_NODEMASK (&A68_JOB) |= BREAKPOINT_MASK;
1050 } else if (eq (p, "NOBReakpoint")) {
1051 OPTION_NODEMASK (&A68_JOB) &= ~BREAKPOINT_MASK;
1052 } else if (eq (p, "NO-BReakpoint")) {
1053 OPTION_NODEMASK (&A68_JOB) &= ~BREAKPOINT_MASK;
1054 }
1055 // TRACE and NOTRACE switch on/off tracing of the running program.
1056 else if (eq (p, "TRace")) {
1057 OPTION_TRACE (&A68_JOB) = A68_TRUE;
1058 OPTION_NODEMASK (&A68_JOB) |= BREAKPOINT_TRACE_MASK;
1059 } else if (eq (p, "NOTRace")) {
1060 OPTION_NODEMASK (&A68_JOB) &= ~BREAKPOINT_TRACE_MASK;
1061 } else if (eq (p, "NO-TRace")) {
1062 OPTION_NODEMASK (&A68_JOB) &= ~BREAKPOINT_TRACE_MASK;
1063 }
1064 // TIMELIMIT lets the interpreter stop after so-many seconds.
1065 else if (eq (p, "TImelimit") || eq (p, "TIME-Limit")) {
1066 BOOL_T error = A68_FALSE;
1067 int k = fetch_integral (p, &i, &error);
1068 if (error || errno > 0) {
1069 option_error (start_l, start_c, "conversion error in");
1070 } else if (k < 1) {
1071 option_error (start_l, start_c, "invalid time span in");
1072 } else {
1073 OPTION_TIME_LIMIT (&A68_JOB) = k;
1074 }
1075 } else {
1076 // Unrecognised.
1077 option_error (start_l, start_c, "unrecognised");
1078 }
1079 a68_free (stale);
1080 }
1081 // Go processing next item, if present.
1082 if (i != NO_OPTION_LIST) {
1083 FORWARD (i);
1084 }
1085 }
1086 }
1087 // Mark options as processed.
1088 for (; j != NO_OPTION_LIST; FORWARD (j)) {
1089 PROCESSED (j) = A68_TRUE;
1090 }
1091 return (BOOL_T) (errno == 0);
1092 }
