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