|
 |
1 //! @file a68g.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-2026 J. Marcel van der Veer [algol68g@algol68genie.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 main driver. 25 26 // --assertions, --noassertions, switch elaboration of assertions on or off. 27 // --backtrace, --nobacktrace, switch stack backtracing in case of a runtime error. 28 // --boldstropping, set stropping mode to bold stropping. 29 // --brackets, consider [ .. ] and { .. } as equivalent to ( .. ). 30 // --check, --norun, check syntax only, interpreter does not start. 31 // --clock, report execution time excluding compilation time. 32 // --compile, compile source file. 33 // --debug, --monitor, start execution in the debugger and debug in case of runtime error. 34 // --echo string, echo 'string' to standard output. 35 // --execute unit, execute algol 68 unit 'unit'. 36 // --exit, --, ignore next options. 37 // --extensive, make extensive listing. 38 // --file string, accept string as generic filename. 39 // --frame 'number', set frame stack size to 'number'. 40 // --handles 'number', set handle space size to 'number'. 41 // --heap 'number', set heap size to 'number'. 42 // --keep, --nokeep, switch object file deletion off or on. 43 // --listing, make concise listing. 44 // --moids, make overview of moids in listing file. 45 // -O0, -O1, -O2, -O3, switch compilation on and pass option to back-end C compiler. 46 // --optimise, --nooptimise, switch compilation on or off. 47 // --pedantic, equivalent to --warnings --portcheck. 48 // --portcheck, --noportcheck, switch portability warnings on or off. 49 // --pragmats, --nopragmats, switch elaboration of pragmat items on or off. 50 // --precision 'number', set precision for long long modes to 'number' significant digits. 51 // --preludelisting, make a listing of preludes. 52 // --pretty-print, pretty-print the source file. 53 // --print unit, print value yielded by algol 68 unit 'unit'. 54 // --quiet, suppresses all warning diagnostics. 55 // --quotestropping, set stropping mode to quote stropping. 56 // --reductions, print parser reductions. 57 // --run, override --check/--norun options. 58 // --rerun, run using already compiled code. 59 // --script, set next option as source file name; pass further options to algol 68 program. 60 // --source, --nosource, switch listing of source lines in listing file on or off. 61 // --stack 'number', set expression stack size to 'number'. 62 // --statistics, print statistics in listing file. 63 // --strict, disable most extensions to Algol 68 syntax. 64 // --timelimit 'number', interrupt the interpreter after 'number' seconds. 65 // --trace, --notrace, switch tracing of a running program on or off. 66 // --tree, --notree, switch syntax tree listing in listing file on or off. 67 // --unused, make an overview of unused tags in the listing file. 68 // --verbose, inform on program actions. 69 // --version, state version of the running copy. 70 // --warnings, --nowarnings, switch warning diagnostics on or off. 71 // --xref, --noxref, switch cross reference in the listing file on or off. 72 73 #include "a68g.h" 74 #include "a68g-listing.h" 75 #include "a68g-mp.h" 76 #include "a68g-optimiser.h" 77 #include "a68g-options.h" 78 #include "a68g-parser.h" 79 #include "a68g-postulates.h" 80 #include "a68g-genie.h" 81 #include "a68g-prelude.h" 82 #include "a68g-prelude-mathlib.h" 83 84 #if defined (HAVE_R_MATHLIB) 85 #include <Rmath.h> 86 #endif 87 88 #if defined (HAVE_CURL) 89 #include <curl/curl.h> 90 #endif 91 92 GLOBALS_T common; 93 94 #define EXTENSIONS 13 95 static char *extensions[EXTENSIONS] = { 96 NO_TEXT, 97 ".a68", ".A68", 98 ".a68g", ".A68G", 99 ".alg", ".ALG", 100 ".algol", ".ALGOL", 101 ".algol68", ".ALGOL68", 102 ".algol68g", ".ALGOL68G" 103 }; 104 105 void compiler_interpreter (void); 106 107 //! @brief Verbose statistics, only useful when debugging a68g. 108 109 void verbosity (void) 110 { 111 #if defined (A68G_DEBUG) 112 ; 113 #else 114 ; 115 #endif 116 } 117 118 //! @brief State license of running a68g image. 119 120 void state_license (FILE_T f) 121 { 122 #define PR(s)\ 123 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s\n", (s)) >= 0);\ 124 WRITE (f, A68G (output_line)); 125 126 if (f == A68G_STDOUT) { 127 io_close_tty_line (); 128 } 129 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Algol 68 Genie %s\n", PACKAGE_VERSION) >= 0); 130 WRITE (f, A68G (output_line)); 131 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Copyright 2001-2026 %s.\n", PACKAGE_BUGREPORT) >= 0); 132 WRITE (f, A68G (output_line)); 133 PR (""); 134 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "This is free software covered by the GNU General Public License.\n") >= 0); 135 WRITE (f, A68G (output_line)); 136 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "There is ABSOLUTELY NO WARRANTY for Algol 68 Genie;\n") >= 0); 137 WRITE (f, A68G (output_line)); 138 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n") >= 0); 139 WRITE (f, A68G (output_line)); 140 PR ("See the GNU General Public License for more details."); 141 PR (""); 142 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Please report bugs to %s.\n", PACKAGE_BUGREPORT) >= 0); 143 WRITE (f, A68G (output_line)); 144 #undef PR 145 } 146 147 //! @brief State version of running a68g image. 148 149 void state_version (FILE_T f) 150 { 151 #define PR(s)\ 152 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s\n", (s)) >= 0);\ 153 WRITE (f, A68G (output_line)); 154 155 if (f == A68G_STDOUT) { 156 io_close_tty_line (); 157 } 158 state_license (f); 159 PR (""); 160 #if defined (BUILD_WIN32) 161 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "WIN32 executable\n") >= 0); 162 WRITE (f, A68G (output_line)); 163 WRITELN (f, ""); 164 #endif 165 #if defined (BUILD_WIN64) 166 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "WIN64 executable\n") >= 0); 167 WRITE (f, A68G (output_line)); 168 WRITELN (f, ""); 169 #endif 170 #if (A68G_LEVEL >= 3) 171 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With hardware support for long modes\n") >= 0); 172 WRITE (f, A68G (output_line)); 173 #endif 174 #if defined (BUILD_A68G_COMPILER) 175 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With plugin-compilation support\n") >= 0); 176 WRITE (f, A68G (output_line)); 177 #endif 178 #if defined (BUILD_PARALLEL_CLAUSE) 179 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With parallel-clause support\n") >= 0); 180 WRITE (f, A68G (output_line)); 181 #endif 182 #if defined (HAVE_POSTGRESQL) 183 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With PostgreSQL support\n") >= 0); 184 WRITE (f, A68G (output_line)); 185 #endif 186 #if defined (HAVE_CURL) 187 curl_version_info_data *data = curl_version_info(CURLVERSION_NOW); 188 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With curl %s\n", data->version) >= 0); 189 WRITE (f, A68G (output_line)); 190 #endif 191 #if defined (HAVE_GNU_MPFR) 192 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU MP %s\n", gmp_version) >= 0); 193 WRITE (f, A68G (output_line)); 194 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU MPFR %s\n", mpfr_get_version ()) >= 0); 195 WRITE (f, A68G (output_line)); 196 #endif 197 #if defined (HAVE_R_MATHLIB) 198 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With mathlib from R %s\n", R_VERSION_STRING) >= 0); 199 WRITE (f, A68G (output_line)); 200 #endif 201 #if defined (HAVE_GSL) 202 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU Scientific Library %s\n", GSL_VERSION) >= 0); 203 WRITE (f, A68G (output_line)); 204 #endif 205 #if defined (HAVE_GNU_PLOTUTILS) 206 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU plotutils %s\n", PL_LIBPLOT_VER_STRING) >= 0); 207 WRITE (f, A68G (output_line)); 208 #endif 209 #if defined (HAVE_CURSES) 210 #if defined (NCURSES_VERSION) 211 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With ncurses %s\n", NCURSES_VERSION) >= 0); 212 #else 213 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With curses support\n") >= 0); 214 #endif 215 WRITE (f, A68G (output_line)); 216 #endif 217 #if defined (_CS_GNU_LIBC_VERSION) && defined (BUILD_UNIX) 218 if (confstr (_CS_GNU_LIBC_VERSION, A68G (input_line), BUFFER_SIZE) > (size_t) 0) { 219 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "GNU libc version %s\n", A68G (input_line)) >= 0); 220 WRITE (f, A68G (output_line)); 221 } 222 #if (defined (BUILD_PARALLEL_CLAUSE) && defined (_CS_GNU_LIBPTHREAD_VERSION)) 223 if (confstr (_CS_GNU_LIBPTHREAD_VERSION, A68G (input_line), BUFFER_SIZE) > (size_t) 0) { 224 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "GNU libpthread version %s\n", A68G (input_line)) >= 0); 225 WRITE (f, A68G (output_line)); 226 } 227 #endif 228 #endif 229 #define RSIZE(n) (unt) (sizeof (n) / sizeof (int)) 230 #if defined (BUILD_A68G_COMPILER) && defined (C_COMPILER) 231 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Build level %d.%x%x%x%x %s %s\n", A68G_LEVEL, RSIZE (INT_T), RSIZE (REAL_T), RSIZE (MP_INT_T), RSIZE (MP_REAL_T), C_COMPILER, __DATE__) >= 0); 232 #else 233 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Build level %d.%x%x%x%x %s\n", A68G_LEVEL, RSIZE (INT_T), RSIZE (REAL_T), RSIZE (MP_INT_T), RSIZE (MP_REAL_T), __DATE__) >= 0); 234 #endif 235 #undef RSIZE 236 WRITE (f, A68G (output_line)); 237 #undef PR 238 } 239 240 //! @brief Give brief help if someone types 'a68g --help'. 241 242 void online_help (FILE_T f) 243 { 244 if (f == A68G_STDOUT) { 245 io_close_tty_line (); 246 } 247 state_license (f); 248 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Usage: %s [options | filename]", A68G (a68g_cmd_name)) >= 0); 249 WRITELN (f, A68G (output_line)); 250 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "For help: %s --apropos [keyword]", A68G (a68g_cmd_name)) >= 0); 251 WRITELN (f, A68G (output_line)); 252 } 253 254 //! @brief Start book keeping for a phase. 255 256 void announce_phase (char *t) 257 { 258 if (OPTION_VERBOSE (&A68G_JOB)) { 259 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s: %s", A68G (a68g_cmd_name), t) >= 0); 260 io_close_tty_line (); 261 WRITE (A68G_STDOUT, A68G (output_line)); 262 } 263 } 264 265 //! @brief Test extension and strip. 266 267 BOOL_T strip_extension (char *ext) 268 { 269 if (ext == NO_TEXT) { 270 return A68G_FALSE; 271 } 272 size_t nlen = strlen (FILE_SOURCE_NAME (&A68G_JOB)), xlen = strlen (ext); 273 if (nlen > xlen && strcmp (&(FILE_SOURCE_NAME (&A68G_JOB)[nlen - xlen]), ext) == 0) { 274 char *fn = (char *) get_heap_space (nlen + 1); 275 a68g_bufcpy (fn, FILE_SOURCE_NAME (&A68G_JOB), nlen); 276 fn[nlen - xlen] = NULL_CHAR; 277 a68g_free (FILE_GENERIC_NAME (&A68G_JOB)); 278 FILE_GENERIC_NAME (&A68G_JOB) = new_string (fn, NO_TEXT); 279 a68g_free (fn); 280 return A68G_TRUE; 281 } else { 282 return A68G_FALSE; 283 } 284 } 285 286 //! @brief Try opening with an extension. 287 288 void open_with_extensions (void) 289 { 290 FILE_SOURCE_FD (&A68G_JOB) = A68G_NO_FILE; 291 for (int k = 0; k < EXTENSIONS && FILE_SOURCE_FD (&A68G_JOB) == A68G_NO_FILE; k++) { 292 size_t len; 293 char *fn = NULL; 294 if (extensions[k] == NO_TEXT) { 295 len = strlen (FILE_INITIAL_NAME (&A68G_JOB)) + 1; 296 fn = (char *) get_heap_space (len); 297 a68g_bufcpy (fn, FILE_INITIAL_NAME (&A68G_JOB), len); 298 } else { 299 len = strlen (FILE_INITIAL_NAME (&A68G_JOB)) + strlen (extensions[k]) + 1; 300 fn = (char *) get_heap_space (len); 301 a68g_bufcpy (fn, FILE_INITIAL_NAME (&A68G_JOB), len); 302 a68g_bufcat (fn, extensions[k], len); 303 } 304 FILE_SOURCE_FD (&A68G_JOB) = open (fn, O_RDONLY | O_BINARY); 305 if (FILE_SOURCE_FD (&A68G_JOB) != A68G_NO_FILE) { 306 BOOL_T cont = A68G_TRUE; 307 a68g_free (FILE_SOURCE_NAME (&A68G_JOB)); 308 a68g_free (FILE_GENERIC_NAME (&A68G_JOB)); 309 FILE_SOURCE_NAME (&A68G_JOB) = new_string (fn, NO_TEXT); 310 FILE_GENERIC_NAME (&A68G_JOB) = new_string (a68g_basename (fn), NO_TEXT); 311 FILE_PATH (&A68G_JOB) = new_string (a68g_dirname (fn), NO_TEXT); 312 for (int l = 0; l < EXTENSIONS && cont; l++) { 313 if (strip_extension (extensions[l])) { 314 cont = A68G_FALSE; 315 } 316 } 317 } 318 a68g_free (fn); 319 } 320 } 321 322 //! @brief Remove a regular file. 323 324 void a68g_rm (char *fn) 325 { 326 struct stat path_stat; 327 if (stat (fn, &path_stat) == 0) { 328 if (S_ISREG (path_stat.st_mode)) { 329 ABEND (remove (fn) != 0, ERROR_ACTION, FILE_OBJECT_NAME (&A68G_JOB)); 330 } 331 } 332 } 333 334 //! @brief Drives compilation and interpretation. 335 336 void compiler_interpreter (void) 337 { 338 BOOL_T emitted = A68G_FALSE; 339 TREE_LISTING_SAFE (&A68G_JOB) = A68G_FALSE; 340 CROSS_REFERENCE_SAFE (&A68G_JOB) = A68G_FALSE; 341 A68G (in_execution) = A68G_FALSE; 342 A68G (new_nodes) = 0; 343 A68G (new_modes) = 0; 344 A68G (new_postulates) = 0; 345 A68G (new_node_infos) = 0; 346 A68G (new_genie_infos) = 0; 347 A68G (symbol_table_count) = 0; 348 A68G (mode_count) = 0; 349 A68G (node_register) = NO_REF; 350 init_postulates (); 351 A68G (do_confirm_exit) = A68G_TRUE; 352 A68G (f_entry) = NO_NODE; 353 A68G (global_level) = 0; 354 A68G (max_lex_lvl) = 0; 355 A68G_PARSER (stop_scanner) = A68G_FALSE; 356 A68G_PARSER (read_error) = A68G_FALSE; 357 A68G_PARSER (no_preprocessing) = A68G_FALSE; 358 A68G_PARSER (reductions) = 0; 359 A68G_PARSER (tag_number) = 0; 360 A68G (curses_mode) = A68G_FALSE; 361 A68G (top_soid_list) = NO_SOID; 362 A68G (max_simplout_size) = 0; 363 A68G_MON (in_monitor) = A68G_FALSE; 364 A68G_MP (mp_ln_scale_size) = -1; 365 A68G_MP (mp_ln_10_size) = -1; 366 A68G_MP (mp_gamma_size) = -1; 367 A68G_MP (mp_one_size) = -1; 368 A68G_MP (mp_pi_size) = -1; 369 // File set-up. 370 SCAN_ERROR (FILE_INITIAL_NAME (&A68G_JOB) == NO_TEXT, NO_LINE, NO_TEXT, ERROR_NO_SOURCE_FILE); 371 FILE_BINARY_OPENED (&A68G_JOB) = A68G_FALSE; 372 FILE_BINARY_WRITEMOOD (&A68G_JOB) = A68G_TRUE; 373 FILE_PLUGIN_OPENED (&A68G_JOB) = A68G_FALSE; 374 FILE_PLUGIN_WRITEMOOD (&A68G_JOB) = A68G_TRUE; 375 FILE_LISTING_OPENED (&A68G_JOB) = A68G_FALSE; 376 FILE_LISTING_WRITEMOOD (&A68G_JOB) = A68G_TRUE; 377 FILE_OBJECT_OPENED (&A68G_JOB) = A68G_FALSE; 378 FILE_OBJECT_WRITEMOOD (&A68G_JOB) = A68G_TRUE; 379 FILE_PRETTY_OPENED (&A68G_JOB) = A68G_FALSE; 380 FILE_SCRIPT_OPENED (&A68G_JOB) = A68G_FALSE; 381 FILE_SCRIPT_WRITEMOOD (&A68G_JOB) = A68G_FALSE; 382 FILE_SOURCE_OPENED (&A68G_JOB) = A68G_FALSE; 383 FILE_SOURCE_WRITEMOOD (&A68G_JOB) = A68G_FALSE; 384 FILE_DIAGS_OPENED (&A68G_JOB) = A68G_FALSE; 385 FILE_DIAGS_WRITEMOOD (&A68G_JOB) = A68G_TRUE; 386 // Open the source file. 387 // Open it for binary reading for systems that require so (Win32). 388 // Accept various silent extensions. 389 errno = 0; 390 FILE_SOURCE_NAME (&A68G_JOB) = NO_TEXT; 391 FILE_GENERIC_NAME (&A68G_JOB) = NO_TEXT; 392 open_with_extensions (); 393 if (FILE_SOURCE_NAME (&A68G_JOB) == NO_TEXT) { 394 errno = ENOENT; 395 SCAN_ERROR (A68G_TRUE, NO_LINE, NO_TEXT, ERROR_SOURCE_FILE_OPEN); 396 } else { 397 struct stat path_stat; 398 errno = 0; 399 SCAN_ERROR (stat (FILE_SOURCE_NAME (&A68G_JOB), &path_stat) != 0, NO_LINE, NO_TEXT, ERROR_SOURCE_FILE_OPEN); 400 SCAN_ERROR (S_ISDIR (path_stat.st_mode), NO_LINE, NO_TEXT, ERROR_IS_DIRECTORY); 401 SCAN_ERROR (!S_ISREG (path_stat.st_mode), NO_LINE, NO_TEXT, ERROR_NO_REGULAR_FILE); 402 } 403 if (FILE_SOURCE_FD (&A68G_JOB) == A68G_NO_FILE) { 404 scan_error (NO_LINE, NO_TEXT, ERROR_SOURCE_FILE_OPEN); 405 } 406 ABEND (FILE_SOURCE_NAME (&A68G_JOB) == NO_TEXT, ERROR_INTERNAL_CONSISTENCY, NO_TEXT); 407 ABEND (FILE_GENERIC_NAME (&A68G_JOB) == NO_TEXT, ERROR_INTERNAL_CONSISTENCY, NO_TEXT); 408 // Object file. 409 size_t len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (OBJECT_EXTENSION); 410 FILE_OBJECT_NAME (&A68G_JOB) = (char *) get_heap_space (len); 411 a68g_bufcpy (FILE_OBJECT_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len); 412 a68g_bufcat (FILE_OBJECT_NAME (&A68G_JOB), OBJECT_EXTENSION, len); 413 // Binary. 414 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (PLUGIN_EXTENSION); 415 FILE_BINARY_NAME (&A68G_JOB) = (char *) get_heap_space (len); 416 a68g_bufcpy (FILE_BINARY_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len); 417 a68g_bufcat (FILE_BINARY_NAME (&A68G_JOB), BINARY_EXTENSION, len); 418 // Library file. 419 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (PLUGIN_EXTENSION); 420 FILE_PLUGIN_NAME (&A68G_JOB) = (char *) get_heap_space (len); 421 a68g_bufcpy (FILE_PLUGIN_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len); 422 a68g_bufcat (FILE_PLUGIN_NAME (&A68G_JOB), PLUGIN_EXTENSION, len); 423 // Listing file. 424 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (LISTING_EXTENSION); 425 FILE_LISTING_NAME (&A68G_JOB) = (char *) get_heap_space (len); 426 a68g_bufcpy (FILE_LISTING_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len); 427 a68g_bufcat (FILE_LISTING_NAME (&A68G_JOB), LISTING_EXTENSION, len); 428 // Pretty file. 429 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (PRETTY_EXTENSION); 430 FILE_PRETTY_NAME (&A68G_JOB) = (char *) get_heap_space (len); 431 a68g_bufcpy (FILE_PRETTY_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len); 432 a68g_bufcat (FILE_PRETTY_NAME (&A68G_JOB), PRETTY_EXTENSION, len); 433 // Script file. 434 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (SCRIPT_EXTENSION); 435 FILE_SCRIPT_NAME (&A68G_JOB) = (char *) get_heap_space (len); 436 a68g_bufcpy (FILE_SCRIPT_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len); 437 a68g_bufcat (FILE_SCRIPT_NAME (&A68G_JOB), SCRIPT_EXTENSION, len); 438 // Parser. 439 a68g_parser (); 440 if (TOP_NODE (&A68G_JOB) == NO_NODE) { 441 errno = ECANCELED; 442 ABEND (A68G_TRUE, ERROR_SOURCE_FILE_EMPTY, NO_TEXT); 443 } 444 // Portability checker. 445 if (ERROR_COUNT (&A68G_JOB) == 0) { 446 announce_phase ("portability checker"); 447 portcheck (TOP_NODE (&A68G_JOB)); 448 verbosity (); 449 } 450 // Finalise syntax tree. 451 if (ERROR_COUNT (&A68G_JOB) == 0) { 452 int num = 0; 453 renumber_nodes (TOP_NODE (&A68G_JOB), &num); 454 NEST (TABLE (TOP_NODE (&A68G_JOB))) = A68G (symbol_table_count) = 3; 455 reset_symbol_table_nest_count (TOP_NODE (&A68G_JOB)); 456 verbosity (); 457 } 458 if (A68G_MP (varying_mp_digits) > width_to_mp_digits (MP_MAX_DECIMALS)) { 459 diagnostic (A68G_WARNING, NO_NODE, WARNING_PRECISION, NO_LINE, 0, A68G_MP (varying_mp_digits) * LOG_MP_RADIX); 460 } 461 // Plugin code generation and compilation. 462 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_OPT_LEVEL (&A68G_JOB) > NO_OPTIMISE) { 463 announce_phase ("plugin-compiler"); 464 plugin_driver_code (); 465 #if defined (BUILD_A68G_COMPILER) 466 emitted = A68G_TRUE; 467 if (ERROR_COUNT (&A68G_JOB) == 0 && !OPTION_RUN_SCRIPT (&A68G_JOB)) { 468 plugin_driver_compile (); 469 } 470 verbosity (); 471 #else 472 emitted = A68G_FALSE; 473 diagnostic (A68G_WARNING, TOP_NODE (&A68G_JOB), WARNING_OPTIMISATION); 474 #endif 475 } 476 // Indenter. 477 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_PRETTY (&A68G_JOB)) { 478 announce_phase ("indenter"); 479 indenter (&A68G_JOB); 480 verbosity (); 481 } 482 // Interpreter initialisation. 483 diagnostics_to_terminal (TOP_LINE (&A68G_JOB), A68G_ALL_DIAGNOSTICS); 484 if (OPTION_DEBUG (&A68G_JOB)) { 485 state_license (A68G_STDOUT); 486 } 487 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_COMPILE (&A68G_JOB) == A68G_FALSE && 488 (OPTION_CHECK_ONLY (&A68G_JOB) ? OPTION_RUN (&A68G_JOB) : A68G_TRUE)) { 489 announce_phase ("genie"); 490 GetRNGstate (); 491 A68G (f_entry) = TOP_NODE (&A68G_JOB); 492 A68G (close_tty_on_exit) = A68G_FALSE; 493 #if defined (BUILD_A68G_COMPILER) 494 plugin_driver_genie (); 495 #else 496 genie ((void *) NULL); 497 #endif 498 // Free heap allocated by genie. 499 if (A68G_GC (total) > 10 * A68G_MEGA) { 500 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE, 501 "sweeps=" A68G_LU ", refused=" A68G_LU ", freed=" A68G_LU "MB", 502 A68G_GC (sweeps), A68G_GC (refused), A68G_GC (total) / A68G_MEGA) 503 ); 504 } else if (A68G_GC (total) > 10 * A68G_KILO) { 505 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE, 506 "sweeps=" A68G_LU ", refused=" A68G_LU ", freed=" A68G_LU "kB", 507 A68G_GC (sweeps), A68G_GC (refused), A68G_GC (total) / A68G_KILO) 508 ); 509 } else { 510 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE, 511 "sweeps=" A68G_LU ", refused=" A68G_LU ", freed=" A68G_LU, 512 A68G_GC (sweeps), A68G_GC (refused), A68G_GC (total)) 513 ); 514 } 515 announce_phase (A68G (edit_line)); 516 genie_free (TOP_NODE (&A68G_JOB)); 517 // Store seed for rng. 518 announce_phase ("store rng state"); 519 PutRNGstate (); 520 // Normal end of program. 521 diagnostics_to_terminal (TOP_LINE (&A68G_JOB), A68G_RUNTIME_ERROR); 522 if (OPTION_DEBUG (&A68G_JOB) || OPTION_TRACE (&A68G_JOB) || OPTION_CLOCK (&A68G_JOB)) { 523 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\nGenie finished in %.2f seconds\n", seconds () - A68G (cputime_0)) >= 0); 524 WRITE (A68G_STDOUT, A68G (output_line)); 525 } 526 verbosity (); 527 } 528 // Setting up listing file. 529 announce_phase ("write listing"); 530 if (OPTION_MOID_LISTING (&A68G_JOB) || OPTION_TREE_LISTING (&A68G_JOB) || OPTION_SOURCE_LISTING (&A68G_JOB) || OPTION_OBJECT_LISTING (&A68G_JOB) || OPTION_STATISTICS_LISTING (&A68G_JOB)) { 531 FILE_LISTING_FD (&A68G_JOB) = open (FILE_LISTING_NAME (&A68G_JOB), O_WRONLY | O_CREAT | O_TRUNC, A68G_PROTECTION); 532 ABEND (FILE_LISTING_FD (&A68G_JOB) == A68G_NO_FILE, ERROR_ACTION, NO_TEXT); 533 FILE_LISTING_OPENED (&A68G_JOB) = A68G_TRUE; 534 } else { 535 FILE_LISTING_OPENED (&A68G_JOB) = A68G_FALSE; 536 } 537 // Write listing. 538 if (FILE_LISTING_OPENED (&A68G_JOB)) { 539 A68G (heap_is_fluid) = A68G_TRUE; 540 write_listing_header (); 541 write_source_listing (); 542 write_tree_listing (); 543 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_OPT_LEVEL (&A68G_JOB) > 0) { 544 write_object_listing (); 545 } 546 write_listing (); 547 ASSERT (close (FILE_LISTING_FD (&A68G_JOB)) == 0); 548 FILE_LISTING_OPENED (&A68G_JOB) = A68G_FALSE; 549 verbosity (); 550 } 551 // Cleaning up the intermediate files. 552 #if defined (BUILD_A68G_COMPILER) 553 announce_phase ("clean up intermediate files"); 554 plugin_driver_clean (emitted); 555 #else 556 (void) emitted; 557 #endif 558 } 559 560 //! @brief Exit a68g in an orderly manner. 561 562 void a68g_exit (int code) 563 { 564 announce_phase ("exit"); 565 #if defined (HAVE_GNU_MPFR) 566 mpfr_free_cache (); 567 #endif 568 // Close unclosed files, remove temp files. 569 free_file_entries (); 570 // Close the terminal. 571 if (A68G (close_tty_on_exit) || OPTION_REGRESSION_TEST (&A68G_JOB)) { 572 io_close_tty_line (); 573 } else if (OPTION_VERBOSE (&A68G_JOB)) { 574 io_close_tty_line (); 575 } 576 #if defined (HAVE_CURSES) 577 // "curses" might still be open if it was not closed from A68, or the program 578 // was interrupted, or a runtime error occured. 579 // That wreaks havoc on your terminal. 580 genie_curses_end (NO_NODE); 581 #endif 582 // Clean up stale things. 583 free_syntax_tree (TOP_NODE (&A68G_JOB)); 584 free_option_list (OPTION_LIST (&A68G_JOB)); 585 a68g_free (A68G_MP (mp_180_over_pi)); 586 a68g_free (A68G_MP (mp_half_pi)); 587 a68g_free (A68G_MP (mp_ln_pi)); 588 a68g_free (A68G_MP (mp_one)); 589 a68g_free (A68G_MP (mp_pi)); 590 a68g_free (A68G_MP (mp_pi_over_180)); 591 a68g_free (A68G_MP (mp_sqrt_pi)); 592 a68g_free (A68G_MP (mp_sqrt_two_pi)); 593 a68g_free (A68G_MP (mp_two_pi)); 594 a68g_free (A68G (node_register)); 595 a68g_free (A68G (options)); 596 a68g_free (FILE_BINARY_NAME (&A68G_JOB)); 597 a68g_free (FILE_DIAGS_NAME (&A68G_JOB)); 598 a68g_free (FILE_GENERIC_NAME (&A68G_JOB)); 599 a68g_free (FILE_INITIAL_NAME (&A68G_JOB)); 600 a68g_free (FILE_LISTING_NAME (&A68G_JOB)); 601 a68g_free (FILE_OBJECT_NAME (&A68G_JOB)); 602 a68g_free (FILE_PATH (&A68G_JOB)); 603 a68g_free (FILE_PLUGIN_NAME (&A68G_JOB)); 604 a68g_free (FILE_PRETTY_NAME (&A68G_JOB)); 605 a68g_free (FILE_SCRIPT_NAME (&A68G_JOB)); 606 a68g_free (FILE_SOURCE_NAME (&A68G_JOB)); 607 exit (code); 608 } 609 610 //! @brief Main entry point. 611 612 int main (int argc, char *argv[]) 613 { 614 BYTE_T stack_offset; // Leave this here! 615 #if defined (MALLOPT) 616 mallopt (M_CHECK_ACTION, 3); // Default in recent glibc. 617 #endif 618 A68G (argc) = argc; 619 A68G (argv) = argv; 620 A68G (stdin_is_raw) = A68G_FALSE; 621 A68G (close_tty_on_exit) = A68G_TRUE; 622 FILE_DIAGS_FD (&A68G_JOB) = A68G_NO_FILE; 623 // Get command name and discard path. 624 #if defined (BUILD_WINDOWS) 625 a68g_bufcpy (A68G (a68g_cmd_name), "a68g", BUFFER_SIZE); 626 #else 627 a68g_bufcpy (A68G (a68g_cmd_name), argv[0], BUFFER_SIZE); 628 for (int k = strlen (A68G (a68g_cmd_name)) - 1; k >= 0; k--) { 629 if (A68G (a68g_cmd_name)[k] == '/') { 630 MOVE (&A68G (a68g_cmd_name)[0], &A68G (a68g_cmd_name)[k + 1], strlen (A68G (a68g_cmd_name)) - k + 1); 631 k = -1; 632 } 633 } 634 #endif 635 // Try to read maximum line width on the terminal, 636 // used to pretty print diagnostics to same. 637 a68g_getty (&A68G (term_heigth), &A68G (term_width)); 638 // Determine clock resolution. 639 { 640 clock_t t0 = clock (), t1; 641 do { 642 t1 = clock (); 643 } while (t1 == t0); 644 A68G (clock_res) = (t1 - t0) / (clock_t) CLOCKS_PER_SEC; 645 } 646 #if defined (BUILD_PARALLEL_CLAUSE) 647 // Set the main thread id. 648 A68G_PAR (main_thread_id) = pthread_self (); 649 #endif 650 A68G (heap_is_fluid) = A68G_TRUE; 651 A68G (system_stack_offset) = &stack_offset; 652 init_file_entries (); 653 if (!setjmp (RENDEZ_VOUS (&A68G_JOB))) { 654 init_tty (); 655 // Initialise option handling. 656 init_options (); 657 SOURCE_SCAN (&A68G_JOB) = 1; 658 default_options (&A68G_JOB); 659 default_mem_sizes (1, NULL, NULL); 660 // Initialise core. 661 A68G_STACK = NO_BYTE; 662 A68G_HEAP = NO_BYTE; 663 A68G_HANDLES = NO_BYTE; 664 get_C_stack_size (); 665 // Well, let's start. 666 TOP_REFINEMENT (&A68G_JOB) = NO_REFINEMENT; 667 FILE_INITIAL_NAME (&A68G_JOB) = NO_TEXT; 668 FILE_GENERIC_NAME (&A68G_JOB) = NO_TEXT; 669 FILE_SOURCE_NAME (&A68G_JOB) = NO_TEXT; 670 FILE_LISTING_NAME (&A68G_JOB) = NO_TEXT; 671 FILE_OBJECT_NAME (&A68G_JOB) = NO_TEXT; 672 FILE_PLUGIN_NAME (&A68G_JOB) = NO_TEXT; 673 FILE_BINARY_NAME (&A68G_JOB) = NO_TEXT; 674 FILE_PRETTY_NAME (&A68G_JOB) = NO_TEXT; 675 FILE_SCRIPT_NAME (&A68G_JOB) = NO_TEXT; 676 FILE_DIAGS_NAME (&A68G_JOB) = NO_TEXT; 677 // Options are processed here. 678 read_rc_options (); 679 read_env_options (); 680 // Posix copies arguments from the command line. 681 if (argc <= 1) { 682 online_help (A68G_STDOUT); 683 a68g_exit (EXIT_FAILURE); 684 } 685 for (int k = 1; k < argc; k++) { 686 add_option_list (&(OPTION_LIST (&A68G_JOB)), argv[k], NO_LINE); 687 } 688 if (!set_options (OPTION_LIST (&A68G_JOB), A68G_TRUE)) { 689 a68g_exit (EXIT_FAILURE); 690 } 691 // State license. 692 if (OPTION_LICENSE (&A68G_JOB)) { 693 state_license (A68G_STDOUT); 694 } 695 // State version. 696 if (OPTION_VERSION (&A68G_JOB)) { 697 state_version (A68G_STDOUT); 698 } 699 // Start the UI. 700 init_before_tokeniser (); 701 // Running a script. 702 #if defined (BUILD_A68G_COMPILER) 703 if (OPTION_RUN_SCRIPT (&A68G_JOB)) { 704 load_script (); 705 } 706 #endif 707 // We translate the program. 708 if (FILE_INITIAL_NAME (&A68G_JOB) == NO_TEXT || strlen (FILE_INITIAL_NAME (&A68G_JOB)) == 0) { 709 SCAN_ERROR (!(OPTION_LICENSE (&A68G_JOB) || OPTION_VERSION (&A68G_JOB)), NO_LINE, NO_TEXT, ERROR_NO_SOURCE_FILE); 710 } else { 711 compiler_interpreter (); 712 } 713 a68g_exit (ERROR_COUNT (&A68G_JOB) == 0 ? EXIT_SUCCESS : EXIT_FAILURE); 714 return EXIT_SUCCESS; 715 } else { 716 diagnostics_to_terminal (TOP_LINE (&A68G_JOB), A68G_ALL_DIAGNOSTICS); 717 a68g_exit (EXIT_FAILURE); 718 return EXIT_FAILURE; 719 } 720 }
© 2001-2026 J.M. van der Veer
jmvdveer@algol68genie.nl