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