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