1 /**
2 @file a68g.h
3 @author J. Marcel van der Veer
4 @brief General definitions for Algol 68 Genie.
5 @section Copyright
6 
7 This file is part of Algol 68 Genie - an Algol 68 compiler-interpreter.
8 Copyright 2001-2016 J. Marcel van der Veer <algol68g@xs4all.nl>.
9 
10 @section License
11 
12 This program is free software; you can redistribute it and/or modify it under
13 the terms of the GNU General Public License as published by the Free Software
14 Foundation; either version 3 of the License, or (at your option) any later
15 version.
16 
17 This program is distributed in the hope that it will be useful, but WITHOUT ANY
18 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
19 PARTICULAR PURPOSE. See the GNU General Public License for more details.
20 
21 You should have received a copy of the GNU General Public License along with
22 this program. If not, see <http://www.gnu.org/licenses/>.
23 
24 @section Description
25 
26 Top level include file.
27 **/
28 
29 /**
30 @mainpage Introduction to Algol 68 Genie
31 **/
32 
33 #if ! defined A68G_ALGOL68G_H
34 #define A68G_ALGOL68G_H
35 
36 /*****************/
37 /* Configuration */
38 /*****************/
39 
40 #include "a68g-config.h"
41 
42 /*************************/
43 /* Derived configuration */
44 /*************************/
45 
46 /* Do we have a compiler? */
47 #if (! defined HAVE_GCC || defined NO_MINUS_C_MINUS_O || ! defined HAVE_DL)
48 #undef HAVE_COMPILER
49 #elif (! HAVE_MAC_OS_X && ! defined HAVE_EXPORT_DYNAMIC)
50 #undef HAVE_COMPILER
51 #elif ((defined HAVE_LINUX || defined HAVE_MAC_OS_X) && defined HAVE_DL)
52 #define HAVE_COMPILER 1
53 #elif (defined HAVE_FREEBSD || defined HAVE_NETBSD)
54 #define HAVE_COMPILER 1
55 #else
56 #undef HAVE_COMPILER
57 #endif
58 
59 /* Can we access the internet? */
60 
61 #if (defined HAVE_NETDB_H && defined HAVE_NETINET_IN_H && defined HAVE_SYS_SOCKET_H)
62 #if (defined HAVE_LINUX || defined HAVE_MAC_OS_X || defined HAVE_FREEBSD || defined HAVE_NETBSD)
63 #define HAVE_HTTP
64 #endif
65 #endif
66 
67 /************/
68 /* Includes */
69 /************/
70 
71 #if defined HAVE_SYS_TYPES_H
72 #include <sys/types.h>
73 #endif
74 
75 #if defined HAVE_STDIO_H
76 #include <stdio.h>
77 #endif
78 
79 #if defined HAVE_LIMITS_H
80 #include <limits.h>
81 #endif
82 
83 #if defined HAVE_ASSERT_H
84 #include <assert.h>
85 #endif
86 
87 #if defined HAVE_CONIO_H
88 #include <conio.h>
89 #endif
90 
91 #if defined HAVE_CTYPE_H
92 #include <ctype.h>
93 #endif
94 
95 #if defined HAVE_CURSES_H
96 #include <curses.h>
97 #elif defined HAVE_NCURSES_CURSES_H
98 #include <ncurses/curses.h>
99 #endif
100 
101 #if defined HAVE_READLINE_READLINE_H
102 #include <readline/readline.h>
103 #endif
104 
105 #if defined HAVE_READLINE_HISTORY_H
106 #include <readline/history.h>
107 #endif
108 
109 #if defined HAVE_DIRENT_H
110 #include <dirent.h>
111 #endif
112 
113 #if defined HAVE_DL
114 #include <dlfcn.h>
115 #endif
116 
117 #if defined HAVE_ERRNO_H
118 #include <errno.h>
119 #endif
120 
121 #if defined HAVE_FCNTL_H
122 #include <fcntl.h>
123 #endif
124 
125 #if defined HAVE_FLOAT_H
126 #include <float.h>
127 #endif
128 
129 #if defined HAVE_LIBPQ-FE_H
130 #include <libpq-fe.h>
131 #endif
132 
133 #if defined HAVE_MATH_H
134 #include <math.h>
135 #endif
136 
137 #if defined HAVE_NETDB_H
138 #include <netdb.h>
139 #endif
140 
141 #if defined HAVE_NETINET_IN_H
142 #include <netinet/in.h>
143 #endif
144 
145 #if defined HAVE_GNU_PLOTUTILS
146 #include <plot.h>
147 #endif
148 
149 #if defined HAVE_PTHREAD_H
150 #include <pthread.h>
151 #endif
152 
153 #if defined HAVE_REGEX_H
154 #include <regex.h>
155 #endif
156 
157 #if defined HAVE_SETJMP_H
158 #include <setjmp.h>
159 #endif
160 
161 #if defined HAVE_SIGNAL_H
162 #include <signal.h>
163 #endif
164 
165 #if defined HAVE_STDARG_H
166 #include <stdarg.h>
167 #endif
168 
169 #if defined HAVE_STDDEF_H
170 #include <stddef.h>
171 #endif
172 
173 #if defined HAVE_STDLIB_H
174 #include <stdlib.h>
175 #endif
176 
177 #if defined HAVE_STRING_H
178 #include <string.h>
179 #endif
180 
181 #if defined HAVE_STRINGS_H
182 #include <strings.h>
183 #endif
184 
185 #if (defined HAVE_TERMIOS_H && ! defined TIOCGWINSZ)
186 #include <termios.h>
187 #elif (defined HAVE_TERMIOS_H && ! defined GWINSZ_IN_SYS_IOCTL)
188 #include <termios.h>
189 #endif
190 
191 #if defined HAVE_TIME_H
192 #include <time.h>
193 #endif
194 
195 #if defined HAVE_UNISTD_H
196 #include <unistd.h>
197 #endif
198 
199 #if defined HAVE_SYS_IOCTL_H
200 #include <sys/ioctl.h>
201 #endif
202 
203 #if defined HAVE_SYS_RESOURCE_H
204 #include <sys/resource.h>
205 #endif
206 
207 #if defined HAVE_SYS_SOCKET_H
208 #include <sys/socket.h>
209 #endif
210 
211 #if defined HAVE_SYS_STAT_H
212 #include <sys/stat.h>
213 #endif
214 
215 #if defined HAVE_SYS_TIME_H
216 #include <sys/time.h>
217 #endif
218 
219 #if defined HAVE_SYS_WAIT_H
220 #include <sys/wait.h>
221 #endif
222 
223 #if defined HAVE_GSL_GSL_BLAS_H
224 #include <gsl/gsl_blas.h>
225 #endif
226 
227 #if defined HAVE_GSL_GSL_COMPLEX_H
228 #include <gsl/gsl_complex.h>
229 #endif
230 
231 #if defined HAVE_GSL_GSL_COMPLEX_H
232 #include <gsl/gsl_complex.h>
233 #endif
234 
235 #if defined HAVE_GSL_GSL_COMPLEX_H
236 #include <gsl/gsl_complex.h>
237 #endif
238 
239 #if defined HAVE_GSL_GSL_COMPLEX_MATH_H
240 #include <gsl/gsl_complex_math.h>
241 #endif
242 
243 #if defined HAVE_GSL_GSL_COMPLEX_MATH_H
244 #include <gsl/gsl_complex_math.h>
245 #endif
246 
247 #if defined HAVE_GSL_GSL_COMPLEX_MATH_H
248 #include <gsl/gsl_complex_math.h>
249 #endif
250 
251 #if defined HAVE_GSL_GSL_ERRNO_H
252 #include <gsl/gsl_errno.h>
253 #endif
254 
255 #if defined HAVE_GSL_GSL_ERRNO_H
256 #include <gsl/gsl_errno.h>
257 #endif
258 
259 #if defined HAVE_GSL_GSL_ERRNO_H
260 #include <gsl/gsl_errno.h>
261 #endif
262 
263 #if defined HAVE_GSL_GSL_FFT_COMPLEX_H
264 #include <gsl/gsl_fft_complex.h>
265 #endif
266 
267 #if defined HAVE_GSL_GSL_INTEGRATION_H
268 #include <gsl/gsl_integration.h>
269 #endif
270 
271 #if defined HAVE_GSL_GSL_LINALG_H
272 #include <gsl/gsl_linalg.h>
273 #endif
274 
275 #if defined HAVE_GSL_GSL_MATH_H
276 #include <gsl/gsl_math.h>
277 #endif
278 
279 #if defined HAVE_GSL_GSL_MATH_H
280 #include <gsl/gsl_math.h>
281 #endif
282 
283 #if defined HAVE_GSL_GSL_MATH_H
284 #include <gsl/gsl_math.h>
285 #endif
286 
287 #if defined HAVE_GSL_GSL_MATRIX_H
288 #include <gsl/gsl_matrix.h>
289 #endif
290 
291 #if defined HAVE_GSL_GSL_PERMUTATION_H
292 #include <gsl/gsl_permutation.h>
293 #endif
294 
295 #if defined HAVE_GSL_GSL_SF_H
296 #include <gsl/gsl_sf.h>
297 #endif
298 
299 #if defined HAVE_GSL_GSL_SF_H
300 #include <gsl/gsl_sf.h>
301 #endif
302 
303 #if defined HAVE_GSL_GSL_SF_H
304 #include <gsl/gsl_sf.h>
305 #endif
306 
307 #if defined HAVE_GSL_GSL_VECTOR_H
308 #include <gsl/gsl_vector.h>
309 #endif
310 
311 /*****************/
312 /* Compatibility */
313 /*****************/
314 
315 #if ! defined HAVE_SNPRINTF
316 #define snprintf a68g_snprintf
317 extern int a68g_snprintf (char *, size_t, char *, ...);
318 #endif
319 
320 #if ! defined O_BINARY
321 #define O_BINARY 0x0000
322 #endif
323 
324 /*************/
325 /* Constants */
326 /*************/
327 
328 #define A68_DIR ".a68g"
329 #define A68_FALSE ((BOOL_T) 0)
330 #define A68_HISTORY_FILE ".a68g.edit.hist"
331 #define A68_MAX_BITS (UINT_MAX)
332 #define A68_MAX_INT (INT_MAX)
333 #define A68_MAX_UNT (UINT_MAX)
334 #define A68_NO_FILENO ((FILE_T) -1)
335 #define A68_PI 3.1415926535897932384626433832795029
336 #define A68_PROTECTION (S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH) /* -rw-r--r-- */
337 #define A68_READ_ACCESS (O_RDONLY)
338 #define A68_TRUE ((BOOL_T) 1)
339 #define A68_WRITE_ACCESS (O_WRONLY | O_CREAT | O_TRUNC)
340 #define BACKSLASH_CHAR '\\'
341 #define BINARY_EXTENSION ".o"
342 #define BLANK_CHAR ' '
343 #define BUFFER_SIZE (KILOBYTE)
344 #define BYTES_WIDTH 32
345 #define CR_CHAR '\r'
346 #define DEFAULT_DOUBLE_DIGITS 5
347 #define DEFAULT_MP_RADIX 10000000
348 #define DEFAULT_WIDTH (-1)
349 #define DIGIT_BLANK ((unsigned) 0x2)
350 #define DIGIT_NORMAL ((unsigned) 0x1)
351 #define DOUBLE_ACCURACY (DBL_DIG - 1)
352 #define EMBEDDED_FORMAT A68_TRUE
353 #define EOF_CHAR (EOF)
354 #define ERROR_CHAR '*'
355 #define ESCAPE_CHAR '\033'
356 #define EXPONENT_CHAR 'e'
357 #define FLIP_CHAR 'T'
358 #define FLOP_CHAR 'F'
359 #define FORMFEED_CHAR '\f'
360 #define GIGABYTE (KILOBYTE * MEGABYTE)
361 #define HIDDEN_TEMP_FILE_NAME ".a68g.tmp"
362 #define INSERTION_BLANK ((unsigned) 0x20)
363 #define INSERTION_NORMAL ((unsigned) 0x10)
364 #define ITEM_NOT_USED (-1)
365 #define KILOBYTE ((int) 1024)
366 #define LIBRARY_EXTENSION ".so"
367 #define LISTING_EXTENSION ".l"
368 #define LOG2_10	3.321928094887362347870319430
369 #define LOG_MP_BASE 7
370 #define LONGLONG_EXP_WIDTH (EXP_WIDTH)
371 #define LONG_BYTES_WIDTH 256
372 #define LONG_EXP_WIDTH (EXP_WIDTH)
373 #define LONG_MP_DIGITS DEFAULT_DOUBLE_DIGITS
374 #define MAX_ERRORS 8
375 #define MAX_MP_EXPONENT 142857 /* Arbitrary. Let M = MAX_REPR_INT then the largest range is M / Log M / LOG_MP_BASE */
376 #define MAX_OPEN_FILES 64 /* Some OS's won't open more than this number */
377 #define MAX_PRIORITY 9
378 #define MAX_REPR_INT 9007199254740992.0	/* 2^53, max int in a double */
379 #define MAX_TERM_HEIGTH 24
380 #define MAX_TERM_WIDTH (BUFFER_SIZE / 2)
381 #define MAX_TRANSPUT_BUFFER (MAX_OPEN_FILES)
382 #define MEGABYTE (KILOBYTE * KILOBYTE)
383 #define MIN_MEM_SIZE (128 * KILOBYTE)
384 #define MOID_ERROR_WIDTH 80
385 #define MOID_WIDTH 80
386 #define MONADS "%^&+-~!?"
387 #define MP_BITS_BITS 23
388 #define MP_BITS_RADIX 8388608 /* Max power of two smaller than MP_RADIX */
389 #define MP_RADIX DEFAULT_MP_RADIX
390 #define NEWLINE_CHAR '\n'
391 #define NEWLINE_STRING "\n"
392 #define NOMADS "></=*"
393 #define NOT_EMBEDDED_FORMAT A68_FALSE
394 #define NOT_PRINTED 1
395 #define NULL_CHAR '\0'
396 #define OBJECT_EXTENSION ".c"
397 #define POINT_CHAR '.'
398 #define PRETTY_EXTENSION ".f"
399 #define PRIMAL_SCOPE 0
400 #define QUOTE_CHAR '"'
401 #define RADIX_CHAR 'r'
402 #define REAL_WIDTH (DBL_DIG)
403 #define SCRIPT_EXTENSION ".sh"
404 #define SKIP_PATTERN A68_FALSE
405 #define SMALL_BUFFER_SIZE 128
406 #define SNPRINTF_SIZE ((size_t) BUFFER_SIZE)
407 #define TAB_CHAR '\t'
408 #define TRANSPUT_BUFFER_SIZE BUFFER_SIZE
409 #define WANT_PATTERN A68_TRUE
410 
411 /* Error codes */
412 
413 #define A68_NO_DIAGNOSTICS ((STATUS_MASK) 0x0)
414 #define A68_ERROR ((STATUS_MASK) 0x1)
415 #define A68_SYNTAX_ERROR ((STATUS_MASK) 0x2)
416 #define A68_MATH_ERROR ((STATUS_MASK) 0x4)
417 #define A68_WARNING ((STATUS_MASK) 0x8)
418 #define A68_RUNTIME_ERROR ((STATUS_MASK) 0x10)
419 #define A68_SUPPRESS_SEVERITY ((STATUS_MASK) 0x20)
420 #define A68_ALL_DIAGNOSTICS ((STATUS_MASK) 0x40)
421 #define A68_RERUN ((STATUS_MASK) 0x80)
422 #define A68_FORCE_DIAGNOSTICS ((STATUS_MASK) 0x100)
423 #define A68_FORCE_QUIT ((STATUS_MASK) 0x200)
424 #define A68_NO_SYNTHESIS ((STATUS_MASK) 0x400)
425 
426 /* Various forms of NIL */
427 
428 #define NO_ARRAY ((A68_ARRAY *) NULL)
429 #define NO_A68_REF ((A68_REF *) NULL)
430 #define NO_BOOK ((BOOK_T *) NULL)
431 #define NO_BOOL ((BOOL_T *) NULL)
432 #define NO_BYTE ((BYTE_T *) NULL)
433 #define NO_CONSTANT ((void *) NULL)
434 #define NO_DEC ((DEC_T *) NULL)
435 #define NO_DIAGNOSTIC ((DIAGNOSTIC_T *) NULL)
436 #define NO_EDLIN ((EDLIN_T *) NULL)
437 #define NO_FILE ((FILE *) NULL)
438 #define NO_FORMAT ((A68_FORMAT *) NULL)
439 #define NO_GINFO ((GINFO_T *) NULL)
440 #define NO_GPROC ((void (*) (NODE_T *)) NULL)
441 #define NO_HANDLE ((A68_HANDLE *) NULL)
442 #define NO_INT ((int *) NULL)
443 #define NO_JMP_BUF ((jmp_buf *) NULL)
444 #define NO_KEYWORD ((KEYWORD_T *) NULL)
445 #define NO_LINE ((LINE_T *) NULL)
446 #define NO_MOID ((MOID_T *) NULL)
447 #define NO_MP ((MP_T *) NULL)
448 #define NO_NINFO ((NODE_INFO_T *) NULL)
449 #define NO_NODE ((NODE_T *) NULL)
450 #define NO_NOTE ((void (*) (NODE_T *)) NULL)
451 #define NO_OPTION_LIST ((OPTION_LIST_T *) NULL)
452 #define NO_PACK ((PACK_T *) NULL)
453 #define NO_POSTULATE ((POSTULATE_T *) NULL)
454 #define NO_PPROC ((PROP_T (*) (NODE_T *)) NULL)
455 #define NO_PROCEDURE ((A68_PROCEDURE *) NULL)
456 #define NO_REAL ((double *) NULL)
457 #define NO_REFINEMENT ((REFINEMENT_T *) NULL)
458 #define NO_REGMATCH ((regmatch_t *) NULL)
459 #define NO_SCOPE ((SCOPE_T *) NULL)
460 #define NO_SOID ((SOID_T *) NULL)
461 #define NO_SOUND ((A68_SOUND *) NULL)
462 #define NO_STREAM NO_FILE
463 #define NO_TABLE ((TABLE_T *) NULL)
464 #define NO_TAG ((TAG_T *) NULL)
465 #define NO_TEXT ((char *) NULL)
466 #define NO_TICK ((BOOL_T *) NULL)
467 #define NO_TOKEN ((TOKEN_T *) NULL)
468 #define NO_TUPLE ((A68_TUPLE *) NULL)
469 #define NO_VAR (NULL)
470 
471 /* Status Masks */
472 
473 #define NULL_MASK ((STATUS_MASK) 0x00000000)
474 #define IN_HEAP_MASK ((STATUS_MASK) 0x00000001)
475 #define IN_FRAME_MASK ((STATUS_MASK) 0x00000002)
476 #define IN_STACK_MASK ((STATUS_MASK) 0x00000004)
477 #define INIT_MASK ((STATUS_MASK) 0x00000010)
478 #define CONSTANT_MASK ((STATUS_MASK) 0x00000020)
479 #define BLOCK_GC_MASK ((STATUS_MASK) 0x00000040)
480 #define COOKIE_MASK ((STATUS_MASK) 0x00000100)
481 #define SCOPE_ERROR_MASK ((STATUS_MASK) 0x00000100)
482 #define ALLOCATED_MASK ((STATUS_MASK) 0x00000400)
483 #define STANDENV_PROC_MASK ((STATUS_MASK) 0x00000800)
484 #define COLOUR_MASK ((STATUS_MASK) 0x00001000)
485 #define OPTIMAL_MASK ((STATUS_MASK) 0x00004000)
486 #define SERIAL_MASK ((STATUS_MASK) 0x00008000)
487 #define CROSS_REFERENCE_MASK ((STATUS_MASK) 0x00010000)
488 #define TREE_MASK ((STATUS_MASK) 0x00020000)
489 #define CODE_MASK ((STATUS_MASK) 0x00040000)
490 #define NOT_NEEDED_MASK ((STATUS_MASK) 0x00080000)
491 #define SOURCE_MASK ((STATUS_MASK) 0x00100000)
492 #define ASSERT_MASK ((STATUS_MASK) 0x00200000)
493 #define NIL_MASK ((STATUS_MASK) 0x00400000)
494 #define SKIP_PROCEDURE_MASK ((STATUS_MASK) 0x00800000)
495 #define SKIP_FORMAT_MASK ((STATUS_MASK) 0x00800000)
496 #define SKIP_ROW_MASK	((STATUS_MASK) 0x00800000)
497 #define INTERRUPTIBLE_MASK ((STATUS_MASK) 0x01000000)
498 #define BREAKPOINT_MASK ((STATUS_MASK) 0x02000000)
499 #define BREAKPOINT_TEMPORARY_MASK ((STATUS_MASK) 0x04000000)
500 #define BREAKPOINT_INTERRUPT_MASK ((STATUS_MASK) 0x08000000)
501 #define BREAKPOINT_WATCH_MASK ((STATUS_MASK) 0x10000000)
502 #define BREAKPOINT_TRACE_MASK ((STATUS_MASK) 0x20000000)
503 #define SEQUENCE_MASK ((STATUS_MASK) 0x40000000)
504 #define BREAKPOINT_ERROR_MASK ((STATUS_MASK) 0xffffffff)
505 
506 /* CODEX masks */
507 
508 #define PROC_DECLARATION_MASK ((STATUS_MASK) 0x00000001)
509 
510 /************************/
511 /* Enumerated constants */
512 /************************/
513 
514 enum {UPPER_STROPPING = 1, QUOTE_STROPPING};
515 enum {MP_PI, MP_TWO_PI, MP_HALF_PI};
516 
517 enum
518 {
519   STOP = 0,
520   A68_PATTERN,
521   ACCO_SYMBOL,
522   ACTUAL_DECLARER_MARK,
523   ALIF_IF_PART,
524   ALIF_PART,
525   ALIF_SYMBOL,
526   ALT_DO_PART,
527   ALT_DO_SYMBOL,
528   ALT_EQUALS_SYMBOL,
529   ALT_FORMAL_BOUNDS_LIST,
530   ANDF_SYMBOL,
531   AND_FUNCTION,
532   ANONYMOUS,
533   ARGUMENT,
534   ARGUMENT_LIST,
535   ASSERTION,
536   ASSERT_SYMBOL,
537   ASSIGNATION,
538   ASSIGN_SYMBOL,
539   ASSIGN_TO_SYMBOL,
540   AT_SYMBOL,
541   BEGIN_SYMBOL,
542   BITS_C_PATTERN,
543   BITS_DENOTATION,
544   BITS_PATTERN,
545   BITS_SYMBOL,
546   BOLD_COMMENT_SYMBOL,
547   BOLD_PRAGMAT_SYMBOL,
548   BOLD_TAG,
549   BOOLEAN_PATTERN,
550   BOOL_SYMBOL,
551   BOUND,
552   BOUNDS,
553   BOUNDS_LIST,
554   BRIEF_OUSE_PART,
555   BRIEF_CONFORMITY_OUSE_PART,
556   BRIEF_ELIF_PART,
557   BRIEF_OPERATOR_DECLARATION,
558   BUS_SYMBOL,
559   BYTES_SYMBOL,
560   BY_PART,
561   BY_SYMBOL,
562   CALL,
563   CASE_CHOICE_CLAUSE,
564   CASE_CLAUSE,
565   CASE_IN_PART,
566   CASE_OUSE_PART,
567   CASE_PART,
568   CASE_SYMBOL,
569   CAST,
570   CHANNEL_SYMBOL,
571   CHAR_C_PATTERN,
572   CHAR_SYMBOL,
573   CHOICE,
574   CHOICE_PATTERN,
575   CLASS_SYMBOL,
576   CLOSED_CLAUSE,
577   CLOSE_SYMBOL,
578   CODE_CLAUSE,
579   CODE_LIST,
580   CODE_SYMBOL,
581   COLLATERAL_CLAUSE,
582   COLLECTION,
583   COLON_SYMBOL,
584   COLUMN_FUNCTION,
585   COLUMN_SYMBOL,
586   COMMA_SYMBOL,
587   COMPLEX_PATTERN,
588   COMPLEX_SYMBOL,
589   COMPL_SYMBOL,
590   CONDITIONAL_CLAUSE,
591   CONFORMITY_CHOICE,
592   CONFORMITY_CLAUSE,
593   CONFORMITY_IN_PART,
594   CONFORMITY_OUSE_PART,
595   CONSTRUCT,
596   DECLARATION_LIST,
597   DECLARER,
598   DEFINING_IDENTIFIER,
599   DEFINING_INDICANT,
600   DEFINING_OPERATOR,
601   DENOTATION,
602   DEPROCEDURING,
603   DEREFERENCING,
604   DIAGONAL_FUNCTION,
605   DIAGONAL_SYMBOL,
606   DOTDOT_SYMBOL,
607   DOWNTO_SYMBOL,
608   DO_PART,
609   DO_SYMBOL,
610   DYNAMIC_REPLICATOR,
611   EDOC_SYMBOL,
612   ELIF_IF_PART,
613   ELIF_PART,
614   ELIF_SYMBOL,
615   ELSE_BAR_SYMBOL,
616   ELSE_OPEN_PART,
617   ELSE_PART,
618   ELSE_SYMBOL,
619   EMPTY_SYMBOL,
620   ENCLOSED_CLAUSE,
621   END_SYMBOL,
622   ENQUIRY_CLAUSE,
623   ENVIRON_NAME,
624   ENVIRON_SYMBOL,
625   EQUALS_SYMBOL,
626   ERROR,
627   ERROR_IDENTIFIER,
628   ESAC_SYMBOL,
629   EXIT_SYMBOL,
630   EXPONENT_FRAME,
631   FALSE_SYMBOL,
632   FIELD,
633   FIELD_IDENTIFIER,
634   FILE_SYMBOL,
635   FIRM,
636   FIXED_C_PATTERN,
637   FI_SYMBOL,
638   FLEX_SYMBOL,
639   FLOAT_C_PATTERN,
640   FORMAL_BOUNDS,
641   FORMAL_BOUNDS_LIST,
642   FORMAL_DECLARERS,
643   FORMAL_DECLARERS_LIST,
644   FORMAL_DECLARER_MARK,
645   FORMAT_A_FRAME,
646   FORMAT_CLOSE_SYMBOL,
647   FORMAT_DELIMITER_SYMBOL,
648   FORMAT_D_FRAME,
649   FORMAT_E_FRAME,
650   FORMAT_IDENTIFIER,
651   FORMAT_ITEM_A,
652   FORMAT_ITEM_B,
653   FORMAT_ITEM_C,
654   FORMAT_ITEM_D,
655   FORMAT_ITEM_E,
656   FORMAT_ITEM_ESCAPE,
657   FORMAT_ITEM_F,
658   FORMAT_ITEM_G,
659   FORMAT_ITEM_H,
660   FORMAT_ITEM_I,
661   FORMAT_ITEM_J,
662   FORMAT_ITEM_K,
663   FORMAT_ITEM_L,
664   FORMAT_ITEM_M,
665   FORMAT_ITEM_MINUS,
666   FORMAT_ITEM_N,
667   FORMAT_ITEM_O,
668   FORMAT_ITEM_P,
669   FORMAT_ITEM_PLUS,
670   FORMAT_ITEM_POINT,
671   FORMAT_ITEM_Q,
672   FORMAT_ITEM_R,
673   FORMAT_ITEM_S,
674   FORMAT_ITEM_T,
675   FORMAT_ITEM_U,
676   FORMAT_ITEM_V,
677   FORMAT_ITEM_W,
678   FORMAT_ITEM_X,
679   FORMAT_ITEM_Y,
680   FORMAT_ITEM_Z,
681   FORMAT_I_FRAME,
682   FORMAT_OPEN_SYMBOL,
683   FORMAT_PATTERN,
684   FORMAT_POINT_FRAME,
685   FORMAT_SYMBOL,
686   FORMAT_TEXT,
687   FORMAT_Z_FRAME,
688   FORMULA,
689   FOR_PART,
690   FOR_SYMBOL,
691   FROM_PART,
692   FROM_SYMBOL,
693   GENERAL_C_PATTERN,
694   GENERAL_PATTERN,
695   GENERATOR,
696   GENERIC_ARGUMENT,
697   GENERIC_ARGUMENT_LIST,
698   GOTO_SYMBOL,
699   GO_SYMBOL,
700   GUARDED_CONDITIONAL_CLAUSE,
701   GUARDED_LOOP_CLAUSE,
702   HEAP_SYMBOL,
703   IDENTIFIER,
704   IDENTITY_DECLARATION,
705   IDENTITY_RELATION,
706   IF_PART,
707   IF_SYMBOL,
708   INDICANT,
709   INITIALISER_SERIES,
710   INSERTION,
711   INTEGRAL_C_PATTERN,
712   INTEGRAL_MOULD,
713   INTEGRAL_PATTERN,
714   INT_DENOTATION,
715   INT_SYMBOL,
716   IN_SYMBOL,
717   IN_TYPE_MODE,
718   ISNT_SYMBOL,
719   IS_SYMBOL,
720   JUMP,
721   KEYWORD,
722   LABEL,
723   LABELED_UNIT,
724   LABEL_IDENTIFIER,
725   LABEL_SEQUENCE,
726   LITERAL,
727   LOCAL_LABEL,
728   LOC_SYMBOL,
729   LONGETY,
730   LONG_SYMBOL,
731   LOOP_CLAUSE,
732   LOOP_IDENTIFIER,
733   MAIN_SYMBOL,
734   MEEK,
735   MODE_BITS,
736   MODE_BOOL,
737   MODE_BYTES,
738   MODE_CHAR,
739   MODE_COMPLEX,
740   MODE_DECLARATION,
741   MODE_FILE,
742   MODE_FORMAT,
743   MODE_INT,
744   MODE_LONGLONG_BITS,
745   MODE_LONGLONG_COMPLEX,
746   MODE_LONGLONG_INT,
747   MODE_LONGLONG_REAL,
748   MODE_LONG_BITS,
749   MODE_LONG_BYTES,
750   MODE_LONG_COMPLEX,
751   MODE_LONG_INT,
752   MODE_LONG_REAL,
753   MODE_NO_CHECK,
754   MODE_PIPE,
755   MODE_REAL,
756   MODE_SOUND,
757   MODE_SYMBOL,
758   MONADIC_FORMULA,
759   MONAD_SEQUENCE,
760   NEW_SYMBOL,
761   NIHIL,
762   NIL_SYMBOL,
763   NORMAL_IDENTIFIER,
764   NO_SORT,
765   OCCA_SYMBOL,
766   OD_SYMBOL,
767   OF_SYMBOL,
768   OPEN_PART,
769   OPEN_SYMBOL,
770   OPERATOR,
771   OPERATOR_DECLARATION,
772   OPERATOR_PLAN,
773   OP_SYMBOL,
774   ORF_SYMBOL,
775   OR_FUNCTION,
776   OUSE_PART,
777   OUSE_SYMBOL,
778   OUT_PART,
779   OUT_SYMBOL,
780   OUT_TYPE_MODE,
781   PARALLEL_CLAUSE,
782   PARAMETER,
783   PARAMETER_IDENTIFIER,
784   PARAMETER_LIST,
785   PARAMETER_PACK,
786   PARTICULAR_PROGRAM,
787   PAR_SYMBOL,
788   PICTURE,
789   PICTURE_LIST,
790   PIPE_SYMBOL,
791   POINT_SYMBOL,
792   PRIMARY,
793   PRIORITY,
794   PRIORITY_DECLARATION,
795   PRIO_SYMBOL,
796   PROCEDURE_DECLARATION,
797   PROCEDURE_VARIABLE_DECLARATION,
798   PROCEDURING,
799   PROC_SYMBOL,
800   QUALIFIER,
801   RADIX_FRAME,
802   REAL_DENOTATION,
803   REAL_PATTERN,
804   REAL_SYMBOL,
805   REF_SYMBOL,
806   REPLICATOR,
807   ROUTINE_TEXT,
808   ROUTINE_UNIT,
809   ROWING,
810   ROWS_SYMBOL,
811   ROW_CHAR_DENOTATION,
812   ROW_FUNCTION,
813   ROW_SYMBOL,
814   SECONDARY,
815   SELECTION,
816   SELECTOR,
817   SEMA_SYMBOL,
818   SEMI_SYMBOL,
819   SERIAL_CLAUSE,
820   SERIES_MODE,
821   SHORTETY,
822   SHORT_SYMBOL,
823   SIGN_MOULD,
824   SKIP,
825   SKIP_SYMBOL,
826   SLICE,
827   SOFT,
828   SOME_CLAUSE,
829   SOUND_SYMBOL,
830   SPECIFICATION,
831   SPECIFIED_UNIT,
832   SPECIFIED_UNIT_LIST,
833   SPECIFIED_UNIT_UNIT,
834   SPECIFIER,
835   SPECIFIER_IDENTIFIER,
836   STANDARD,
837   STATIC_REPLICATOR,
838   STOWED_MODE,
839   STRING_C_PATTERN,
840   STRING_PATTERN,
841   STRING_SYMBOL,
842   STRONG,
843   STRUCTURED_FIELD,
844   STRUCTURED_FIELD_LIST,
845   STRUCTURE_PACK,
846   STRUCT_SYMBOL,
847   STYLE_II_COMMENT_SYMBOL,
848   STYLE_I_COMMENT_SYMBOL,
849   STYLE_I_PRAGMAT_SYMBOL,
850   SUB_SYMBOL,
851   SUB_UNIT,
852   TERTIARY,
853   THEN_BAR_SYMBOL,
854   THEN_PART,
855   THEN_SYMBOL,
856   TO_PART,
857   TO_SYMBOL,
858   TRANSPOSE_FUNCTION,
859   TRANSPOSE_SYMBOL,
860   TRIMMER,
861   TRUE_SYMBOL,
862   UNION_DECLARER_LIST,
863   UNION_PACK,
864   UNION_SYMBOL,
865   UNIT,
866   UNITING,
867   UNIT_LIST,
868   UNIT_SERIES,
869   UNTIL_PART,
870   UNTIL_SYMBOL,
871   VARIABLE_DECLARATION,
872   VIRTUAL_DECLARER_MARK,
873   VOIDING,
874   VOID_SYMBOL,
875   WEAK,
876   WHILE_PART,
877   WHILE_SYMBOL,
878   WIDENING,
879   WILDCARD
880 };
881 
882 enum
883 {
884   INPUT_BUFFER = 0, OUTPUT_BUFFER, EDIT_BUFFER, UNFORMATTED_BUFFER,
885   FORMATTED_BUFFER, DOMAIN_BUFFER, PATH_BUFFER, REQUEST_BUFFER,
886   CONTENT_BUFFER, STRING_BUFFER, PATTERN_BUFFER, REPLACE_BUFFER,
887   FIXED_TRANSPUT_BUFFERS
888 };
889 
890 enum
891 {
892   NO_DEFLEXING = 1, SAFE_DEFLEXING, ALIAS_DEFLEXING, FORCE_DEFLEXING,
893   SKIP_DEFLEXING
894 };
895 
896 /*****************************************************************************/
897 /* Type definitions                                                          */
898 /*****************************************************************************/
899 
900 typedef double MP_T;
901 typedef int *A68_ALIGN_T;
902 typedef int ADDR_T, BOOL_T, FILE_T, LEAP_T;
903 typedef unsigned STATUS_MASK;
904 typedef unsigned char BYTE_T;
905 typedef MP_T A68_LONG[DEFAULT_DOUBLE_DIGITS + 2];
906 typedef A68_LONG A68_LONG_COMPLEX[2];
907 typedef BYTE_T * A68_STRUCT;
908 typedef struct A68_ARRAY A68_ARRAY;
909 typedef struct A68_BITS A68_BITS;
910 typedef struct A68_BOOL A68_BOOL;
911 typedef struct A68_BYTES A68_BYTES;
912 typedef struct A68_CHANNEL A68_CHANNEL;
913 typedef struct A68_CHAR A68_CHAR;
914 typedef struct A68_COLLITEM A68_COLLITEM;
915 typedef struct A68_FILE A68_FILE;
916 typedef struct A68_FORMAT A68_FORMAT;
917 typedef struct A68_HANDLE A68_HANDLE;
918 typedef struct A68_INT A68_INT;
919 typedef struct A68_LONG_BYTES A68_LONG_BYTES;
920 typedef struct A68_PROCEDURE A68_PROCEDURE;
921 typedef struct A68_REAL A68_REAL;
922 typedef struct A68_REF A68_REF, A68_ROW;
923 typedef struct A68_SOUND A68_SOUND;
924 typedef struct A68_STREAM A68_STREAM;
925 typedef struct A68_TUPLE A68_TUPLE;
926 typedef struct A68_UNION A68_UNION;
927 typedef struct DIAGNOSTIC_T DIAGNOSTIC_T;
928 typedef struct FILES_T FILES_T;
929 typedef struct GINFO_T GINFO_T;
930 typedef struct KEYWORD_T KEYWORD_T;
931 typedef struct MODES_T MODES_T;
932 typedef struct MODULE_T MODULE_T;
933 typedef struct MOID_T MOID_T;
934 typedef struct NODE_INFO_T NODE_INFO_T;
935 typedef struct NODE_T NODE_T;
936 typedef struct OPTIONS_T OPTIONS_T;
937 typedef struct OPTION_LIST_T OPTION_LIST_T;
938 typedef struct PACK_T PACK_T;
939 typedef struct POSTULATE_T POSTULATE_T;
940 typedef struct PROP_T PROP_T;
941 typedef struct REFINEMENT_T REFINEMENT_T;
942 typedef struct SOID_T SOID_T;
943 typedef struct LINE_T LINE_T;
944 typedef struct TABLE_T TABLE_T;
945 typedef struct TAG_T TAG_T;
946 typedef struct TOKEN_T TOKEN_T;
947 typedef void GPROC (NODE_T *);
948 typedef struct ACTIVATION_RECORD ACTIVATION_RECORD;
949 
950 struct ACTIVATION_RECORD
951 {
952   ADDR_T static_link, dynamic_link, dynamic_scope, parameters;
953   NODE_T *node;
954   jmp_buf *jump_stat;
955   BOOL_T proc_frame;
956   int frame_no, frame_level, parameter_level;
957 #if defined HAVE_PARALLEL_CLAUSE
958   pthread_t thread_id;
959 #endif
960 };
961 
962 typedef PROP_T PROP_PROC (NODE_T *);
963 
964 struct PROP_T
965 {
966   PROP_PROC *unit;
967   NODE_T *source;
968 };
969 
970 struct A68_STREAM
971 {
972   char *name;
973   FILE_T fd;
974   BOOL_T opened, writemood;
975 };
976 
977 struct DIAGNOSTIC_T
978 {
979   int attribute, number;
980   NODE_T *where;
981   LINE_T *line;
982   char *text, *symbol;
983   DIAGNOSTIC_T *next;
984 };
985 
986 
987 struct FILES_T
988 {
989   char *path, *initial_name, *generic_name;
990   struct A68_STREAM binary, diags, library, script, object, source, listing, pretty;
991 };
992 
993 struct KEYWORD_T
994 {
995   int attribute;
996   char *text;
997   KEYWORD_T *less, *more;
998 };
999 
1000 
1001 struct MODES_T
1002 {
1003   MOID_T *BITS, *BOOL, *BYTES, *CHANNEL, *CHAR, *COLLITEM, *COMPL, *COMPLEX,
1004   *C_STRING, *ERROR, *FILE, *FORMAT, *HIP, *INT, *LONG_BITS, *LONG_BYTES,
1005   *LONG_COMPL, *LONG_COMPLEX, *LONG_INT, *LONGLONG_BITS, *LONGLONG_COMPL,
1006   *LONGLONG_COMPLEX, *LONGLONG_INT, *LONGLONG_REAL, *LONG_REAL, *NUMBER, *PIPE,
1007   *PROC_REAL_REAL, *PROC_REF_FILE_BOOL, *PROC_REF_FILE_VOID, *PROC_ROW_CHAR,
1008   *PROC_STRING, *PROC_VOID, *REAL, *REF_BITS, *REF_BOOL, *REF_BYTES,
1009   *REF_CHAR, *REF_COMPL, *REF_COMPLEX, *REF_FILE, *REF_FORMAT, *REF_INT,
1010   *REF_LONG_BITS, *REF_LONG_BYTES, *REF_LONG_COMPL, *REF_LONG_COMPLEX,
1011   *REF_LONG_INT, *REF_LONGLONG_BITS, *REF_LONGLONG_COMPL,
1012   *REF_LONGLONG_COMPLEX, *REF_LONGLONG_INT, *REF_LONGLONG_REAL,
1013   *REF_LONG_REAL, *REF_PIPE, *REF_REAL, *REF_REF_FILE, *REF_ROW_CHAR,
1014   *REF_ROW_COMPLEX, *REF_ROW_INT, *REF_ROW_REAL, *REF_ROWROW_COMPLEX,
1015   *REF_ROWROW_REAL, *REF_SOUND, *REF_STRING, *ROW_BITS, *ROW_BOOL, *ROW_CHAR,
1016   *ROW_COMPLEX, *ROW_INT, *ROW_LONG_BITS, *ROW_LONGLONG_BITS, *ROW_REAL,
1017   *ROW_ROW_CHAR, *ROWROW_COMPLEX, *ROWROW_REAL, *ROWS, *ROW_SIMPLIN,
1018   *ROW_SIMPLOUT, *ROW_STRING, *SEMA, *SIMPLIN, *SIMPLOUT, *SOUND, *SOUND_DATA,
1019   *STRING, *FLEX_ROW_CHAR, *FLEX_ROW_BOOL, *UNDEFINED, *VACUUM, *VOID;
1020 };
1021 
1022 struct OPTIONS_T
1023 {
1024   OPTION_LIST_T *list;
1025   BOOL_T backtrace, brackets, check_only, clock, cross_reference, debug, compile, keep, fold, local, moid_listing, object_listing, optimise, portcheck, pragmat_sema, pretty, reductions, regression_test, run, rerun, run_script, source_listing, standard_prelude_listing, statistics_listing, strict, stropping, trace, tree_listing, unused, verbose, version, no_warnings, quiet;
1026   int time_limit, opt_level, indent;
1027   STATUS_MASK nodemask;
1028 };
1029 
1030 struct MODULE_T
1031 {
1032   BOOL_T tree_listing_safe, cross_reference_safe;
1033   FILES_T files;
1034   NODE_T *top_node;
1035   MOID_T *top_moid, *standenv_moid;
1036   OPTIONS_T options;
1037   PROP_T global_prop;
1038   REFINEMENT_T *top_refinement;
1039   LINE_T *top_line;
1040   int error_count, warning_count, source_scan;
1041   jmp_buf rendez_vous;
1042   struct {
1043     LINE_T *save_l;
1044     char *save_s, save_c;
1045   } scan_state;
1046 };
1047 
1048 struct MOID_T
1049 {
1050   int attribute, dim, number, short_id, size, digits, sizec, digitsc;
1051   BOOL_T has_rows, use, portable, derivate;
1052   NODE_T *node;
1053   PACK_T *pack;
1054   MOID_T *sub, *equivalent_mode, *slice, *deflexed_mode, *name, *multiple_mode, *next, *rowed, *trim;
1055 };
1056 
1057 struct NODE_T
1058 {
1059   GINFO_T *genie;
1060   int number, attribute, annotation;
1061   MOID_T *type;
1062   NODE_INFO_T *info;
1063   NODE_T *next, *previous, *sub, *sequence, *nest;
1064   PACK_T *pack;
1065   STATUS_MASK status, codex;
1066   TABLE_T *symbol_table, *non_local;
1067   TAG_T *tag;
1068 };
1069 
1070 struct NODE_INFO_T
1071 {
1072   int procedure_level, priority, pragment_type;
1073   char *char_in_line, *symbol, *pragment, *expr;
1074   LINE_T *line;
1075 };
1076 
1077 struct GINFO_T
1078 {
1079   PROP_T propagator;
1080   BOOL_T is_coercion, is_new_lexical_level, need_dns;
1081   BYTE_T *offset;
1082   MOID_T *partial_proc, *partial_locale;
1083   NODE_T *parent;
1084   char *compile_name;
1085   int level, argsize, size, compile_node;
1086   void *constant;
1087 };
1088 
1089 struct OPTION_LIST_T
1090 {
1091   char *str;
1092   int scan;
1093   BOOL_T processed;
1094   LINE_T *line;
1095   OPTION_LIST_T *next;
1096 };
1097 
1098 struct PACK_T
1099 {
1100   MOID_T *type;
1101   char *text;
1102   NODE_T *node;
1103   PACK_T *next, *previous;
1104   int size;
1105   ADDR_T offset;
1106 };
1107 
1108 struct POSTULATE_T
1109 {
1110   MOID_T *a, *b;
1111   POSTULATE_T *next;
1112 };
1113 
1114 struct REFINEMENT_T
1115 {
1116   REFINEMENT_T *next;
1117   char *name;
1118   LINE_T *line_defined, *line_applied;
1119   int applications;
1120   NODE_T *node_defined, *begin, *end;
1121 };
1122 
1123 struct SOID_T
1124 {
1125   int attribute, sort, cast;
1126   MOID_T *type;
1127   NODE_T *node;
1128   SOID_T *next;
1129 };
1130 
1131 struct LINE_T
1132 {
1133   char marker[6], *string, *filename;
1134   DIAGNOSTIC_T *diagnostics;
1135   int number, print_status;
1136   BOOL_T list;
1137   LINE_T *next, *previous;
1138 };
1139 
1140 struct TABLE_T
1141 {
1142   int level, nest, attribute;
1143   BOOL_T initialise_frame, initialise_anon, proc_ops;
1144   ADDR_T ap_increment;
1145   TABLE_T *previous, *outer;
1146   TAG_T *identifiers, *operators, *priority, *indicants, *labels, *anonymous;
1147   NODE_T *jump_to, *sequence;
1148 };
1149 
1150 struct TAG_T
1151 {
1152   STATUS_MASK status, codex;
1153   TABLE_T *symbol_table;
1154   MOID_T *type;
1155   NODE_T *node, *unit;
1156   char *value;
1157   GPROC *procedure;
1158   BOOL_T scope_assigned, use, in_proc, a68g_standenv_proc, loc_assigned, portable;
1159   int priority, heap, scope, size, youngest_environ, number;
1160   ADDR_T offset;
1161   TAG_T *next, *body;
1162 };
1163 
1164 struct TOKEN_T
1165 {
1166   char *text;
1167   TOKEN_T *less, *more;
1168 };
1169 
1170 /**
1171 @struct A68_HANDLE
1172 @brief Handle for REF into the HEAP.
1173 @details
1174 A REF into the HEAP points at a HANDLE.
1175 The HANDLE points at the actual object in the HEAP.
1176 Garbage collection modifies HANDLEs, but not REFs.
1177 **/
1178 
1179 struct A68_HANDLE
1180 {
1181   STATUS_MASK status;
1182   BYTE_T *pointer;
1183   int size;
1184   MOID_T *type;
1185   A68_HANDLE *next, *previous;
1186 };
1187 
1188 /**
1189 @struct A68_REF
1190 @brief Fat A68 pointer.
1191 **/
1192 
1193 struct A68_REF
1194 {
1195   STATUS_MASK status;
1196   ADDR_T offset;
1197   ADDR_T scope; /**< Dynamic scope. **/
1198   A68_HANDLE *handle;
1199 };
1200 
1201 /**
1202 @struct A68_ARRAY
1203 @brief A68 array descriptor.
1204 @details
1205 A row is an A68_REF to an A68_ARRAY.
1206 
1207 An A68_ARRAY is followed by one A68_TUPLE per dimension.
1208 
1209 @verbatim
1210 A68_REF row -> A68_ARRAY ----+   ARRAY: Description of row, ref to elements
1211                A68_TUPLE 1   |   TUPLE: Bounds, one for every dimension
1212                ...           |
1213                A68_TUPLE dim |
1214                ...           |
1215                ...           |
1216                Element 1 <---+   Element: Sequential row elements, in the heap
1217                ...                        Not always contiguous - trims!
1218 @endverbatim
1219 **/
1220 
1221 struct A68_ARRAY
1222 {
1223   MOID_T *type;
1224   int dim, elem_size;
1225   ADDR_T slice_offset, field_offset;
1226   A68_REF array;
1227 };
1228 
1229 struct A68_BITS
1230 {
1231   STATUS_MASK status;
1232   unsigned value;
1233 };
1234 
1235 struct A68_BYTES
1236 {
1237   STATUS_MASK status;
1238   char value[BYTES_WIDTH + 1];
1239 };
1240 
1241 struct A68_CHANNEL
1242 {
1243   STATUS_MASK status;
1244   BOOL_T reset, set, get, put, bin, draw, compress;
1245 };
1246 
1247 struct A68_BOOL
1248 {
1249   STATUS_MASK status;
1250   int value;
1251 };
1252 
1253 struct A68_CHAR
1254 {
1255   STATUS_MASK status;
1256   int value;
1257 };
1258 
1259 struct A68_COLLITEM
1260 {
1261   STATUS_MASK status;
1262   int count;
1263 };
1264 
1265 struct A68_INT
1266 {
1267   STATUS_MASK status;
1268   int value;
1269 };
1270 
1271 /**
1272 @struct A68_FORMAT
1273 @brief A68 format descriptor.
1274 @details
1275 A format behaves very much like a procedure.
1276 **/
1277 
1278 struct A68_FORMAT
1279 {
1280   STATUS_MASK status;
1281   NODE_T *body; /**< Entry point in syntax tree. **/
1282   ADDR_T environ; /**< Frame pointer to environ. **/
1283 };
1284 
1285 struct A68_LONG_BYTES
1286 {
1287   STATUS_MASK status;
1288   char value[LONG_BYTES_WIDTH + 1];
1289 };
1290 
1291 /**
1292 @struct A68_PROCEDURE
1293 @brief A68 procedure descriptor.
1294 **/
1295 
1296 struct A68_PROCEDURE
1297 {
1298   STATUS_MASK status;
1299   union {NODE_T *node; GPROC *procedure;} body;
1300   /**< Entry point in syntax tree or precompiled C procedure. **/
1301   A68_HANDLE *locale; /**< Locale for partial parametrisation. **/
1302   MOID_T *type;
1303   ADDR_T environ; /**< Frame pointer to environ. **/
1304 };
1305 
1306 struct A68_REAL
1307 {
1308   STATUS_MASK status;
1309   double value;
1310 };
1311 
1312 typedef A68_REAL A68_COMPLEX[2];
1313 
1314 /**
1315 @struct A68_TUPLE
1316 @brief A tuple containing bounds etcetera for one dimension.
1317 **/
1318 
1319 struct A68_TUPLE
1320 {
1321   int upper_bound, lower_bound, shift, span, k;
1322 };
1323 
1324 struct A68_UNION
1325 {
1326   STATUS_MASK status;
1327   void *value;
1328 };
1329 
1330 struct A68_SOUND
1331 {
1332   STATUS_MASK status;
1333   unsigned num_channels, sample_rate, bits_per_sample, num_samples, data_size;
1334   A68_REF data;
1335 };
1336 
1337 struct A68_FILE
1338 {
1339   STATUS_MASK status;
1340   A68_CHANNEL channel;
1341   A68_FORMAT format;
1342   A68_PROCEDURE file_end_mended, page_end_mended, line_end_mended, value_error_mended, open_error_mended, transput_error_mended, format_end_mended, format_error_mended;
1343   A68_REF identification, terminator, string;
1344   ADDR_T frame_pointer, stack_pointer; /* Since formats open frames*/
1345   BOOL_T read_mood, write_mood, char_mood, draw_mood, opened, open_exclusive, end_of_file, tmp_file;
1346   FILE_T fd;
1347   int transput_buffer, strpos, file_entry;
1348   struct
1349   {
1350     FILE *stream;
1351 #if defined HAVE_GNU_PLOTUTILS
1352     plPlotter *plotter;
1353     plPlotterParams *plotter_params;
1354 #endif
1355     BOOL_T device_made, device_opened;
1356     A68_REF device, page_size;
1357     int device_handle /* deprecated*/ , window_x_size, window_y_size;
1358     double x_coord, y_coord, red, green, blue;
1359   }
1360   device;
1361 #if defined HAVE_POSTGRESQL
1362   PGconn *connection;
1363   PGresult *result;
1364 #endif
1365 };
1366 
1367 /*****************************************************************************/
1368 /* Macros                                                                    */
1369 /*****************************************************************************/
1370 
1371 #define COPY(d, s, n) {\
1372   int _m_k = (n); BYTE_T *_m_u = (BYTE_T *) (d), *_m_v = (BYTE_T *) (s);\
1373   while (_m_k--) {*_m_u++ = *_m_v++;}}
1374 
1375 #define COPY_ALIGNED(d, s, n) {\
1376   int _m_k = (n); A68_ALIGN_T *_m_u = (A68_ALIGN_T *) (d), *_m_v = (A68_ALIGN_T *) (s);\
1377   while (_m_k > 0) {*_m_u++ = *_m_v++; _m_k -= A68_ALIGNMENT;}}
1378 
1379 #define MOVE(d, s, n) {\
1380   int _m_k = (int) (n); BYTE_T *_m_d = (BYTE_T *) (d), *_m_s = (BYTE_T *) (s);\
1381   if (_m_s < _m_d) {\
1382     _m_d += _m_k; _m_s += _m_k;\
1383     while (_m_k--) {*(--_m_d) = *(--_m_s);}\
1384   } else {\
1385     while (_m_k--) {*(_m_d++) = *(_m_s++);}\
1386   }}
1387 
1388 #define FILL(d, s, n) {\
1389    int _m_k = (n); BYTE_T *_m_u = (BYTE_T *) (d), _m_v = (BYTE_T) (s);\
1390    while (_m_k--) {*_m_u++ = _m_v;}}
1391 
1392 #define FILL_ALIGNED(d, s, n) {\
1393    int _m_k = (n); A68_ALIGN_T *_m_u = (A68_ALIGN_T *) (d), _m_v = (A68_ALIGN_T) (s);\
1394    while (_m_k > 0) {*_m_u++ = _m_v; _m_k -= A68_ALIGNMENT;}}
1395 
1396 #define ABEND(p, reason, info) {\
1397   if (p) {\
1398     abend ((char *) reason, (char *) info, __FILE__, __LINE__);\
1399   }}
1400 
1401 #if defined HAVE_CURSES
1402 #define ASSERT(f) {\
1403   if (!(f)) {\
1404     if (a68g_curses_mode == A68_TRUE) {\
1405       (void) attrset (A_NORMAL);\
1406       (void) endwin ();\
1407       a68g_curses_mode = A68_FALSE;\
1408     }\
1409     ABEND(A68_TRUE, "Return value failure", error_specification ())\
1410   }}
1411 #else
1412 #define ASSERT(f) {\
1413   ABEND((!(f)), "Return value failure", error_specification ())\
1414   }
1415 #endif
1416 
1417 /*
1418 Some macros to overcome the ambiguity in having signed or unsigned char
1419 on various systems. PDP-11s and IBM 370s are still haunting us with this.
1420 */
1421 
1422 #define IS_ALNUM(c) isalnum ((unsigned char) (c))
1423 #define IS_ALPHA(c) isalpha ((unsigned char) (c))
1424 #define IS_CNTRL(c) iscntrl ((unsigned char) (c))
1425 #define IS_DIGIT(c) isdigit ((unsigned char) (c))
1426 #define IS_GRAPH(c) isgraph ((unsigned char) (c))
1427 #define IS_LOWER(c) islower ((unsigned char) (c))
1428 #define IS_PRINT(c) isprint ((unsigned char) (c))
1429 #define IS_PUNCT(c) ispunct ((unsigned char) (c))
1430 #define IS_SPACE(c) isspace ((unsigned char) (c))
1431 #define IS_UPPER(c) isupper ((unsigned char) (c))
1432 #define IS_XDIGIT(c) isxdigit ((unsigned char) (c))
1433 #define TO_LOWER(c) (char) tolower ((unsigned char) (c))
1434 #define TO_UCHAR(c) ((c) >= 0 ? (int) (c) : (int) (UCHAR_MAX + (int) (c) + 1))
1435 #define TO_UPPER(c) (char) toupper ((unsigned char) (c))
1436 
1437 /* Macro's for fat A68 pointers */
1438 
1439 #define ADDRESS(z) (&((IS_IN_HEAP (z) ? REF_POINTER (z) : stack_segment)[REF_OFFSET (z)]))
1440 #define ARRAY_ADDRESS(z) (&(REF_POINTER (z)[REF_OFFSET (z)]))
1441 #define DEREF(mode, expr) ((mode *) ADDRESS (expr))
1442 #define FILE_DEREF(p) DEREF (A68_FILE, (p))
1443 #define HEAP_ADDRESS(n) ((BYTE_T *) & (heap_segment[n]))
1444 #define IS_IN_FRAME(z) (STATUS (z) & IN_FRAME_MASK)
1445 #define IS_IN_HEAP(z) (STATUS (z) & IN_HEAP_MASK)
1446 #define IS_IN_STACK(z) (STATUS (z) & IN_STACK_MASK)
1447 #define IS_NIL(p) ((BOOL_T) ((STATUS (&(p)) & NIL_MASK) != 0))
1448 #define LOCAL_ADDRESS(z) (& stack_segment[REF_OFFSET (z)])
1449 #define REF_HANDLE(z) (HANDLE (z))
1450 #define REF_OFFSET(z) (OFFSET (z))
1451 #define REF_POINTER(z) (POINTER (REF_HANDLE (z)))
1452 #define REF_SCOPE(z) (SCOPE (z))
1453 #define STACK_ADDRESS(n) ((BYTE_T *) &(stack_segment[(n)]))
1454 #define STACK_OFFSET(n) (STACK_ADDRESS (stack_pointer + (int) (n)))
1455 #define STACK_TOP (STACK_ADDRESS (stack_pointer))
1456 
1457 /* Miscellaneous macros */
1458 
1459 #define SIZE_AL(p) ((int) A68_ALIGN (sizeof (p)))
1460 #define A68_REF_SIZE (SIZE_AL (A68_REF))
1461 #define A68_UNION_SIZE (SIZE_AL (A68_UNION))
1462 
1463 #define A68_ALIGN(s) ((int) ((s) % A68_ALIGNMENT) == 0 ? (s) : ((s) - (s) % A68_ALIGNMENT + A68_ALIGNMENT))
1464 #define A68_ALIGNMENT ((int) (sizeof (A68_ALIGN_T)))
1465 #define A68_ALIGN_8(s) ((int) ((s) % 8) == 0 ? (s) : ((s) - (s) % 8 + 8))
1466 #define A68_SOUND_BYTES(s) ((int) (BITS_PER_SAMPLE (s)) / 8 + (int) (BITS_PER_SAMPLE (s) % 8 == 0 ? 0 : 1))
1467 #define A68_SOUND_DATA_SIZE(s) ((int) (NUM_SAMPLES (s)) * (int) (NUM_CHANNELS (s)) * (int) (A68_SOUND_BYTES (s)))
1468 #define ABS(n) ((n) >= 0 ? (n) : -(n))
1469 #define BACKWARD(p) (p = PREVIOUS (p))
1470 #define BITS_WIDTH ((int) (1 + ceil (log ((double) A68_MAX_INT) / log((double) 2))))
1471 #define DEFLEX(p) (DEFLEXED (p) != NO_MOID ? DEFLEXED(p) : (p))
1472 #define EXP_WIDTH ((int) (1 + log10 ((double) DBL_MAX_10_EXP)))
1473 #define FORWARD(p) ((p) = NEXT (p))
1474 #define INT_WIDTH ((int) (1 + floor (log ((double) A68_MAX_INT) / log ((double) 10))))
1475 #define LONGLONG_INT_WIDTH (1 + LONGLONG_WIDTH)
1476 #define LONGLONG_REAL_WIDTH ((varying_mp_digits - 1) * LOG_MP_BASE)
1477 #define LONGLONG_WIDTH (varying_mp_digits * LOG_MP_BASE)
1478 #define LONG_INT_WIDTH (1 + LONG_WIDTH)
1479 #define LONG_REAL_WIDTH ((LONG_MP_DIGITS - 1) * LOG_MP_BASE)
1480 #define LONG_WIDTH (LONG_MP_DIGITS * LOG_MP_BASE)
1481 #define MP_BITS_WIDTH(k) ((int) ceil((k) * LOG_MP_BASE * LOG2_10) - 1)
1482 #define MP_BITS_WORDS(k) ((int) ceil ((double) MP_BITS_WIDTH (k) / (double) MP_BITS_BITS))
1483 #define PM(m) (moid_to_string (m, 132, NO_NODE))
1484 #define SIGN(n) ((n) == 0 ? 0 : ((n) > 0 ? 1 : -1))
1485 #define STATUS_CLEAR(p, q) {STATUS (p) &= (~(q));}
1486 #define STATUS_SET(p, q) {STATUS (p) |= (q);}
1487 #define STATUS_TEST(p, q) ((STATUS (p) & (q)) != (unsigned) 0)
1488 #define WIS(p) where_in_source (STDOUT_FILENO, (p))
1489 #define WRITE(f, s) io_write_string ((f), (s));
1490 #define WRITELN(f, s) {io_close_tty_line (); WRITE ((f), (s));}
1491 
1492 /* Access macros */
1493 
1494 #define A(p) ((p)->a)
1495 #define A68G_STANDENV_PROC(p) ((p)->a68g_standenv_proc)
1496 #define ACTION(p) ((p)->action)
1497 #define ACTIVE(p) ((p)->active)
1498 #define ADDR(p) ((p)->addr)
1499 #define ANNOTATION(p) ((p)->annotation)
1500 #define ANONYMOUS(p) ((p)->anonymous)
1501 #define APPLICATIONS(p) ((p)->applications)
1502 #define AP_INCREMENT(p) ((p)->ap_increment)
1503 #define ARGSIZE(p) ((p)->argsize)
1504 #define ARRAY(p) ((p)->array)
1505 #define ATTRIBUTE(p) ((p)->attribute)
1506 #define B(p) ((p)->b)
1507 #define BEGIN(p) ((p)->begin)
1508 #define BIN(p) ((p)->bin)
1509 #define BITS_PER_SAMPLE(p) ((p)->bits_per_sample)
1510 #define BLUE(p) ((p)->blue)
1511 #define BODY(p) ((p)->body)
1512 #define BSTATE(p) ((p)->bstate)
1513 #define BYTES(p) ((p)->bytes)
1514 #define CAST(p) ((p)->cast)
1515 #define CAT(p) ((p)->cat)
1516 #define CHANNEL(p) ((p)->channel)
1517 #define CHAR_IN_LINE(p) ((p)->char_in_line)
1518 #define CHAR_MOOD(p) ((p)->char_mood)
1519 #define CMD(p) ((p)->cmd)
1520 #define CMD_ROW(p) ((p)->cmd_row)
1521 #define CODE(p) ((p)->code)
1522 #define CODEX(p) ((p)->codex)
1523 #define COLLECT(p) ((p)->collect)
1524 #define COMPILED(p) ((p)->compiled)
1525 #define COMPILE_NAME(p) ((p)->compile_name)
1526 #define COMPILE_NODE(p) ((p)->compile_node)
1527 #define COMPRESS(p) ((p)->compress)
1528 #define CONNECTION(p) ((p)->connection)
1529 #define CONSTANT(p) ((p)->constant)
1530 #define COUNT(p) ((p)->count)
1531 #define CROSS_REFERENCE_SAFE(p) ((p)->cross_reference_safe)
1532 #define CUR_PTR(p) ((p)->cur_ptr)
1533 #define DATA(p) ((p)->data)
1534 #define DATA_SIZE(p) ((p)->data_size)
1535 #define DATE(p) ((p)->date)
1536 #define DEF(p) ((p)->def)
1537 #define DEFLEXED(p) ((p)->deflexed_mode)
1538 #define DERIVATE(p) ((p)->derivate)
1539 #define DEVICE(p) ((p)->device)
1540 #define DEVICE_HANDLE(p) ((p)->device_handle)
1541 #define DEVICE_MADE(p) ((p)->device_made)
1542 #define DEVICE_OPENED(p) ((p)->device_opened)
1543 #define DIAGNOSTICS(p) ((p)->diagnostics)
1544 #define DIGITS(p) ((p)->digits)
1545 #define DIGITSC(p) ((p)->digitsc)
1546 #define DIM(p) ((p)->dim)
1547 #define DISPLAY(p) ((p)->display)
1548 #define DRAW(p) ((p)->draw)
1549 #define DRAW_MOOD(p) ((p)->draw_mood)
1550 #define DUMP(p) ((p)->dump)
1551 #define DYNAMIC_LINK(p) ((p)->dynamic_link)
1552 #define DYNAMIC_SCOPE(p) ((p)->dynamic_scope)
1553 #define D_NAME(p) ((p)->d_name)
1554 #define ELEM_SIZE(p) ((p)->elem_size)
1555 #define END(p) ((p)->end)
1556 #define END_OF_FILE(p) ((p)->end_of_file)
1557 #define ENVIRON(p) ((p)->environ)
1558 #define EQUIVALENT(p) ((p)->equivalent_mode)
1559 #define EQUIVALENT_MODE(p) ((p)->equivalent_mode)
1560 #define ERROR_COUNT(p) ((p)->error_count)
1561 #define RENDEZ_VOUS(p) ((p)->rendez_vous)
1562 #define EXPR(p) ((p)->expr)
1563 #define F(p) ((p)->f)
1564 #define FACTOR(p) ((p)->factor)
1565 #define FD(p) ((p)->fd)
1566 #define FIELD_OFFSET(p) ((p)->field_offset)
1567 #define FILENAME(p) ((p)->filename)
1568 #define FILES(p) ((p)->files)
1569 #define FILE_BINARY_NAME(p) (FILES (p).binary.name)
1570 #define FILE_BINARY_OPENED(p) (FILES (p).binary.opened)
1571 #define FILE_BINARY_WRITEMOOD(p) (FILES (p).binary.writemood)
1572 #define FILE_DIAGS_FD(p) (FILES (p).diags.fd)
1573 #define FILE_DIAGS_NAME(p) (FILES (p).diags.name)
1574 #define FILE_DIAGS_OPENED(p) (FILES (p).diags.opened)
1575 #define FILE_DIAGS_WRITEMOOD(p) (FILES (p).diags.writemood)
1576 #define FILE_END_MENDED(p) ((p)->file_end_mended)
1577 #define FILE_ENTRY(p) ((p)->file_entry)
1578 #define FILE_GENERIC_NAME(p) (FILES (p).generic_name)
1579 #define FILE_INITIAL_NAME(p) (FILES (p).initial_name)
1580 #define FILE_LIBRARY_NAME(p) (FILES (p).library.name)
1581 #define FILE_LIBRARY_OPENED(p) (FILES (p).library.opened)
1582 #define FILE_LIBRARY_WRITEMOOD(p) (FILES (p).library.writemood)
1583 #define FILE_LISTING_FD(p) (FILES (p).listing.fd)
1584 #define FILE_LISTING_NAME(p) (FILES (p).listing.name)
1585 #define FILE_LISTING_OPENED(p) (FILES (p).listing.opened)
1586 #define FILE_LISTING_WRITEMOOD(p) (FILES (p).listing.writemood)
1587 #define FILE_OBJECT_FD(p) (FILES (p).object.fd)
1588 #define FILE_OBJECT_NAME(p) (FILES (p).object.name)
1589 #define FILE_OBJECT_OPENED(p) (FILES (p).object.opened)
1590 #define FILE_OBJECT_WRITEMOOD(p) (FILES (p).object.writemood)
1591 #define FILE_PATH(p) (FILES (p).path)
1592 #define FILE_PRETTY_FD(p) (FILES (p).pretty.fd)
1593 #define FILE_PRETTY_NAME(p) (FILES (p).pretty.name)
1594 #define FILE_PRETTY_OPENED(p) (FILES (p).pretty.opened)
1595 #define FILE_PRETTY_WRITEMOOD(p) (FILES (p).pretty.writemood)
1596 #define FILE_SCRIPT_NAME(p) (FILES (p).script.name)
1597 #define FILE_SCRIPT_OPENED(p) (FILES (p).script.opened)
1598 #define FILE_SCRIPT_WRITEMOOD(p) (FILES (p).script.writemood)
1599 #define FILE_SOURCE_FD(p) (FILES (p).source.fd)
1600 #define FILE_SOURCE_NAME(p) (FILES (p).source.name)
1601 #define FILE_SOURCE_OPENED(p) (FILES (p).source.opened)
1602 #define FILE_SOURCE_WRITEMOOD(p) (FILES (p).source.writemood)
1603 #define FIND(p) ((p)->find)
1604 #define FORMAT(p) ((p)->format)
1605 #define FORMAT_END_MENDED(p) ((p)->format_end_mended)
1606 #define FORMAT_ERROR_MENDED(p) ((p)->format_error_mended)
1607 #define FRAME(p) ((p)->frame)
1608 #define FRAME_LEVEL(p) ((p)->frame_level)
1609 #define FRAME_NO(p) ((p)->frame_no)
1610 #define FRAME_POINTER(p) ((p)->frame_pointer)
1611 #define FUNCTION(p) ((p)->function)
1612 #define G(p) ((p)->g)
1613 #define GINFO(p) ((p)->genie)
1614 #define GET(p) ((p)->get)
1615 #define GLOBAL_PROP(p) ((p)->global_prop)
1616 #define GPARENT(p) (PARENT (GINFO (p)))
1617 #define GREEN(p) ((p)->green)
1618 #define H(p) ((p)->h)
1619 #define HANDLE(p) ((p)->handle)
1620 #define HAS_ROWS(p) ((p)->has_rows)
1621 #define HEAP(p) ((p)->heap)
1622 #define HEAP_POINTER(p) ((p)->heap_pointer)
1623 #define H_ADDR(p) ((p)->h_addr)
1624 #define H_LENGTH(p) ((p)->h_length)
1625 #define ID(p) ((p)->id)
1626 #define IDENTIFICATION(p) ((p)->identification)
1627 #define IDENTIFIERS(p) ((p)->identifiers)
1628 #define IDF(p) ((p)->idf)
1629 #define IM(z) (VALUE (&(z)[1]))
1630 #define IN(p) ((p)->in)
1631 #define INDEX(p) ((p)->index)
1632 #define INDICANTS(p) ((p)->indicants)
1633 #define INFO(p) ((p)->info)
1634 #define INITIALISE_ANON(p) ((p)->initialise_anon)
1635 #define INITIALISE_FRAME(p) ((p)->initialise_frame)
1636 #define INI_PTR(p) ((p)->ini_ptr)
1637 #define INS_MODE(p) ((p)->ins_mode)
1638 #define IN_CMD(p) ((p)->in_cmd)
1639 #define IN_FORBIDDEN(p) ((p)->in_forbidden)
1640 #define IN_PREFIX(p) ((p)->in_prefix)
1641 #define IN_PROC(p) ((p)->in_proc)
1642 #define IN_TEXT(p) ((p)->in_text)
1643 #define IS_COMPILED(p) ((p)->is_compiled)
1644 #define IS_OPEN(p) ((p)->is_open)
1645 #define IS_TMP(p) ((p)->is_tmp)
1646 #define JUMP_STAT(p) ((p)->jump_stat)
1647 #define JUMP_TO(p) ((p)->jump_to)
1648 #define K(q) ((q)->k)
1649 #define LABELS(p) ((p)->labels)
1650 #define LAST(p) ((p)->last)
1651 #define LAST_LINE(p) ((p)->last_line)
1652 #define LESS(p) ((p)->less)
1653 #define LEVEL(p) ((p)->level)
1654 #define LEX_LEVEL(p) (LEVEL (TABLE (p)))
1655 #define LINBUF(p) ((p)->linbuf)
1656 #define LINE(p) ((p)->line)
1657 #define LINE_APPLIED(p) ((p)->line_applied)
1658 #define LINE_DEFINED(p) ((p)->line_defined)
1659 #define LINE_END_MENDED(p) ((p)->line_end_mended)
1660 #define LINE_NUMBER(p) (NUMBER (LINE (INFO (p))))
1661 #define LINSIZ(p) ((p)->linsiz)
1662 #define LIST(p) ((p)->list)
1663 #define LOCALE(p) ((p)->locale)
1664 #define LOC_ASSIGNED(p) ((p)->loc_assigned)
1665 #define LOWER_BOUND(p) ((p)->lower_bound)
1666 #define LWB(p) ((p)->lower_bound)
1667 #define MARKER(p) ((p)->marker)
1668 #define MATCH(p) ((p)->match)
1669 #define MODE(p) (a68_modes.p)
1670 #define MODIFIED(p) ((p)->modified)
1671 #define MOID(p) ((p)->type)
1672 #define MORE(p) ((p)->more)
1673 #define MSGS(p) ((p)->msgs)
1674 #define MULTIPLE(p) ((p)->multiple_mode)
1675 #define MULTIPLE_MODE(p) ((p)->multiple_mode)
1676 #define M_EO(p) ((p)->m_eo)
1677 #define M_MATCH(p) ((p)->match)
1678 #define M_SO(p) ((p)->m_so)
1679 #define NAME(p) ((p)->name)
1680 #define NEED_DNS(p) ((p)->need_dns)
1681 #define NEGATE(p) ((p)->negate)
1682 #define NEST(p) ((p)->nest)
1683 #define NEW_FILE(p) ((p)->new_file)
1684 #define NEXT(p) ((p)->next)
1685 #define NEXT_NEXT(p) (NEXT (NEXT (p)))
1686 #define NEXT_NEXT_NEXT(p) (NEXT (NEXT_NEXT (p)))
1687 #define NEXT_SUB(p) (NEXT (SUB (p)))
1688 #define NF(p) ((p)->nf)
1689 #define NODE(p) ((p)->node)
1690 #define NODE_DEFINED(p) ((p)->node_defined)
1691 #define NODE_PACK(p) ((p)->pack)
1692 #define NON_LOCAL(p) ((p)->non_local)
1693 #define NCHAR_IN_LINE(p) (CHAR_IN_LINE (INFO (p)))
1694 #define NPRAGMENT(p) (PRAGMENT (INFO (p)))
1695 #define NPRAGMENT_TYPE(p) (PRAGMENT_TYPE (INFO (p)))
1696 #define NSYMBOL(p) (SYMBOL (INFO (p)))
1697 #define NUM(p) ((p)->num)
1698 #define NUMBER(p) ((p)->number)
1699 #define NUM_CHANNELS(p) ((p)->num_channels)
1700 #define NUM_MATCH(p) ((p)->num_match)
1701 #define NUM_SAMPLES(p) ((p)->num_samples)
1702 #define OFFSET(p) ((p)->offset)
1703 #define OPENED(p) ((p)->opened)
1704 #define OPEN_ERROR_MENDED(p) ((p)->open_error_mended)
1705 #define OPEN_EXCLUSIVE(p) ((p)->open_exclusive)
1706 #define OPER(p) ((p)->oper)
1707 #define OPERATORS(p) ((p)->operators)
1708 #define OPTIONS(p) ((p)->options)
1709 #define OPTION_BACKTRACE(p) (OPTIONS (p).backtrace)
1710 #define OPTION_BRACKETS(p) (OPTIONS (p).brackets)
1711 #define OPTION_CHECK_ONLY(p) (OPTIONS (p).check_only)
1712 #define OPTION_CLOCK(p) (OPTIONS (p).clock)
1713 #define OPTION_COMPILE(p) (OPTIONS (p).compile)
1714 #define OPTION_CROSS_REFERENCE(p) (OPTIONS (p).cross_reference)
1715 #define OPTION_DEBUG(p) (OPTIONS (p).debug)
1716 #define OPTION_FOLD(p) (OPTIONS (p).fold)
1717 #define OPTION_INDENT(p) (OPTIONS (p).indent)
1718 #define OPTION_KEEP(p) (OPTIONS (p).keep)
1719 #define OPTION_LIST(p) (OPTIONS (p).list)
1720 #define OPTION_LOCAL(p) (OPTIONS (p).local)
1721 #define OPTION_MOID_LISTING(p) (OPTIONS (p).moid_listing)
1722 #define OPTION_NODEMASK(p) (OPTIONS (p).nodemask)
1723 #define OPTION_NO_WARNINGS(p) (OPTIONS (p).no_warnings)
1724 #define OPTION_OBJECT_LISTING(p) (OPTIONS (p).object_listing)
1725 #define OPTION_OPTIMISE(p) (OPTIONS (p).optimise)
1726 #define OPTION_OPT_LEVEL(p) (OPTIONS (p).opt_level)
1727 #define OPTION_PORTCHECK(p) (OPTIONS (p).portcheck)
1728 #define OPTION_PRAGMAT_SEMA(p) (OPTIONS (p).pragmat_sema)
1729 #define OPTION_PRETTY(p) (OPTIONS (p).pretty)
1730 #define OPTION_QUIET(p) (OPTIONS (p).quiet)
1731 #define OPTION_REDUCTIONS(p) (OPTIONS (p).reductions)
1732 #define OPTION_REGRESSION_TEST(p) (OPTIONS (p).regression_test)
1733 #define OPTION_RERUN(p) (OPTIONS (p).rerun)
1734 #define OPTION_RUN(p) (OPTIONS (p).run)
1735 #define OPTION_RUN_SCRIPT(p) (OPTIONS (p).run_script)
1736 #define OPTION_SOURCE_LISTING(p) (OPTIONS (p).source_listing)
1737 #define OPTION_STANDARD_PRELUDE_LISTING(p) (OPTIONS (p).standard_prelude_listing)
1738 #define OPTION_STATISTICS_LISTING(p) (OPTIONS (p).statistics_listing)
1739 #define OPTION_STRICT(p) (OPTIONS (p).strict)
1740 #define OPTION_STROPPING(p) (OPTIONS (p).stropping)
1741 #define OPTION_TIME_LIMIT(p) (OPTIONS (p).time_limit)
1742 #define OPTION_TRACE(p) (OPTIONS (p).trace)
1743 #define OPTION_TREE_LISTING(p) (OPTIONS (p).tree_listing)
1744 #define OPTION_UNUSED(p) (OPTIONS (p).unused)
1745 #define OPTION_VERBOSE(p) (OPTIONS (p).verbose)
1746 #define OPTION_VERSION(p) (OPTIONS (p).version)
1747 #define OUT(p) ((p)->out)
1748 #define OUTER(p) ((p)->outer)
1749 #define P(q) ((q)->p)
1750 #define PACK(p) ((p)->pack)
1751 #define PAGE_END_MENDED(p) ((p)->page_end_mended)
1752 #define A68_PAGE_SIZE(p) ((p)->page_size)
1753 #define PARAMETERS(p) ((p)->parameters)
1754 #define PARAMETER_LEVEL(p) ((p)->parameter_level)
1755 #define GSL_PARAMS(p) ((p)->params)
1756 #define PARENT(p) ((p)->parent)
1757 #define PARTIAL_LOCALE(p) ((p)->partial_locale)
1758 #define PARTIAL_PROC(p) ((p)->partial_proc)
1759 #define PATTERN(p) ((p)->pattern)
1760 #define PERM(p) ((p)->perm)
1761 #define PERMS(p) ((p)->perms)
1762 #define IDF_ROW(p) ((p)->idf_row)
1763 #define PHASE(p) ((p)->phase)
1764 #define PLOTTER(p) ((p)->plotter)
1765 #define PLOTTER_PARAMS(p) ((p)->plotter_params)
1766 #define POINTER(p) ((p)->pointer)
1767 #define PORTABLE(p) ((p)->portable)
1768 #define POS(p) ((p)->pos)
1769 #define PRAGMENT(p) ((p)->pragment)
1770 #define PRAGMENT_TYPE(p) ((p)->pragment_type)
1771 #define PRECMD(p) ((p)->precmd)
1772 #define PREVIOUS(p) ((p)->previous)
1773 #define PRINT_STATUS(p) ((p)->print_status)
1774 #define PRIO(p) ((p)->priority)
1775 #define PROCEDURE(p) ((p)->procedure)
1776 #define PROCEDURE_LEVEL(p) ((p)->procedure_level)
1777 #define PROCESSED(p) ((p)->processed)
1778 #define PROC_FRAME(p) ((p)->proc_frame)
1779 #define PROC_OPS(p) ((p)->proc_ops)
1780 #define GPROP(p) (GINFO (p)->propagator)
1781 #define PROP(p) ((p)->propagator)
1782 #define PS(p) ((p)->ps)
1783 #define PUT(p) ((p)->put)
1784 #define P_PROTO(p) ((p)->p_proto)
1785 #define R(p) ((p)->r)
1786 #define RE(z) (VALUE (&(z)[0]))
1787 #define READ_MOOD(p) ((p)->read_mood)
1788 #define RED(p) ((p)->red)
1789 #define REPL(p) ((p)->repl)
1790 #define RESERVED(p) ((p)->reserved)
1791 #define RESET(p) ((p)->reset)
1792 #define RESET_ERRNO {errno = 0;}
1793 #define RESULT(p) ((p)->result)
1794 #define RE_NSUB(p) ((p)->re_nsub)
1795 #define RLIM_CUR(p) ((p)->rlim_cur)
1796 #define RLIM_MAX(p) ((p)->rlim_max)
1797 #define RM_EO(p) ((p)->rm_eo)
1798 #define RM_SO(p) ((p)->rm_so)
1799 #define ROWED(p) ((p)->rowed)
1800 #define S(p) ((p)->s)
1801 #define SAMPLE_RATE(p) ((p)->sample_rate)
1802 #define SCAN_STATE_C(p) ((p)->scan_state.save_c)
1803 #define SCAN_STATE_L(p) ((p)->scan_state.save_l)
1804 #define SCAN_STATE_S(p) ((p)->scan_state.save_s)
1805 #define SCALE_ROW(p) ((p)->scale_row)
1806 #define SCAN(p) ((p)->scan)
1807 #define SCAN_ERROR(c, u, v, txt) if (c) {scan_error (u, v, txt);}
1808 #define SCOPE(p) ((p)->scope)
1809 #define SCOPE_ASSIGNED(p) ((p)->scope_assigned)
1810 #define SEARCH(p) ((p)->search)
1811 #define SELECT(p) ((p)->select)
1812 #define SEQUENCE(p) ((p)->sequence)
1813 #define SET(p) ((p)->set)
1814 #define SHIFT(p) ((p)->shift)
1815 #define SHORT_ID(p) ((p)->short_id)
1816 #define SIN_ADDR(p) ((p)->sin_addr)
1817 #define SIN_FAMILY(p) ((p)->sin_family)
1818 #define SIN_PORT(p) ((p)->sin_port)
1819 #define SIZE(p) ((p)->size)
1820 #define SIZE1(p) ((p)->size1)
1821 #define SIZE2(p) ((p)->size2)
1822 #define SIZEC(p) ((p)->sizec)
1823 #define SLICE(p) ((p)->slice)
1824 #define SLICE_OFFSET(p) ((p)->slice_offset)
1825 #define SO(p) ((p)->so)
1826 #define SORT(p) ((p)->sort)
1827 #define SOURCE(p) ((p)->source)
1828 #define SOURCE_SCAN(p) ((p)->source_scan)
1829 #define SPAN(p) ((p)->span)
1830 #define STACK(p) ((p)->stack)
1831 #define STACK_POINTER(p) ((p)->stack_pointer)
1832 #define STACK_USED(p) ((p)->stack_used)
1833 #define STANDENV_MOID(p) ((p)->standenv_moid)
1834 #define START(p) ((p)->start)
1835 #define STATIC_LINK(p) ((p)->static_link)
1836 #define STATUS(p) ((p)->status)
1837 #define STATUS_IM(z) (STATUS (&(z)[1]))
1838 #define STATUS_RE(z) (STATUS (&(z)[0]))
1839 #define STR(p) ((p)->str)
1840 #define STREAM(p) ((p)->stream)
1841 #define STRING(p) ((p)->string)
1842 #define STRPOS(p) ((p)->strpos)
1843 #define ST_MODE(p) ((p)->st_mode)
1844 #define ST_MTIME(p) ((p)->st_mtime)
1845 #define SUB(p) ((p)->sub)
1846 #define SUBSET(p) ((p)->subset)
1847 #define SUB_MOID(p) (SUB (MOID (p)))
1848 #define SUB_NEXT(p) (SUB (NEXT (p)))
1849 #define SUB_SUB(p) (SUB (SUB (p)))
1850 #define SWAP(p) ((p)->swap)
1851 #define SYMBOL(p) ((p)->symbol)
1852 #define SYNC(p) ((p)->sync)
1853 #define SYNC_INDEX(p) ((p)->sync_index)
1854 #define SYNC_LINE(p) ((p)->sync_line)
1855 #define S_PORT(p) ((p)->s_port)
1856 #define TABLE(p) ((p)->symbol_table)
1857 #define TABS(p) ((p)->tabs)
1858 #define TAG_LEX_LEVEL(p) (LEVEL (TAG_TABLE (p)))
1859 #define TAG_TABLE(p) ((p)->symbol_table)
1860 #define TAX(p) ((p)->tag)
1861 #define TERM(p) ((p)->term)
1862 #define TERMINATOR(p) ((p)->terminator)
1863 #define TEXT(p) ((p)->text)
1864 #define THREAD_ID(p) ((p)->thread_id)
1865 #define THREAD_STACK_OFFSET(p) ((p)->thread_stack_offset)
1866 #define TMP_FILE(p) ((p)->tmp_file)
1867 #define TMP_TEXT(p) ((p)->tmp_text)
1868 #define TM_HOUR(p) ((p)->tm_hour)
1869 #define TM_ISDST(p) ((p)->tm_isdst)
1870 #define TM_MDAY(p) ((p)->tm_mday)
1871 #define TM_MIN(p) ((p)->tm_min)
1872 #define TM_MON(p) ((p)->tm_mon)
1873 #define TM_SEC(p) ((p)->tm_sec)
1874 #define TM_WDAY(p) ((p)->tm_wday)
1875 #define TM_YEAR(p) ((p)->tm_year)
1876 #define TOF(p) ((p)->tof)
1877 #define TOP_LINE(p) ((p)->top_line)
1878 #define TOP_MOID(p) ((p)->top_moid)
1879 #define TOP_NODE(p) ((p)->top_node)
1880 #define TOP_REFINEMENT(p) ((p)->top_refinement)
1881 #define TRANS(p) ((p)->trans)
1882 #define TRANSIENT(p) ((p)->transient)
1883 #define TRANSPUT_BUFFER(p) ((p)->transput_buffer)
1884 #define TRANSPUT_ERROR_MENDED(p) ((p)->transput_error_mended)
1885 #define TREE_LISTING_SAFE(p) ((p)->tree_listing_safe)
1886 #define TRIM(p) ((p)->trim)
1887 #define TUPLE(p) ((p)->tuple)
1888 #define TV_SEC(p) ((p)->tv_sec)
1889 #define TV_USEC(p) ((p)->tv_usec)
1890 #define UNDO(p) ((p)->undo)
1891 #define UNDO_LINE(p) ((p)->undo_line)
1892 #define UNION_OFFSET (SIZE_AL (A68_UNION))
1893 #define UNIT(p) ((p)->unit)
1894 #define UPB(p) ((p)->upper_bound)
1895 #define UPPER_BOUND(p) ((p)->upper_bound)
1896 #define USE(p) ((p)->use)
1897 #define VAL(p) ((p)->val)
1898 #define VALUE(p) ((p)->value)
1899 #define VALUE_ERROR_MENDED(p) ((p)->value_error_mended)
1900 #define WARNING_COUNT(p) ((p)->warning_count)
1901 #define WHERE(p) ((p)->where)
1902 #define IS(p, s) (ATTRIBUTE (p) == (s))
1903 #define IS_COERCION(p) ((p)->is_coercion)
1904 #define IS_LITERALLY(p, s) (strcmp (NSYMBOL (p), s) == 0)
1905 #define IS_NEW_LEXICAL_LEVEL(p) ((p)->is_new_lexical_level)
1906 #define ISNT(p, s) (! IS (p, s))
1907 #define IS_REF_FLEX(m)\
1908   (IS (m, REF_SYMBOL) && IS (SUB (m), FLEX_SYMBOL))
1909 #define WINDOW_X_SIZE(p) ((p)->window_x_size)
1910 #define WINDOW_Y_SIZE(p) ((p)->window_y_size)
1911 #define WRITE_MOOD(p) ((p)->write_mood)
1912 #define X(p) ((p)->x)
1913 #define X_COORD(p) ((p)->x_coord)
1914 #define Y(p) ((p)->y)
1915 #define YOUNGEST_ENVIRON(p) ((p)->youngest_environ)
1916 #define Y_COORD(p) ((p)->y_coord)
1917 
1918 /***********************************/
1919 /* Interpreter related definitions */
1920 /***********************************/
1921 
1922 /* Prelude errors can also occur in the constant folder */
1923 
1924 #define PRELUDE_ERROR(cond, p, txt, add)\
1925   if (cond) {\
1926     errno = ERANGE;\
1927     if (in_execution) {\
1928       diagnostic_node (A68_RUNTIME_ERROR, p, txt, add);\
1929       exit_genie (p, A68_RUNTIME_ERROR);\
1930     } else {\
1931       diagnostic_node (A68_MATH_ERROR, p, txt, add);\
1932     }}
1933 
1934 /* Check on a NIL name */
1935 
1936 #define CHECK_REF(p, z, m)\
1937   if (! INITIALISED (&z)) {\
1938     diagnostic_node (A68_RUNTIME_ERROR, (p), ERROR_EMPTY_VALUE_FROM, (m));\
1939     exit_genie ((p), A68_RUNTIME_ERROR);\
1940   } else if (IS_NIL (z)) {\
1941     diagnostic_node (A68_RUNTIME_ERROR, (p), ERROR_ACCESSING_NIL, (m));\
1942     exit_genie ((p), A68_RUNTIME_ERROR);\
1943   }
1944 
1945 /***************************/
1946 /* Macros for row-handling */
1947 /***************************/
1948 
1949 #define GET_DESCRIPTOR(a, t, p)\
1950   a = (A68_ARRAY *) ARRAY_ADDRESS (p);\
1951   t = (A68_TUPLE *) & (((BYTE_T *) (a)) [SIZE_AL (A68_ARRAY)]);
1952 
1953 #define GET_DESCRIPTOR2(a, t1, t2, p)\
1954   a = (A68_ARRAY *) ARRAY_ADDRESS (p);\
1955   t1 = (A68_TUPLE *) & (((BYTE_T *) (a)) [SIZE_AL (A68_ARRAY)]);\
1956   t2 = (A68_TUPLE *) & (((BYTE_T *) (a)) [SIZE_AL (A68_ARRAY) + sizeof (A68_TUPLE)]);
1957 
1958 #define PUT_DESCRIPTOR(a, t1, p) {\
1959   BYTE_T *a_p = ARRAY_ADDRESS (p);\
1960   *(A68_ARRAY *) a_p = (a);\
1961   *(A68_TUPLE *) &(((BYTE_T *) (a_p)) [SIZE_AL (A68_ARRAY)]) = (t1);\
1962   }
1963 
1964 #define PUT_DESCRIPTOR2(a, t1, t2, p) {\
1965   BYTE_T *a_p = ARRAY_ADDRESS (p);\
1966   *(A68_ARRAY *) a_p = (a);\
1967   *(A68_TUPLE *) &(((BYTE_T *) (a_p)) [SIZE_AL (A68_ARRAY)]) = (t1);\
1968   *(A68_TUPLE *) &(((BYTE_T *) (a_p)) [SIZE_AL (A68_ARRAY) + sizeof (A68_TUPLE)]) = (t2);\
1969   }
1970 
1971 #define ROW_SIZE(t) ((UPB (t) >= LWB (t)) ? (UPB (t) - LWB (t) + 1) : 0)
1972 #define ROW_ELEMENT(a, k) (((ADDR_T) k + SLICE_OFFSET (a)) * ELEM_SIZE (a) + FIELD_OFFSET (a))
1973 #define INDEX_1_DIM(a, t, k) ROW_ELEMENT (a, (SPAN (t) * (int) (k) - SHIFT (t)))
1974 
1975 /*************/
1976 /* Execution */
1977 /*************/
1978 
1979 #define EXECUTE_UNIT_2(p, dest) {\
1980   PROP_T *_prop_ = &GPROP (p);\
1981   last_unit = p;\
1982   dest = (*(UNIT (_prop_))) (SOURCE (_prop_));}
1983 
1984 #define EXECUTE_UNIT(p) {\
1985   PROP_T *_prop_ = &GPROP (p);\
1986   last_unit = p;\
1987   (void) (*(UNIT (_prop_))) (SOURCE (_prop_));}
1988 
1989 #define EXECUTE_UNIT_TRACE(p) {\
1990   if (STATUS_TEST (p, (BREAKPOINT_MASK | BREAKPOINT_TEMPORARY_MASK | \
1991       BREAKPOINT_INTERRUPT_MASK | BREAKPOINT_WATCH_MASK | BREAKPOINT_TRACE_MASK))) {\
1992     single_step ((p), STATUS (p));\
1993   }\
1994   EXECUTE_UNIT (p);}
1995 
1996 /***********************************/
1997 /* Stuff for the garbage collector */
1998 /***********************************/
1999 
2000 /* Check whether the heap fills */
2001 
2002 #define PREEMPTIVE_GC {\
2003   double f = (double) heap_pointer / (double) heap_size;\
2004   double h = (double) free_handle_count / (double) max_handle_count;\
2005   if ((f > 0.8 || h < 0.2) && stack_pointer == stack_start) {\
2006     gc_heap ((NODE_T *) p, frame_pointer);\
2007   }}
2008 
2009 /* Save a handle from the GC */
2010 
2011 #define BLOCK_GC_HANDLE(z) {\
2012   if (IS_IN_HEAP (z)) {\
2013     STATUS_SET (REF_HANDLE(z), BLOCK_GC_MASK);\
2014   }}
2015 
2016 #define UNBLOCK_GC_HANDLE(z) {\
2017   if (IS_IN_HEAP (z)) {\
2018     STATUS_CLEAR (REF_HANDLE (z), BLOCK_GC_MASK);\
2019   }}
2020 
2021 /* Tests for objects of mode INT */
2022 
2023 #define CHECK_INT_ADDITION(p, i, j)\
2024   PRELUDE_ERROR (\
2025     ((j) > 0 && (i) > (INT_MAX - (j))) || ((j) < 0 && (i) < (-INT_MAX - (j))),\
2026     p, ERROR_MATH, MODE (INT))
2027 #define CHECK_INT_SUBTRACTION(p, i, j)\
2028   CHECK_INT_ADDITION(p, i, -(j))
2029 #define CHECK_INT_MULTIPLICATION(p, i, j)\
2030   PRELUDE_ERROR (\
2031     (j) != 0 && ABS (i) > INT_MAX / ABS (j),\
2032     p, ERROR_MATH, MODE (INT))
2033 #define CHECK_INT_DIVISION(p, i, j)\
2034   PRELUDE_ERROR ((j) == 0, p, ERROR_DIVISION_BY_ZERO, MODE (INT))
2035 
2036 #define CHECK_INDEX(p, k, t) {\
2037   if (VALUE (k) < LWB (t) || VALUE (k) > UPB (t)) {\
2038     diagnostic_node (A68_RUNTIME_ERROR, p, ERROR_INDEX_OUT_OF_BOUNDS);\
2039     exit_genie (p, A68_RUNTIME_ERROR);\
2040   }}
2041 
2042 /* Tests for objects of mode REAL */
2043 
2044 #if defined HAVE_IEEE_754
2045 
2046 #define NOT_A_REAL(x) (!finite (x))
2047 #define CHECK_REAL_REPRESENTATION(p, u) PRELUDE_ERROR (NOT_A_REAL (u), p, ERROR_MATH, MODE (REAL))
2048 #define CHECK_REAL_ADDITION(p, u, v) CHECK_REAL_REPRESENTATION (p, (u) + (v))
2049 #define CHECK_REAL_SUBTRACTION(p, u, v) CHECK_REAL_REPRESENTATION (p, (u) - (v))
2050 #define CHECK_REAL_MULTIPLICATION(p, u, v) CHECK_REAL_REPRESENTATION (p, (u) * (v))
2051 #define CHECK_REAL_DIVISION(p, u, v)\
2052   PRELUDE_ERROR ((v) == 0, p, ERROR_DIVISION_BY_ZERO, MODE (REAL))
2053 #define CHECK_COMPLEX_REPRESENTATION(p, u, v)\
2054   PRELUDE_ERROR (NOT_A_REAL (u) || NOT_A_REAL (v), p, ERROR_MATH, MODE (COMPLEX))
2055 #else
2056 #define CHECK_REAL_REPRESENTATION(p, u) {;}
2057 #define CHECK_REAL_ADDITION(p, u, v) {;}
2058 #define CHECK_REAL_SUBTRACTION(p, u, v) {;}
2059 #define CHECK_REAL_MULTIPLICATION(p, u, v) {;}
2060 #define CHECK_REAL_DIVISION(p, u, v) {;}
2061 #define CHECK_COMPLEX_REPRESENTATION(p, u, v) {;}
2062 #endif
2063 
2064 #define MATH_RTE(p, z, m, t)\
2065    PRELUDE_ERROR (z, (p), (t == NO_TEXT ? ERROR_MATH : t), (m))
2066 
2067 /*
2068 Macro's for stack checking. Since the stacks grow by small amounts at a time
2069 (A68 rows are in the heap), we check the stacks only at certain points: where
2070 A68 recursion may set in, or in the garbage collector. We check whether there
2071 still is sufficient overhead to make it to the next check.
2072 */
2073 
2074 #define TOO_COMPLEX "program too complex"
2075 
2076 #define SYSTEM_STACK_USED (ABS ((int) (system_stack_offset - &stack_offset)))
2077 #define LOW_SYSTEM_STACK_ALERT(p) {\
2078   BYTE_T stack_offset;\
2079   if (stack_size > 0 && SYSTEM_STACK_USED >= stack_limit) {\
2080     errno = 0;\
2081     if ((p) == NO_NODE) {\
2082       ABEND (A68_TRUE, TOO_COMPLEX, ERROR_STACK_OVERFLOW);\
2083     } else {\
2084       diagnostic_node (A68_RUNTIME_ERROR, (p), ERROR_STACK_OVERFLOW);\
2085       exit_genie ((p), A68_RUNTIME_ERROR);\
2086   }}}
2087 
2088 #define LOW_STACK_ALERT(p) {\
2089   LOW_SYSTEM_STACK_ALERT (p);\
2090   if ((p) != NO_NODE && (frame_pointer >= frame_stack_limit || stack_pointer >= expr_stack_limit)) { \
2091     errno = 0;\
2092     diagnostic_node (A68_RUNTIME_ERROR, (p), ERROR_STACK_OVERFLOW);\
2093     exit_genie ((p), A68_RUNTIME_ERROR);\
2094   }}
2095 
2096 /******************************/
2097 /* Operations on stack frames */
2098 /******************************/
2099 
2100 #define FRAME_ADDRESS(n) ((BYTE_T *) &(stack_segment[n]))
2101 #define FACT(n) ((ACTIVATION_RECORD *) FRAME_ADDRESS (n))
2102 #define FRAME_CLEAR(m) FILL ((BYTE_T *) FRAME_OFFSET (FRAME_INFO_SIZE), 0, (m))
2103 #define FRAME_BLOCKS(n) (BLOCKS (FACT (n)))
2104 #define FRAME_DYNAMIC_LINK(n) (DYNAMIC_LINK (FACT (n)))
2105 #define FRAME_DNS(n) (DYNAMIC_SCOPE (FACT (n)))
2106 #define FRAME_INCREMENT(n) (AP_INCREMENT (TABLE (FRAME_TREE(n))))
2107 #define FRAME_INFO_SIZE (A68_ALIGN_8 ((int) sizeof (ACTIVATION_RECORD)))
2108 #define FRAME_JUMP_STAT(n) (JUMP_STAT (FACT (n)))
2109 #define FRAME_LEXICAL_LEVEL(n) (FRAME_LEVEL (FACT (n)))
2110 #define FRAME_LOCAL(n, m) (FRAME_ADDRESS ((n) + FRAME_INFO_SIZE + (m)))
2111 #define FRAME_NUMBER(n) (FRAME_NO (FACT (n)))
2112 #define FRAME_OBJECT(n) (FRAME_OFFSET (FRAME_INFO_SIZE + (n)))
2113 #define FRAME_OFFSET(n) (FRAME_ADDRESS (frame_pointer + (n)))
2114 #define FRAME_PARAMETER_LEVEL(n) (PARAMETER_LEVEL (FACT (n)))
2115 #define FRAME_PARAMETERS(n) (PARAMETERS (FACT (n)))
2116 #define FRAME_PROC_FRAME(n) (PROC_FRAME (FACT (n)))
2117 #define FRAME_SIZE(fp) (FRAME_INFO_SIZE + FRAME_INCREMENT (fp))
2118 #define FRAME_STATIC_LINK(n) (STATIC_LINK (FACT (n)))
2119 #define FRAME_TREE(n) (NODE (FACT (n)))
2120 
2121 #if defined HAVE_PARALLEL_CLAUSE
2122 #define FRAME_THREAD_ID(n) (THREAD_ID (FACT (n)))
2123 #endif
2124 
2125 #define FOLLOW_SL(dest, l) {\
2126   (dest) = frame_pointer;\
2127   if ((l) <= FRAME_PARAMETER_LEVEL ((dest))) {\
2128     (dest) = FRAME_PARAMETERS ((dest));\
2129   }\
2130   while ((l) != FRAME_LEXICAL_LEVEL ((dest))) {\
2131     (dest) = FRAME_STATIC_LINK ((dest));\
2132   }}
2133 
2134 #define FOLLOW_STATIC_LINK(dest, l) {\
2135   if ((l) == global_level && global_pointer > 0) {\
2136     (dest) = global_pointer;\
2137   } else {\
2138     FOLLOW_SL (dest, l)\
2139   }}
2140 
2141 #define FRAME_GET(dest, cast, p) {\
2142   ADDR_T _m_z;\
2143   FOLLOW_STATIC_LINK (_m_z, LEVEL (GINFO (p)));\
2144   (dest) = (cast *) & (OFFSET (GINFO (p))[_m_z]);\
2145   }
2146 
2147 #define GET_FRAME(dest, cast, level, offset) {\
2148   ADDR_T _m_z;\
2149   FOLLOW_SL (_m_z, (level));\
2150   (dest) = (cast *) & (stack_segment [_m_z + FRAME_INFO_SIZE + (offset)]);\
2151   }
2152 
2153 #define GET_GLOBAL(dest, cast, offset) {\
2154   (dest) = (cast *) & (stack_segment [global_pointer + FRAME_INFO_SIZE + (offset)]);\
2155   }
2156 
2157 /* Opening of stack frames is in-line */
2158 
2159 /*
2160 STATIC_LINK_FOR_FRAME: determine static link for stack frame.
2161 new_lex_lvl: lexical level of new stack frame.
2162 returns: static link for stack frame at 'new_lex_lvl'.
2163 */
2164 
2165 #define STATIC_LINK_FOR_FRAME(dest, new_lex_lvl) {\
2166   int _m_cur_lex_lvl = FRAME_LEXICAL_LEVEL (frame_pointer);\
2167   if (_m_cur_lex_lvl == (new_lex_lvl)) {\
2168     (dest) = FRAME_STATIC_LINK (frame_pointer);\
2169   } else if (_m_cur_lex_lvl > (new_lex_lvl)) {\
2170     ADDR_T _m_static_link = frame_pointer;\
2171     while (FRAME_LEXICAL_LEVEL (_m_static_link) >= (new_lex_lvl)) {\
2172       _m_static_link = FRAME_STATIC_LINK (_m_static_link);\
2173     }\
2174     (dest) = _m_static_link;\
2175   } else {\
2176     (dest) = frame_pointer;\
2177   }}
2178 
2179 #define INIT_STATIC_FRAME(p) {\
2180   FRAME_CLEAR (AP_INCREMENT (TABLE (p)));\
2181   if (INITIALISE_FRAME (TABLE (p))) {\
2182     initialise_frame (p);\
2183   }}
2184 
2185 #define INIT_GLOBAL_POINTER(p) {\
2186   if (LEX_LEVEL (p) == global_level) {\
2187     global_pointer = frame_pointer;\
2188   }}
2189 
2190 #if defined HAVE_PARALLEL_CLAUSE
2191 #define OPEN_STATIC_FRAME(p) {\
2192   ADDR_T dynamic_link = frame_pointer, static_link;\
2193   ACTIVATION_RECORD *act, *pre;\
2194   STATIC_LINK_FOR_FRAME (static_link, LEX_LEVEL (p));\
2195   pre = FACT (frame_pointer);\
2196   frame_pointer += FRAME_SIZE (dynamic_link);\
2197   act = FACT (frame_pointer);\
2198   FRAME_NO (act) = FRAME_NO (pre) + 1;\
2199   FRAME_LEVEL (act) = LEX_LEVEL (p);\
2200   PARAMETER_LEVEL (act) = PARAMETER_LEVEL (pre);\
2201   PARAMETERS (act) = PARAMETERS (pre);\
2202   STATIC_LINK (act) = static_link;\
2203   DYNAMIC_LINK (act) = dynamic_link;\
2204   DYNAMIC_SCOPE (act) = frame_pointer;\
2205   NODE (act) = p;\
2206   JUMP_STAT (act) = NO_JMP_BUF;\
2207   PROC_FRAME (act) = A68_FALSE;\
2208   THREAD_ID (act) = pthread_self ();\
2209   }
2210 #else
2211 #define OPEN_STATIC_FRAME(p) {\
2212   ADDR_T dynamic_link = frame_pointer, static_link;\
2213   ACTIVATION_RECORD *act, *pre;\
2214   STATIC_LINK_FOR_FRAME (static_link, LEX_LEVEL (p));\
2215   pre = FACT (frame_pointer);\
2216   frame_pointer += FRAME_SIZE (dynamic_link);\
2217   act = FACT (frame_pointer);\
2218   FRAME_NO (act) = FRAME_NO (pre) + 1;\
2219   FRAME_LEVEL (act) = LEX_LEVEL (p);\
2220   PARAMETER_LEVEL (act) = PARAMETER_LEVEL (pre);\
2221   PARAMETERS (act) = PARAMETERS (pre);\
2222   STATIC_LINK (act) = static_link;\
2223   DYNAMIC_LINK (act) = dynamic_link;\
2224   DYNAMIC_SCOPE (act) = frame_pointer;\
2225   NODE (act) = p;\
2226   JUMP_STAT (act) = NO_JMP_BUF;\
2227   PROC_FRAME (act) = A68_FALSE;\
2228   }
2229 #endif
2230 
2231 /**
2232 @def OPEN_PROC_FRAME
2233 @brief Open a stack frame for a procedure.
2234 **/
2235 
2236 #if defined HAVE_PARALLEL_CLAUSE
2237 #define OPEN_PROC_FRAME(p, environ) {\
2238   ADDR_T dynamic_link = frame_pointer, static_link;\
2239   ACTIVATION_RECORD *act;\
2240   LOW_STACK_ALERT (p);\
2241   static_link = (environ > 0 ? environ : frame_pointer);\
2242   if (frame_pointer < static_link) {\
2243     diagnostic_node (A68_RUNTIME_ERROR, (p), ERROR_SCOPE_DYNAMIC_0);\
2244     exit_genie (p, A68_RUNTIME_ERROR);\
2245   }\
2246   frame_pointer += FRAME_SIZE (dynamic_link);\
2247   act = FACT (frame_pointer);\
2248   FRAME_NO (act) = FRAME_NUMBER (dynamic_link) + 1;\
2249   FRAME_LEVEL (act) = LEX_LEVEL (p);\
2250   PARAMETER_LEVEL (act) = LEX_LEVEL (p);\
2251   PARAMETERS (act) = frame_pointer;\
2252   STATIC_LINK (act) = static_link;\
2253   DYNAMIC_LINK (act) = dynamic_link;\
2254   DYNAMIC_SCOPE (act) = frame_pointer;\
2255   NODE (act) = p;\
2256   JUMP_STAT (act) = NO_JMP_BUF;\
2257   PROC_FRAME (act) = A68_TRUE;\
2258   THREAD_ID (act) = pthread_self ();\
2259   }
2260 #else
2261 #define OPEN_PROC_FRAME(p, environ) {\
2262   ADDR_T dynamic_link = frame_pointer, static_link;\
2263   ACTIVATION_RECORD *act;\
2264   LOW_STACK_ALERT (p);\
2265   static_link = (environ > 0 ? environ : frame_pointer);\
2266   if (frame_pointer < static_link) {\
2267     diagnostic_node (A68_RUNTIME_ERROR, (p), ERROR_SCOPE_DYNAMIC_0);\
2268     exit_genie (p, A68_RUNTIME_ERROR);\
2269   }\
2270   frame_pointer += FRAME_SIZE (dynamic_link);\
2271   act = FACT (frame_pointer);\
2272   FRAME_NO (act) = FRAME_NUMBER (dynamic_link) + 1;\
2273   FRAME_LEVEL (act) = LEX_LEVEL (p);\
2274   PARAMETER_LEVEL (act) = LEX_LEVEL (p);\
2275   PARAMETERS (act) = frame_pointer;\
2276   STATIC_LINK (act) = static_link;\
2277   DYNAMIC_LINK (act) = dynamic_link;\
2278   DYNAMIC_SCOPE (act) = frame_pointer;\
2279   NODE (act) = p;\
2280   JUMP_STAT (act) = NO_JMP_BUF;\
2281   PROC_FRAME (act) = A68_TRUE;\
2282   }
2283 #endif
2284 
2285 #define CLOSE_FRAME {\
2286   ACTIVATION_RECORD *act = FACT (frame_pointer);\
2287   frame_pointer = DYNAMIC_LINK (act);\
2288   }
2289 
2290 /* Macros for check on initialisation of values */
2291 
2292 #define CHECK_INIT(p, c, q)\
2293   if (!(c)) {\
2294     diagnostic_node (A68_RUNTIME_ERROR, (p), ERROR_EMPTY_VALUE_FROM, (q));\
2295     exit_genie ((p), A68_RUNTIME_ERROR);\
2296   }
2297 
2298 #define CHECK_DNS2(p, scope, limit, mode)\
2299   if (scope > limit) {\
2300     char txt[BUFFER_SIZE];\
2301     ASSERT (snprintf (txt, SNPRINTF_SIZE, ERROR_SCOPE_DYNAMIC_1) >= 0);\
2302     diagnostic_node (A68_RUNTIME_ERROR, p, txt, mode);\
2303     exit_genie (p, A68_RUNTIME_ERROR);\
2304   }
2305 
2306 #define CHECK_DNS(p, m, w, limit)\
2307   if (NEED_DNS (GINFO (p))) {\
2308     ADDR_T _lim = ((limit) < global_pointer ? global_pointer : (limit));\
2309     if (IS ((m), REF_SYMBOL)) {\
2310       CHECK_DNS2 (p, (REF_SCOPE ((A68_REF *) (w))), _lim, (m));\
2311     } else if (IS ((m), PROC_SYMBOL)) {\
2312       CHECK_DNS2 (p, ENVIRON ((A68_PROCEDURE *) (w)), _lim, (m));\
2313     } else if (IS ((m), FORMAT_SYMBOL)) {\
2314       CHECK_DNS2 (p, ENVIRON ((A68_FORMAT *) w), _lim, (m));\
2315   }}
2316 
2317 /*
2318 The void * cast in next macro is to stop warnings about dropping a volatile
2319 qualifier to a pointer. This is safe here.
2320 */
2321 
2322 #define STACK_DNS(p, m, limit)\
2323   if (p != NO_NODE && GINFO (p) != NO_GINFO) {\
2324     CHECK_DNS ((NODE_T *)(void *)(p), (m),\
2325                (STACK_OFFSET (-SIZE (m))), (limit));\
2326   }
2327 
2328 /***********************************/
2329 /* Macros for the evaluation stack */
2330 /***********************************/
2331 
2332 #define INCREMENT_STACK_POINTER(err, i)\
2333   {stack_pointer += (ADDR_T) A68_ALIGN (i); (void) (err);}
2334 
2335 #define DECREMENT_STACK_POINTER(err, i)\
2336   {stack_pointer -= A68_ALIGN (i); (void) (err);}
2337 
2338 #define PUSH(p, addr, size) {\
2339   BYTE_T *_sp_ = STACK_TOP;\
2340   INCREMENT_STACK_POINTER ((p), (int) (size));\
2341   COPY (_sp_, (BYTE_T *) (addr), (int) (size));\
2342   }
2343 
2344 #define POP(p, addr, size) {\
2345   DECREMENT_STACK_POINTER((p), (int) (size));\
2346   COPY ((BYTE_T *) (addr), STACK_TOP, (int) (size));\
2347   }
2348 
2349 #define POP_ALIGNED(p, addr, size) {\
2350   DECREMENT_STACK_POINTER((p), (int) (size));\
2351   COPY_ALIGNED ((BYTE_T *) (addr), STACK_TOP, (int) (size));\
2352   }
2353 
2354 #define POP_ADDRESS(p, addr, type) {\
2355   DECREMENT_STACK_POINTER((p), (int) SIZE_AL (type));\
2356   (addr) = (type *) STACK_TOP;\
2357   }
2358 
2359 #define POP_OPERAND_ADDRESS(p, i, type) {\
2360   (void) (p);\
2361   (i) = (type *) (STACK_OFFSET (-SIZE_AL (type)));\
2362   }
2363 
2364 #define POP_OPERAND_ADDRESSES(p, i, j, type) {\
2365   DECREMENT_STACK_POINTER ((p), (int) SIZE_AL (type));\
2366   (j) = (type *) STACK_TOP;\
2367   (i) = (type *) (STACK_OFFSET (-SIZE_AL (type)));\
2368   }
2369 
2370 #define POP_3_OPERAND_ADDRESSES(p, i, j, k, type) {\
2371   DECREMENT_STACK_POINTER ((p), (int) (2 * SIZE_AL (type)));\
2372   (k) = (type *) (STACK_OFFSET (SIZE_AL (type)));\
2373   (j) = (type *) STACK_TOP;\
2374   (i) = (type *) (STACK_OFFSET (-SIZE_AL (type)));\
2375   }
2376 
2377 #define PUSH_PRIMITIVE(p, z, mode) {\
2378   mode *_x_ = (mode *) STACK_TOP;\
2379   STATUS (_x_) = INIT_MASK;\
2380   VALUE (_x_) = (z);\
2381   INCREMENT_STACK_POINTER ((p), SIZE_AL (mode));\
2382   }
2383 
2384 #define PUSH_PRIMAL(p, z, m) {\
2385   A68_##m *_x_ = (A68_##m *) STACK_TOP;\
2386   int _size_ = SIZE_AL (A68_##m);\
2387   STATUS (_x_) = INIT_MASK;\
2388   VALUE (_x_) = (z);\
2389   INCREMENT_STACK_POINTER ((p), _size_);\
2390   }
2391 
2392 #define PUSH_OBJECT(p, z, mode) {\
2393   *(mode *) STACK_TOP = (z);\
2394   INCREMENT_STACK_POINTER (p, SIZE_AL (mode));\
2395   }
2396 
2397 #define POP_OBJECT(p, z, mode) {\
2398   DECREMENT_STACK_POINTER((p), SIZE_AL (mode));\
2399   (*(z)) = *((mode *) STACK_TOP);\
2400   }
2401 
2402 #define PUSH_COMPLEX(p, re, im) {\
2403   PUSH_PRIMAL (p, re, REAL);\
2404   PUSH_PRIMAL (p, im, REAL);\
2405   }
2406 
2407 #define POP_COMPLEX(p, re, im) {\
2408   POP_OBJECT (p, im, A68_REAL);\
2409   POP_OBJECT (p, re, A68_REAL);\
2410   }
2411 
2412 #define PUSH_BYTES(p, k) {\
2413   A68_BYTES *_z_ = (A68_BYTES *) STACK_TOP;\
2414   STATUS (_z_) = INIT_MASK;\
2415   strncpy (VALUE (_z_), k, BYTES_WIDTH);\
2416   INCREMENT_STACK_POINTER((p), SIZE_AL (A68_BYTES));\
2417   }
2418 
2419 #define PUSH_LONG_BYTES(p, k) {\
2420   A68_LONG_BYTES *_z_ = (A68_LONG_BYTES *) STACK_TOP;\
2421   STATUS (_z_) = INIT_MASK;\
2422   strncpy (VALUE (_z_), k, LONG_BYTES_WIDTH);\
2423   INCREMENT_STACK_POINTER((p), SIZE_AL (A68_LONG_BYTES));\
2424   }
2425 
2426 #define PUSH_REF(p, z) PUSH_OBJECT (p, z, A68_REF)
2427 #define PUSH_PROCEDURE(p, z) PUSH_OBJECT (p, z, A68_PROCEDURE)
2428 #define PUSH_FORMAT(p, z) PUSH_OBJECT (p, z, A68_FORMAT)
2429 
2430 #define POP_REF(p, z) POP_OBJECT (p, z, A68_REF)
2431 #define POP_PROCEDURE(p, z) POP_OBJECT (p, z, A68_PROCEDURE)
2432 
2433 #define PUSH_UNION(p, z) {\
2434   A68_UNION *_x_ = (A68_UNION *) STACK_TOP;\
2435   STATUS (_x_) = INIT_MASK;\
2436   VALUE (_x_) = (z);\
2437   INCREMENT_STACK_POINTER ((p), SIZE_AL (A68_UNION));\
2438   }
2439 
2440 
2441 /* Macro's for standard environ */
2442 
2443 #define A68_ENV_INT(n, k) void n (NODE_T *p) {PUSH_PRIMAL (p, (k), INT);}
2444 #define A68_ENV_REAL(n, z) void n (NODE_T *p) {PUSH_PRIMAL (p, (z), REAL);}
2445 
2446 /* Interpreter macros */
2447 
2448 #define INITIALISED(z) ((BOOL_T) (STATUS (z) & INIT_MASK))
2449 #define LHS_MODE(p) (MOID (PACK (MOID (p))))
2450 #define RHS_MODE(p) (MOID (NEXT (PACK (MOID (p)))))
2451 
2452 /* Transput related macros */
2453 
2454 #define IS_NIL_FORMAT(f) ((BOOL_T) (BODY (f) == NO_NODE && ENVIRON (f) == 0))
2455 
2456 /* MP Macros */
2457 
2458 #define MP_STATUS(z) ((z)[0])
2459 #define MP_EXPONENT(z) ((z)[1])
2460 #define MP_DIGIT(z, n) ((z)[(n) + 1])
2461 #define SIZE_MP(digits) ((2 + digits) * SIZE_AL (MP_T))
2462 #define IS_ZERO_MP(z) (MP_DIGIT (z, 1) == (MP_T) 0)
2463 
2464 #define MOVE_MP(z, x, digits) {\
2465   MP_T *_m_d = (z), *_m_s = (x); int _m_k = digits + 2;\
2466   while (_m_k--) {*_m_d++ = *_m_s++;}\
2467   }
2468 
2469 #define MOVE_DIGITS(z, x, digits) {\
2470   MP_T *_m_d = (z), *_m_s = (x); int _m_k = digits;\
2471   while (_m_k--) {*_m_d++ = *_m_s++;}\
2472   }
2473 
2474 #define CHECK_MP_EXPONENT(p, z) {\
2475   MP_T _expo_ = fabs (MP_EXPONENT (z));\
2476   if (_expo_ > MAX_MP_EXPONENT || (_expo_ == MAX_MP_EXPONENT && ABS (MP_DIGIT (z, 1)) > 1.0)) {\
2477       errno = ERANGE;\
2478       diagnostic_node (A68_RUNTIME_ERROR, p, ERROR_MP_OUT_OF_BOUNDS, NULL);\
2479       exit_genie (p, A68_RUNTIME_ERROR);\
2480   }}
2481 
2482 #define SET_MP_ZERO(z, digits) {\
2483   MP_T *_m_d = &MP_DIGIT ((z), 1); int _m_k = digits;\
2484   MP_STATUS (z) = (MP_T) INIT_MASK;\
2485   MP_EXPONENT (z) = 0.0;\
2486   while (_m_k--) {*_m_d++ = 0.0;}\
2487   }
2488 
2489 /* stack_mp: allocate temporary space in the evaluation stack */
2490 
2491 #define STACK_MP(dest, p, digits) {\
2492   ADDR_T stack_mp_sp = stack_pointer;\
2493   if ((stack_pointer += SIZE_MP (digits)) > expr_stack_limit) {\
2494     diagnostic_node (A68_RUNTIME_ERROR, p, ERROR_STACK_OVERFLOW);\
2495     exit_genie (p, A68_RUNTIME_ERROR);\
2496   }\
2497   dest = (MP_T *) STACK_ADDRESS (stack_mp_sp);\
2498 }
2499 
2500 /******************************/
2501 /* Library for code generator */
2502 /*****************************/
2503 
2504 /* Operators that are inlined in compiled code */
2505 
2506 #define a68g_eq_complex(/* A68_REAL * */ x, y) (RE (x) == RE (y) && IM (x) == IM (y))
2507 #define a68g_ne_complex(/* A68_REAL * */ x, y) (! a68g_eq_complex (x, y))
2508 #define a68g_mod_int(/* int */ i, j) (((i) % (j)) >= 0 ? ((i) % (j)) : ((i) % (j)) + labs (j))
2509 #define a68g_plusab_int(/* A68_REF * */ i, /* int */ j) (VALUE ((A68_INT *) ADDRESS (i)) += (j), (i))
2510 #define a68g_minusab_int(/* A68_REF * */ i, /* int */ j) (VALUE ((A68_INT *) ADDRESS (i)) -= (j), (i))
2511 #define a68g_timesab_int(/* A68_REF * */ i, /* int */ j) (VALUE ((A68_INT *) ADDRESS (i)) *= (j), (i))
2512 #define a68g_overab_int(/* A68_REF * */ i, /* int */ j) (VALUE ((A68_INT *) ADDRESS (i)) /= (j), (i))
2513 #define a68g_entier(/* double */ x) ((int) floor (x))
2514 #define a68g_plusab_real(/* A68_REF * */ i, /* double */ j) (VALUE ((A68_REAL *) ADDRESS (i)) += (j), (i))
2515 #define a68g_minusab_real(/* A68_REF * */ i, /* double */ j) (VALUE ((A68_REAL *) ADDRESS (i)) -= (j), (i))
2516 #define a68g_timesab_real(/* A68_REF * */ i, /* double */ j) (VALUE ((A68_REAL *) ADDRESS (i)) *= (j), (i))
2517 #define a68g_divab_real(/* A68_REF * */ i, /* double */ j) (VALUE ((A68_REAL *) ADDRESS (i)) /= (j), (i))
2518 #define a68g_re_complex(/* A68_REAL * */ z) (RE (z))
2519 #define a68g_im_complex(/* A68_REAL * */ z) (IM (z))
2520 #define a68g_abs_complex(/* A68_REAL * */ z) a68g_hypot (RE (z), IM (z))
2521 #define a68g_arg_complex(/* A68_REAL * */ z) atan2 (IM (z), RE (z))
2522 
2523 #define a68g_i_complex(/* A68_REAL * */ z, /* double */ re, im) {\
2524   STATUS_RE (z) = INIT_MASK;\
2525   STATUS_IM (z) = INIT_MASK;\
2526   RE (z) = re;\
2527   IM (z) = im;}
2528 
2529 #define a68g_minus_complex(/* A68_REAL * */ z, x) {\
2530   STATUS_RE (z) = INIT_MASK;\
2531   STATUS_IM (z) = INIT_MASK;\
2532   RE (z) = -RE (x);\
2533   IM (z) = -IM (x);}
2534 
2535 #define a68g_conj_complex(/* A68_REAL * */ z, x) {\
2536   STATUS_RE (z) = INIT_MASK;\
2537   STATUS_IM (z) = INIT_MASK;\
2538   RE (z) = RE (x);\
2539   IM (z) = -IM (x);}
2540 
2541 #define a68g_add_complex(/* A68_REAL * */ z, x, y) {\
2542   STATUS_RE (z) = INIT_MASK;\
2543   STATUS_IM (z) = INIT_MASK;\
2544   RE (z) = RE (x) + RE (y);\
2545   IM (z) = IM (x) + IM (y);}
2546 
2547 #define a68g_sub_complex(/* A68_REAL * */ z, x, y) {\
2548   STATUS_RE (z) = INIT_MASK;\
2549   STATUS_IM (z) = INIT_MASK;\
2550   RE (z) = RE (x) - RE (y);\
2551   IM (z) = IM (x) - IM (y);}
2552 
2553 #define a68g_mul_complex(/* A68_REAL * */ z, x, y) {\
2554   STATUS_RE (z) = INIT_MASK;\
2555   STATUS_IM (z) = INIT_MASK;\
2556   RE (z) = RE (x) * RE (y) - IM (x) * IM (y);\
2557   IM (z) = IM (x) * RE (y) + RE (x) * IM (y);}
2558 
2559 /********************************/
2560 /* All kind of constants ex GSL */
2561 /********************************/
2562 
2563 #define GSL_CONST_NUM_FINE_STRUCTURE (7.297352533e-3) /* 1 */
2564 #define GSL_CONST_NUM_AVOGADRO (6.02214199e23) /* 1 / mol */
2565 #define GSL_CONST_NUM_YOTTA (1e24) /* 1 */
2566 #define GSL_CONST_NUM_ZETTA (1e21) /* 1 */
2567 #define GSL_CONST_NUM_EXA (1e18) /* 1 */
2568 #define GSL_CONST_NUM_PETA (1e15) /* 1 */
2569 #define GSL_CONST_NUM_TERA (1e12) /* 1 */
2570 #define GSL_CONST_NUM_GIGA (1e9) /* 1 */
2571 #define GSL_CONST_NUM_MEGA (1e6) /* 1 */
2572 #define GSL_CONST_NUM_KILO (1e3) /* 1 */
2573 #define GSL_CONST_NUM_MILLI (1e-3) /* 1 */
2574 #define GSL_CONST_NUM_MICRO (1e-6) /* 1 */
2575 #define GSL_CONST_NUM_NANO (1e-9) /* 1 */
2576 #define GSL_CONST_NUM_PICO (1e-12) /* 1 */
2577 #define GSL_CONST_NUM_FEMTO (1e-15) /* 1 */
2578 #define GSL_CONST_NUM_ATTO (1e-18) /* 1 */
2579 #define GSL_CONST_NUM_ZEPTO (1e-21) /* 1 */
2580 #define GSL_CONST_NUM_YOCTO (1e-24) /* 1 */
2581 #define GSL_CONST_CGSM_GAUSS (1.0) /* cm / A s^2  */
2582 #define GSL_CONST_CGSM_SPEED_OF_LIGHT (2.99792458e10) /* cm / s */
2583 #define GSL_CONST_CGSM_GRAVITATIONAL_CONSTANT (6.673e-8) /* cm^3 / g s^2 */
2584 #define GSL_CONST_CGSM_ASTRONOMICAL_UNIT (1.49597870691e13) /* cm */
2585 #define GSL_CONST_CGSM_LIGHT_YEAR (9.46053620707e17) /* cm */
2586 #define GSL_CONST_CGSM_PARSEC (3.08567758135e18) /* cm */
2587 #define GSL_CONST_CGSM_GRAV_ACCEL (9.80665e2) /* cm / s^2 */
2588 #define GSL_CONST_CGSM_ELECTRON_VOLT (1.602176487e-12) /* g cm^2 / s^2 */
2589 #define GSL_CONST_CGSM_MASS_ELECTRON (9.10938188e-28) /* g */
2590 #define GSL_CONST_CGSM_MASS_MUON (1.88353109e-25) /* g */
2591 #define GSL_CONST_CGSM_MASS_PROTON (1.67262158e-24) /* g */
2592 #define GSL_CONST_CGSM_MASS_NEUTRON (1.67492716e-24) /* g */
2593 #define GSL_CONST_CGSM_RYDBERG (2.17987196968e-11) /* g cm^2 / s^2 */
2594 #define GSL_CONST_CGSM_BOLTZMANN (1.3806504e-16) /* g cm^2 / K s^2 */
2595 #define GSL_CONST_CGSM_MOLAR_GAS (8.314472e7) /* g cm^2 / K mol s^2 */
2596 #define GSL_CONST_CGSM_STANDARD_GAS_VOLUME (2.2710981e4) /* cm^3 / mol */
2597 #define GSL_CONST_CGSM_MINUTE (6e1) /* s */
2598 #define GSL_CONST_CGSM_HOUR (3.6e3) /* s */
2599 #define GSL_CONST_CGSM_DAY (8.64e4) /* s */
2600 #define GSL_CONST_CGSM_WEEK (6.048e5) /* s */
2601 #define GSL_CONST_CGSM_INCH (2.54e0) /* cm */
2602 #define GSL_CONST_CGSM_FOOT (3.048e1) /* cm */
2603 #define GSL_CONST_CGSM_YARD (9.144e1) /* cm */
2604 #define GSL_CONST_CGSM_MILE (1.609344e5) /* cm */
2605 #define GSL_CONST_CGSM_NAUTICAL_MILE (1.852e5) /* cm */
2606 #define GSL_CONST_CGSM_FATHOM (1.8288e2) /* cm */
2607 #define GSL_CONST_CGSM_MIL (2.54e-3) /* cm */
2608 #define GSL_CONST_CGSM_POINT (3.52777777778e-2) /* cm */
2609 #define GSL_CONST_CGSM_TEXPOINT (3.51459803515e-2) /* cm */
2610 #define GSL_CONST_CGSM_MICRON (1e-4) /* cm */
2611 #define GSL_CONST_CGSM_ANGSTROM (1e-8) /* cm */
2612 #define GSL_CONST_CGSM_HECTARE (1e8) /* cm^2 */
2613 #define GSL_CONST_CGSM_ACRE (4.04685642241e7) /* cm^2 */
2614 #define GSL_CONST_CGSM_BARN (1e-24) /* cm^2 */
2615 #define GSL_CONST_CGSM_LITER (1e3) /* cm^3 */
2616 #define GSL_CONST_CGSM_US_GALLON (3.78541178402e3) /* cm^3 */
2617 #define GSL_CONST_CGSM_QUART (9.46352946004e2) /* cm^3 */
2618 #define GSL_CONST_CGSM_PINT (4.73176473002e2) /* cm^3 */
2619 #define GSL_CONST_CGSM_CUP (2.36588236501e2) /* cm^3 */
2620 #define GSL_CONST_CGSM_FLUID_OUNCE (2.95735295626e1) /* cm^3 */
2621 #define GSL_CONST_CGSM_TABLESPOON (1.47867647813e1) /* cm^3 */
2622 #define GSL_CONST_CGSM_TEASPOON (4.92892159375e0) /* cm^3 */
2623 #define GSL_CONST_CGSM_CANADIAN_GALLON (4.54609e3) /* cm^3 */
2624 #define GSL_CONST_CGSM_UK_GALLON (4.546092e3) /* cm^3 */
2625 #define GSL_CONST_CGSM_MILES_PER_HOUR (4.4704e1) /* cm / s */
2626 #define GSL_CONST_CGSM_KILOMETERS_PER_HOUR (2.77777777778e1) /* cm / s */
2627 #define GSL_CONST_CGSM_KNOT (5.14444444444e1) /* cm / s */
2628 #define GSL_CONST_CGSM_POUND_MASS (4.5359237e2) /* g */
2629 #define GSL_CONST_CGSM_OUNCE_MASS (2.8349523125e1) /* g */
2630 #define GSL_CONST_CGSM_TON (9.0718474e5) /* g */
2631 #define GSL_CONST_CGSM_METRIC_TON (1e6) /* g */
2632 #define GSL_CONST_CGSM_UK_TON (1.0160469088e6) /* g */
2633 #define GSL_CONST_CGSM_TROY_OUNCE (3.1103475e1) /* g */
2634 #define GSL_CONST_CGSM_CARAT (2e-1) /* g */
2635 #define GSL_CONST_CGSM_UNIFIED_ATOMIC_MASS (1.660538782e-24) /* g */
2636 #define GSL_CONST_CGSM_GRAM_FORCE (9.80665e2) /* cm g / s^2 */
2637 #define GSL_CONST_CGSM_POUND_FORCE (4.44822161526e5) /* cm g / s^2 */
2638 #define GSL_CONST_CGSM_KILOPOUND_FORCE (4.44822161526e8) /* cm g / s^2 */
2639 #define GSL_CONST_CGSM_POUNDAL (1.38255e4) /* cm g / s^2 */
2640 #define GSL_CONST_CGSM_CALORIE (4.1868e7) /* g cm^2 / s^2 */
2641 #define GSL_CONST_CGSM_BTU (1.05505585262e10) /* g cm^2 / s^2 */
2642 #define GSL_CONST_CGSM_THERM (1.05506e15) /* g cm^2 / s^2 */
2643 #define GSL_CONST_CGSM_HORSEPOWER (7.457e9) /* g cm^2 / s^3 */
2644 #define GSL_CONST_CGSM_BAR (1e6) /* g / cm s^2 */
2645 #define GSL_CONST_CGSM_STD_ATMOSPHERE (1.01325e6) /* g / cm s^2 */
2646 #define GSL_CONST_CGSM_TORR (1.33322368421e3) /* g / cm s^2 */
2647 #define GSL_CONST_CGSM_METER_OF_MERCURY (1.33322368421e6) /* g / cm s^2 */
2648 #define GSL_CONST_CGSM_INCH_OF_MERCURY (3.38638815789e4) /* g / cm s^2 */
2649 #define GSL_CONST_CGSM_INCH_OF_WATER (2.490889e3) /* g / cm s^2 */
2650 #define GSL_CONST_CGSM_PSI (6.89475729317e4) /* g / cm s^2 */
2651 #define GSL_CONST_CGSM_POISE (1e0) /* g / cm s */
2652 #define GSL_CONST_CGSM_STOKES (1e0) /* cm^2 / s */
2653 #define GSL_CONST_CGSM_STILB (1e0) /* cd / cm^2 */
2654 #define GSL_CONST_CGSM_LUMEN (1e0) /* cd sr */
2655 #define GSL_CONST_CGSM_LUX (1e-4) /* cd sr / cm^2 */
2656 #define GSL_CONST_CGSM_PHOT (1e0) /* cd sr / cm^2 */
2657 #define GSL_CONST_CGSM_FOOTCANDLE (1.076e-3) /* cd sr / cm^2 */
2658 #define GSL_CONST_CGSM_LAMBERT (1e0) /* cd sr / cm^2 */
2659 #define GSL_CONST_CGSM_FOOTLAMBERT (1.07639104e-3) /* cd sr / cm^2 */
2660 #define GSL_CONST_CGSM_CURIE (3.7e10) /* 1 / s */
2661 #define GSL_CONST_CGSM_ROENTGEN (2.58e-8) /* abamp s / g */
2662 #define GSL_CONST_CGSM_RAD (1e2) /* cm^2 / s^2 */
2663 #define GSL_CONST_CGSM_SOLAR_MASS (1.98892e33) /* g */
2664 #define GSL_CONST_CGSM_BOHR_RADIUS (5.291772083e-9) /* cm */
2665 #define GSL_CONST_CGSM_NEWTON (1e5) /* cm g / s^2 */
2666 #define GSL_CONST_CGSM_DYNE (1e0) /* cm g / s^2 */
2667 #define GSL_CONST_CGSM_JOULE (1e7) /* g cm^2 / s^2 */
2668 #define GSL_CONST_CGSM_ERG (1e0) /* g cm^2 / s^2 */
2669 #define GSL_CONST_CGSM_BOHR_MAGNETON (9.27400899e-21) /* abamp cm^2 */
2670 #define GSL_CONST_CGSM_NUCLEAR_MAGNETON (5.05078317e-24) /* abamp cm^2 */
2671 #define GSL_CONST_CGSM_ELECTRON_MAGNETIC_MOMENT (9.28476362e-21) /* abamp cm^2 */
2672 #define GSL_CONST_CGSM_PROTON_MAGNETIC_MOMENT (1.410606633e-23) /* abamp cm^2 */
2673 #define GSL_CONST_CGSM_FARADAY (9.64853429775e3) /* abamp s / mol */
2674 #define GSL_CONST_CGSM_ELECTRON_CHARGE (1.602176487e-20) /* abamp s */
2675 #define GSL_CONST_MKS_SPEED_OF_LIGHT (2.99792458e8) /* m / s */
2676 #define GSL_CONST_MKS_GRAVITATIONAL_CONSTANT (6.673e-11) /* m^3 / kg s^2 */
2677 #define GSL_CONST_MKS_ASTRONOMICAL_UNIT (1.49597870691e11) /* m */
2678 #define GSL_CONST_MKS_LIGHT_YEAR (9.46053620707e15) /* m */
2679 #define GSL_CONST_MKS_PARSEC (3.08567758135e16) /* m */
2680 #define GSL_CONST_MKS_GRAV_ACCEL (9.80665e0) /* m / s^2 */
2681 #define GSL_CONST_MKS_ELECTRON_VOLT (1.602176487e-19) /* kg m^2 / s^2 */
2682 #define GSL_CONST_MKS_MASS_ELECTRON (9.10938188e-31) /* kg */
2683 #define GSL_CONST_MKS_MASS_MUON (1.88353109e-28) /* kg */
2684 #define GSL_CONST_MKS_MASS_PROTON (1.67262158e-27) /* kg */
2685 #define GSL_CONST_MKS_MASS_NEUTRON (1.67492716e-27) /* kg */
2686 #define GSL_CONST_MKS_RYDBERG (2.17987196968e-18) /* kg m^2 / s^2 */
2687 #define GSL_CONST_MKS_BOLTZMANN (1.3806504e-23) /* kg m^2 / K s^2 */
2688 #define GSL_CONST_MKS_MOLAR_GAS (8.314472e0) /* kg m^2 / K mol s^2 */
2689 #define GSL_CONST_MKS_STANDARD_GAS_VOLUME (2.2710981e-2) /* m^3 / mol */
2690 #define GSL_CONST_MKS_MINUTE (6e1) /* s */
2691 #define GSL_CONST_MKS_HOUR (3.6e3) /* s */
2692 #define GSL_CONST_MKS_DAY (8.64e4) /* s */
2693 #define GSL_CONST_MKS_WEEK (6.048e5) /* s */
2694 #define GSL_CONST_MKS_INCH (2.54e-2) /* m */
2695 #define GSL_CONST_MKS_FOOT (3.048e-1) /* m */
2696 #define GSL_CONST_MKS_YARD (9.144e-1) /* m */
2697 #define GSL_CONST_MKS_MILE (1.609344e3) /* m */
2698 #define GSL_CONST_MKS_NAUTICAL_MILE (1.852e3) /* m */
2699 #define GSL_CONST_MKS_FATHOM (1.8288e0) /* m */
2700 #define GSL_CONST_MKS_MIL (2.54e-5) /* m */
2701 #define GSL_CONST_MKS_POINT (3.52777777778e-4) /* m */
2702 #define GSL_CONST_MKS_TEXPOINT (3.51459803515e-4) /* m */
2703 #define GSL_CONST_MKS_MICRON (1e-6) /* m */
2704 #define GSL_CONST_MKS_ANGSTROM (1e-10) /* m */
2705 #define GSL_CONST_MKS_HECTARE (1e4) /* m^2 */
2706 #define GSL_CONST_MKS_ACRE (4.04685642241e3) /* m^2 */
2707 #define GSL_CONST_MKS_BARN (1e-28) /* m^2 */
2708 #define GSL_CONST_MKS_LITER (1e-3) /* m^3 */
2709 #define GSL_CONST_MKS_US_GALLON (3.78541178402e-3) /* m^3 */
2710 #define GSL_CONST_MKS_QUART (9.46352946004e-4) /* m^3 */
2711 #define GSL_CONST_MKS_PINT (4.73176473002e-4) /* m^3 */
2712 #define GSL_CONST_MKS_CUP (2.36588236501e-4) /* m^3 */
2713 #define GSL_CONST_MKS_FLUID_OUNCE (2.95735295626e-5) /* m^3 */
2714 #define GSL_CONST_MKS_TABLESPOON (1.47867647813e-5) /* m^3 */
2715 #define GSL_CONST_MKS_TEASPOON (4.92892159375e-6) /* m^3 */
2716 #define GSL_CONST_MKS_CANADIAN_GALLON (4.54609e-3) /* m^3 */
2717 #define GSL_CONST_MKS_UK_GALLON (4.546092e-3) /* m^3 */
2718 #define GSL_CONST_MKS_MILES_PER_HOUR (4.4704e-1) /* m / s */
2719 #define GSL_CONST_MKS_KILOMETERS_PER_HOUR (2.77777777778e-1) /* m / s */
2720 #define GSL_CONST_MKS_KNOT (5.14444444444e-1) /* m / s */
2721 #define GSL_CONST_MKS_POUND_MASS (4.5359237e-1) /* kg */
2722 #define GSL_CONST_MKS_OUNCE_MASS (2.8349523125e-2) /* kg */
2723 #define GSL_CONST_MKS_TON (9.0718474e2) /* kg */
2724 #define GSL_CONST_MKS_METRIC_TON (1e3) /* kg */
2725 #define GSL_CONST_MKS_UK_TON (1.0160469088e3) /* kg */
2726 #define GSL_CONST_MKS_TROY_OUNCE (3.1103475e-2) /* kg */
2727 #define GSL_CONST_MKS_CARAT (2e-4) /* kg */
2728 #define GSL_CONST_MKS_UNIFIED_ATOMIC_MASS (1.660538782e-27) /* kg */
2729 #define GSL_CONST_MKS_GRAM_FORCE (9.80665e-3) /* kg m / s^2 */
2730 #define GSL_CONST_MKS_POUND_FORCE (4.44822161526e0) /* kg m / s^2 */
2731 #define GSL_CONST_MKS_KILOPOUND_FORCE (4.44822161526e3) /* kg m / s^2 */
2732 #define GSL_CONST_MKS_POUNDAL (1.38255e-1) /* kg m / s^2 */
2733 #define GSL_CONST_MKS_CALORIE (4.1868e0) /* kg m^2 / s^2 */
2734 #define GSL_CONST_MKS_BTU (1.05505585262e3) /* kg m^2 / s^2 */
2735 #define GSL_CONST_MKS_THERM (1.05506e8) /* kg m^2 / s^2 */
2736 #define GSL_CONST_MKS_HORSEPOWER (7.457e2) /* kg m^2 / s^3 */
2737 #define GSL_CONST_MKS_BAR (1e5) /* kg / m s^2 */
2738 #define GSL_CONST_MKS_STD_ATMOSPHERE (1.01325e5) /* kg / m s^2 */
2739 #define GSL_CONST_MKS_TORR (1.33322368421e2) /* kg / m s^2 */
2740 #define GSL_CONST_MKS_METER_OF_MERCURY (1.33322368421e5) /* kg / m s^2 */
2741 #define GSL_CONST_MKS_INCH_OF_MERCURY (3.38638815789e3) /* kg / m s^2 */
2742 #define GSL_CONST_MKS_INCH_OF_WATER (2.490889e2) /* kg / m s^2 */
2743 #define GSL_CONST_MKS_PSI (6.89475729317e3) /* kg / m s^2 */
2744 #define GSL_CONST_MKS_POISE (1e-1) /* kg m^-1 s^-1 */
2745 #define GSL_CONST_MKS_STOKES (1e-4) /* m^2 / s */
2746 #define GSL_CONST_MKS_STILB (1e4) /* cd / m^2 */
2747 #define GSL_CONST_MKS_LUMEN (1e0) /* cd sr */
2748 #define GSL_CONST_MKS_LUX (1e0) /* cd sr / m^2 */
2749 #define GSL_CONST_MKS_PHOT (1e4) /* cd sr / m^2 */
2750 #define GSL_CONST_MKS_FOOTCANDLE (1.076e1) /* cd sr / m^2 */
2751 #define GSL_CONST_MKS_LAMBERT (1e4) /* cd sr / m^2 */
2752 #define GSL_CONST_MKS_FOOTLAMBERT (1.07639104e1) /* cd sr / m^2 */
2753 #define GSL_CONST_MKS_CURIE (3.7e10) /* 1 / s */
2754 #define GSL_CONST_MKS_ROENTGEN (2.58e-4) /* A s / kg */
2755 #define GSL_CONST_MKS_RAD (1e-2) /* m^2 / s^2 */
2756 #define GSL_CONST_MKS_SOLAR_MASS (1.98892e30) /* kg */
2757 #define GSL_CONST_MKS_BOHR_RADIUS (5.291772083e-11) /* m */
2758 #define GSL_CONST_MKS_NEWTON (1e0) /* kg m / s^2 */
2759 #define GSL_CONST_MKS_DYNE (1e-5) /* kg m / s^2 */
2760 #define GSL_CONST_MKS_JOULE (1e0) /* kg m^2 / s^2 */
2761 #define GSL_CONST_MKS_ERG (1e-7) /* kg m^2 / s^2 */
2762 #define GSL_CONST_MKS_BOHR_MAGNETON (9.27400899e-24) /* A m^2 */
2763 #define GSL_CONST_MKS_NUCLEAR_MAGNETON (5.05078317e-27) /* A m^2 */
2764 #define GSL_CONST_MKS_ELECTRON_MAGNETIC_MOMENT (9.28476362e-24) /* A m^2 */
2765 #define GSL_CONST_MKS_PROTON_MAGNETIC_MOMENT (1.410606633e-26) /* A m^2 */
2766 #define GSL_CONST_MKS_FARADAY (9.64853429775e4) /* A s / mol */
2767 #define GSL_CONST_MKS_ELECTRON_CHARGE (1.602176487e-19) /* A s */
2768 #define GSL_CONST_MKS_VACUUM_PERMITTIVITY (8.854187817e-12) /* A^2 s^4 / kg m^3 */
2769 #define GSL_CONST_MKS_VACUUM_PERMEABILITY (1.25663706144e-6) /* kg m / A^2 s^2 */
2770 #define GSL_CONST_MKS_GAUSS (1e-4) /* kg / A s^2 */
2771 
2772 /***********************/
2773 /* Global declarations */
2774 /***********************/
2775 
2776 extern A68_CHANNEL stand_in_channel, stand_out_channel, stand_draw_channel, stand_back_channel, stand_error_channel, associate_channel, skip_channel;
2777 extern A68_FORMAT nil_format;
2778 extern A68_HANDLE nil_handle, *free_handles, *busy_handles;
2779 extern A68_REF nil_ref, stand_in, stand_out, skip_file;
2780 extern ADDR_T fixed_heap_pointer, temp_heap_pointer, frame_pointer, stack_pointer, heap_pointer, handle_pointer, global_pointer, frame_start, frame_end, stack_start, stack_end, finish_frame_pointer;
2781 extern BOOL_T halt_typing, heap_is_fluid, in_execution, in_monitor, do_confirm_exit, no_warnings, close_tty_on_exit;
2782 extern BYTE_T *stack_segment, *heap_segment, *handle_segment, *system_stack_offset;
2783 extern KEYWORD_T *top_keyword;
2784 extern MODES_T a68_modes;
2785 extern MODULE_T program;
2786 extern NODE_T **node_register;
2787 extern POSTULATE_T *top_postulate, *top_postulate_list;
2788 extern TABLE_T *a68g_standenv;
2789 extern TAG_T *error_tag;
2790 extern TOKEN_T *top_token;
2791 extern char **global_argv, *watchpoint_expression, a68g_cmd_name[], output_line[], edit_line[], input_line[];
2792 extern clock_t clock_res;
2793 extern double cputime_0, garbage_seconds;
2794 extern int frame_stack_size, expr_stack_size, heap_size, handle_pool_size, free_handle_count, max_handle_count, garbage_collects, global_argc, global_level, max_lex_lvl, new_nodes, new_modes, new_postulates, new_node_infos, new_genie_infos, stack_limit, frame_stack_limit, expr_stack_limit, stack_size, storage_overhead, symbol_table_count, mode_count, term_heigth, term_width, varying_mp_digits;
2795 extern jmp_buf genie_exit_label;
2796 
2797 #if defined HAVE_CURSES
2798 extern BOOL_T a68g_curses_mode;
2799 #endif
2800 
2801 #if defined HAVE_PARALLEL_CLAUSE
2802 extern pthread_t main_thread_id;
2803 #define SAME_THREAD(p, q) (pthread_equal((p), (q)) != 0)
2804 #define OTHER_THREAD(p, q) (pthread_equal((p), (q)) == 0)
2805 #endif
2806 
2807 #if defined HAVE_WIN32
2808 extern int finite (double);
2809 #endif
2810 
2811 extern A68_REF genie_make_row (NODE_T *, MOID_T *, int, ADDR_T);
2812 extern A68_REF c_string_to_row_char (NODE_T *, char *, int);
2813 extern A68_REF c_to_a_string (NODE_T *, char *, int);
2814 extern A68_REF empty_row (NODE_T *, MOID_T *);
2815 extern A68_REF empty_string (NODE_T *);
2816 extern A68_REF genie_store (NODE_T *, MOID_T *, A68_REF *, A68_REF *);
2817 extern A68_REF heap_generator (NODE_T *, MOID_T *, int);
2818 extern ADDR_T calculate_internal_index (A68_TUPLE *, int);
2819 extern BOOL_T a68g_mkstemp(char *, int, mode_t);
2820 extern BOOL_T close_device (NODE_T *, A68_FILE *);
2821 extern BOOL_T genie_int_case_unit (NODE_T *, int, int *);
2822 extern BOOL_T genie_string_to_value_internal (NODE_T *, MOID_T *, char *, BYTE_T *);
2823 extern BOOL_T increment_internal_index (A68_TUPLE *, int);
2824 extern BOOL_T lexical_analyser (void);
2825 extern BOOL_T match_string (char *, char *, char);
2826 extern BOOL_T set_options (OPTION_LIST_T *, BOOL_T);
2827 extern BOOL_T whether (NODE_T * p, ...);
2828 extern BOOL_T is_coercion (NODE_T *);
2829 extern BOOL_T is_firm (MOID_T *, MOID_T *);
2830 extern BOOL_T is_modes_equivalent (MOID_T *, MOID_T *);
2831 extern BOOL_T is_new_lexical_level (NODE_T *);
2832 extern BOOL_T is_one_of (NODE_T * p, ...);
2833 extern BOOL_T is_subset (MOID_T *, MOID_T *, int);
2834 extern BOOL_T is_unitable (MOID_T *, MOID_T *, int);
2835 extern BYTE_T *get_fixed_heap_space (size_t);
2836 extern BYTE_T *get_heap_space (size_t);
2837 extern BYTE_T *get_temp_heap_space (size_t);
2838 extern FILE *a68g_fopen (char *, char *, char *);
2839 extern FILE_T open_physical_file (NODE_T *, A68_REF, int, mode_t);
2840 extern GINFO_T *new_genie_info (void);
2841 extern KEYWORD_T *find_keyword (KEYWORD_T *, char *);
2842 extern KEYWORD_T *find_keyword_from_attribute (KEYWORD_T *, int);
2843 extern MOID_T *add_mode (MOID_T **, int, int, NODE_T *, MOID_T *, PACK_T *);
2844 extern MOID_T *depref_completely (MOID_T *);
2845 extern MOID_T *new_moid (void);
2846 extern MOID_T *unites_to (MOID_T *, MOID_T *);
2847 extern NODE_INFO_T *new_node_info (void);
2848 extern NODE_T *get_next_format_pattern (NODE_T *, A68_REF, BOOL_T);
2849 extern NODE_T *last_unit;
2850 extern NODE_T *new_node (void);
2851 extern NODE_T *some_node (char *);
2852 extern PACK_T *new_pack (void);
2853 extern POSTULATE_T *is_postulated (POSTULATE_T *, MOID_T *);
2854 extern POSTULATE_T *is_postulated_pair (POSTULATE_T *, MOID_T *, MOID_T *);
2855 extern LINE_T *new_source_line (void);
2856 extern TABLE_T *find_level (NODE_T *, int);
2857 extern TABLE_T *new_symbol_table (TABLE_T *);
2858 extern TAG_T *add_tag (TABLE_T *, int, NODE_T *, MOID_T *, int);
2859 extern TAG_T *find_tag_global (TABLE_T *, int, char *);
2860 extern TAG_T *find_tag_local (TABLE_T *, int, char *);
2861 extern TAG_T *new_tag (void);
2862 extern TOKEN_T *add_token (TOKEN_T **, char *);
2863 extern char *a68g_strchr (char *, int);
2864 extern char *a_to_c_string (NODE_T *, char *, A68_REF);
2865 extern char *ctrl_char (int);
2866 extern char *error_chars (char *, int);
2867 extern char *error_specification (void);
2868 extern char *fixed (NODE_T * p);
2869 extern char *get_transput_buffer (int);
2870 extern char *moid_to_string (MOID_T *, int, NODE_T *);
2871 extern char *new_fixed_string (char *);
2872 extern char *new_string (char *, ...);
2873 extern char *new_temp_string (char *);
2874 extern char *non_terminal_string (char *, int);
2875 extern char *phrase_to_text (NODE_T *, NODE_T **);
2876 extern char *propagator_name (PROP_PROC *p);
2877 extern char *read_string_from_tty (char *);
2878 extern char *standard_environ_proc_name (GPROC);
2879 extern char *sub_fixed (NODE_T *, double, int, int);
2880 extern char *sub_whole (NODE_T *, int, int);
2881 extern char *whole (NODE_T * p);
2882 extern char digit_to_char (int);
2883 extern char pop_char_transput_buffer (int);
2884 extern double a68g_acosh (double);
2885 extern double a68g_asinh (double);
2886 extern double a68g_atan2 (double, double);
2887 extern double a68g_atanh (double);
2888 extern double a68g_exp (double);
2889 extern double a68g_hypot (double, double);
2890 extern double a68g_log1p (double);
2891 extern double a68g_pow_real (double, double);
2892 extern double a68g_pow_real_int (double, int);
2893 extern double curt (double);
2894 extern double inverf (double);
2895 extern double inverfc (double);
2896 extern double rng_53_bit (void);
2897 extern double seconds (void);
2898 extern double ten_up (int);
2899 extern int a68_string_size (NODE_T *, A68_REF);
2900 extern int a68g_round (double);
2901 extern int char_scanner (A68_FILE *);
2902 extern int count_pack_members (PACK_T *);
2903 extern int end_of_format (NODE_T *, A68_REF);
2904 extern int first_tag_global (TABLE_T *, char *);
2905 extern int get_replicator_value (NODE_T *, BOOL_T);
2906 extern int get_row_size (A68_TUPLE *, int);
2907 extern int get_transput_buffer_index (int);
2908 extern int get_transput_buffer_size (int);
2909 extern int get_unblocked_transput_buffer (NODE_T *);
2910 extern int grep_in_string (char *, char *, int *, int *);
2911 extern int heap_available (void);
2912 extern int moid_digits (MOID_T *);
2913 extern int moid_size (MOID_T *);
2914 extern int store_file_entry (NODE_T *, FILE_T, char *, BOOL_T);
2915 extern int is_identifier_or_label_global (TABLE_T *, char *);
2916 extern ssize_t io_read (FILE_T, void *, size_t);
2917 extern ssize_t io_read_conv (FILE_T, void *, size_t);
2918 extern ssize_t io_write (FILE_T, const void *, size_t);
2919 extern ssize_t io_write_conv (FILE_T, const void *, size_t);
2920 extern unsigned a68g_strtoul (char *, char **, int);
2921 extern void a68g_cos_complex (A68_REAL *, A68_REAL *);
2922 extern void a68g_div_complex (A68_REAL *, A68_REAL *, A68_REAL *);
2923 extern void a68g_exit (int);
2924 extern void a68g_exp_complex (A68_REAL *, A68_REAL *);
2925 extern void a68g_getty (int *, int *);
2926 extern void a68g_ln_complex (A68_REAL *, A68_REAL *);
2927 extern void a68g_sin_complex (A68_REAL *, A68_REAL *);
2928 extern void a68g_sqrt_complex (A68_REAL *, A68_REAL *);
2929 extern void abend (char *, char *, char *, int);
2930 extern void add_a_string_transput_buffer (NODE_T *, int, BYTE_T *);
2931 extern void add_char_transput_buffer (NODE_T *, int, char);
2932 extern void add_mode_to_pack (PACK_T **, MOID_T *, char *, NODE_T *);
2933 extern void add_mode_to_pack_end (PACK_T **, MOID_T *, char *, NODE_T *);
2934 extern void add_option_list (OPTION_LIST_T **, char *, LINE_T *);
2935 extern void add_string_from_stack_transput_buffer (NODE_T *, int);
2936 extern void add_string_transput_buffer (NODE_T *, int, char *);
2937 extern void apropos (FILE_T, char *, char *);
2938 extern void assign_offsets (NODE_T *);
2939 extern void assign_offsets_packs (MOID_T *);
2940 extern void assign_offsets_table (TABLE_T *);
2941 extern void bind_format_tags_to_tree (NODE_T *);
2942 extern void bind_routine_tags_to_tree (NODE_T *);
2943 extern void bottom_up_error_check (NODE_T *);
2944 extern void bottom_up_parser (NODE_T *);
2945 extern void bufcat (char *, char *, int);
2946 extern void bufcpy (char *, char *, int);
2947 extern void change_breakpoints (NODE_T *, unsigned, int, BOOL_T *, char *);
2948 extern void change_masks (NODE_T *, unsigned, BOOL_T);
2949 extern void check_parenthesis (NODE_T *);
2950 extern void coercion_inserter (NODE_T *);
2951 extern void collect_taxes (NODE_T *);
2952 extern void compiler (FILE_T);
2953 extern void default_options (MODULE_T *);
2954 extern void diagnostic_line (STATUS_MASK, LINE_T *, char *, char *, ...);
2955 extern void diagnostic_node (STATUS_MASK, NODE_T *, char *, ...);
2956 extern void diagnostics_to_terminal (LINE_T *, int);
2957 extern void discard_heap (void);
2958 extern void end_of_file_error (NODE_T * p, A68_REF ref_file);
2959 extern void enlarge_transput_buffer (NODE_T *, int, int);
2960 extern void exit_genie (NODE_T *, int);
2961 extern void fill_symbol_table_outer (NODE_T *, TABLE_T *);
2962 extern void finalise_symbol_table_setup (NODE_T *, int);
2963 extern void format_error (NODE_T *, A68_REF, char *);
2964 extern void free_file_entries (void);
2965 extern void free_genie_heap (NODE_T *);
2966 extern void free_postulate_list (POSTULATE_T *, POSTULATE_T *);
2967 extern void gc_heap (NODE_T *, ADDR_T);
2968 extern void genie (void *);
2969 extern void genie_argc (NODE_T *);
2970 extern void genie_argv (NODE_T *);
2971 extern void genie_a68g_argc (NODE_T *);
2972 extern void genie_a68g_argv (NODE_T *);
2973 extern void genie_call_operator (NODE_T *, ADDR_T);
2974 extern void genie_call_procedure (NODE_T *, MOID_T *, MOID_T *, MOID_T *, A68_PROCEDURE *, ADDR_T, ADDR_T);
2975 extern void genie_call_event_routine (NODE_T *, MOID_T *, A68_PROCEDURE *, ADDR_T, ADDR_T);
2976 extern void genie_check_initialisation (NODE_T *, BYTE_T *, MOID_T *);
2977 extern void genie_columns (NODE_T *);
2978 extern void genie_create_pipe (NODE_T *);
2979 extern void genie_declaration (NODE_T *);
2980 extern void genie_enquiry_clause (NODE_T *);
2981 extern void genie_errno (NODE_T *);
2982 extern void genie_execve (NODE_T *);
2983 extern void genie_execve_child (NODE_T *);
2984 extern void genie_execve_child_pipe (NODE_T *);
2985 extern void genie_execve_output (NODE_T *);
2986 extern void genie_f_and_becomes (NODE_T *, MOID_T *, GPROC *);
2987 extern void genie_find_proc_op (NODE_T *, int *);
2988 extern void genie_fork (NODE_T *);
2989 extern void genie_generator_bounds (NODE_T *);
2990 extern void genie_generator_internal (NODE_T *, MOID_T *, TAG_T *, LEAP_T, ADDR_T);
2991 extern void genie_getenv (NODE_T *);
2992 extern void genie_identity_dec (NODE_T *);
2993 extern void genie_init_heap (NODE_T *);
2994 extern void genie_init_rng (void);
2995 extern void genie_localtime (NODE_T *);
2996 extern void genie_operator_dec (NODE_T *);
2997 extern void genie_preprocess (NODE_T *, int *, void *);
2998 extern void genie_proc_variable_dec (NODE_T *);
2999 extern void genie_push_undefined (NODE_T *, MOID_T *);
3000 extern void genie_read_standard (NODE_T *, MOID_T *, BYTE_T *, A68_REF);
3001 extern void genie_reset_errno (NODE_T *);
3002 extern void genie_rows (NODE_T *);
3003 extern void genie_serial_clause (NODE_T *, jmp_buf *);
3004 extern void genie_serial_units (NODE_T *, NODE_T **, jmp_buf *, int);
3005 extern void genie_strerror (NODE_T *);
3006 extern void genie_string_to_value (NODE_T *, MOID_T *, BYTE_T *, A68_REF);
3007 extern void genie_subscript (NODE_T *, A68_TUPLE **, int *, NODE_T **);
3008 extern void genie_utctime (NODE_T *);
3009 extern void genie_value_to_string (NODE_T *, MOID_T *, BYTE_T *, int);
3010 extern void genie_variable_dec (NODE_T *, NODE_T **, ADDR_T);
3011 extern void genie_waitpid (NODE_T *);
3012 extern void genie_write_standard (NODE_T *, MOID_T *, BYTE_T *, A68_REF);
3013 extern void get_global_level (NODE_T *);
3014 extern void get_max_simplout_size (NODE_T *);
3015 extern void get_refinements (void);
3016 extern void get_stack_size (void);
3017 extern void indenter (MODULE_T *);
3018 extern BOOL_T folder_mode (MOID_T *);
3019 extern void push_unit (NODE_T *);
3020 extern BOOL_T constant_unit (NODE_T *);
3021 extern void init_curses (void);
3022 extern void init_file_entries (void);
3023 extern void init_file_entry (int);
3024 extern void init_heap (void);
3025 extern void init_options (void);
3026 extern void init_postulates (void);
3027 extern void init_rng (unsigned long);
3028 extern void init_tty (void);
3029 extern void initialise_frame (NODE_T *);
3030 extern void initialise_internal_index (A68_TUPLE *, int);
3031 extern void install_signal_handlers (void);
3032 extern void io_close_tty_line (void);
3033 extern void io_write_string (FILE_T, const char *);
3034 extern void isolate_options (char *, LINE_T *);
3035 extern void jumps_from_procs (NODE_T * p);
3036 extern void list_source_line (FILE_T, LINE_T *, BOOL_T);
3037 extern void make_postulate (POSTULATE_T **, MOID_T *, MOID_T *);
3038 extern void make_special_mode (MOID_T **, int);
3039 extern void make_standard_environ (void);
3040 extern void make_sub (NODE_T *, NODE_T *, int);
3041 extern void make_moid_list (MODULE_T *);
3042 extern void mark_auxilliary (NODE_T *);
3043 extern void mark_jump_in_par (NODE_T *, BOOL_T);
3044 extern void mark_moids (NODE_T *);
3045 extern void mode_checker (NODE_T *);
3046 extern void monitor_error (char *, char *);
3047 extern void on_event_handler (NODE_T *, A68_PROCEDURE, A68_REF);
3048 extern void online_help (FILE_T);
3049 extern void open_error (NODE_T *, A68_REF, char *);
3050 extern void pattern_error (NODE_T *, MOID_T *, int);
3051 extern void portcheck (NODE_T *);
3052 extern void preliminary_symbol_table_setup (NODE_T *);
3053 extern void print_bytes (BYTE_T *, int);
3054 extern void print_internal_index (FILE_T, A68_TUPLE *, int);
3055 extern void print_item (NODE_T *, FILE_T, BYTE_T *, MOID_T *);
3056 extern void print_mode_flat (FILE_T, MOID_T *);
3057 extern void prune_echoes (OPTION_LIST_T *);
3058 extern void put_refinements (void);
3059 extern void read_env_options (void);
3060 extern void read_insertion (NODE_T *, A68_REF);
3061 extern void read_rc_options (void);
3062 extern void read_sound (NODE_T *, A68_REF, A68_SOUND *);
3063 extern void rearrange_goto_less_jumps (NODE_T *);
3064 extern void register_nodes (NODE_T *);
3065 extern void renumber_moids (MOID_T *, int);
3066 extern void renumber_nodes (NODE_T *, int *);
3067 extern void reset_symbol_table_nest_count (NODE_T *);
3068 extern void reset_transput_buffer (int);
3069 extern void scan_error (LINE_T *, char *, char *);
3070 extern void scope_checker (NODE_T *);
3071 extern void set_default_event_procedure (A68_PROCEDURE *);
3072 extern void set_default_event_procedures (A68_FILE *);
3073 extern void set_moid_sizes (MOID_T *);
3074 extern void set_nest (NODE_T *, NODE_T *);
3075 extern void set_proc_level (NODE_T *, int);
3076 extern void set_transput_buffer_index (int, int);
3077 extern void set_transput_buffer_size (int, int);
3078 extern void set_up_tables (void);
3079 extern void single_step (NODE_T *, unsigned);
3080 extern void stack_dump (FILE_T, ADDR_T, int, int *);
3081 extern void standardise (double *, int, int, int *);
3082 extern void state_license (FILE_T);
3083 extern void state_version (FILE_T);
3084 extern void substitute_brackets (NODE_T *);
3085 extern void tie_label_to_serial (NODE_T *);
3086 extern void tie_label_to_unit (NODE_T *);
3087 extern void top_down_parser (NODE_T *);
3088 extern void transput_error (NODE_T *, A68_REF, MOID_T *);
3089 extern void tree_listing (FILE_T, NODE_T *, int, LINE_T *, int *);
3090 extern void unchar_scanner (NODE_T *, A68_FILE *, char);
3091 extern void value_error (NODE_T *, MOID_T *, A68_REF);
3092 extern void victal_checker (NODE_T *);
3093 extern void warn_for_unused_tags (NODE_T *);
3094 extern void where_in_source (FILE_T, NODE_T *);
3095 extern void widen_denotation (NODE_T *);
3096 extern void write_insertion (NODE_T *, A68_REF, unsigned);
3097 extern void write_listing (void);
3098 extern void write_listing_header (void);
3099 extern void write_object_listing (void);
3100 extern void write_purge_buffer (NODE_T *, A68_REF, int);
3101 extern void write_sound (NODE_T *, A68_REF, A68_SOUND *);
3102 extern void write_source_line (FILE_T, LINE_T *, NODE_T *, int);
3103 extern void write_source_listing (void);
3104 extern void write_tree_listing (void);
3105 
3106 #if defined HAVE_CURSES
3107 #endif
3108 
3109 #if defined HAVE_PARALLEL_CLAUSE
3110 extern BOOL_T is_main_thread (void);
3111 extern void genie_abend_all_threads (NODE_T *, jmp_buf *, NODE_T *);
3112 extern void genie_set_exit_from_threads (int);
3113 #endif
3114 
3115 /* External multi-precision procedures */
3116 
3117 extern BOOL_T check_long_int (MP_T *);
3118 extern BOOL_T check_longlong_int (MP_T *);
3119 extern BOOL_T check_mp_int (MP_T *, MOID_T *);
3120 extern MP_T *abs_mp (NODE_T *, MP_T *, MP_T *, int);
3121 extern MP_T *minus_mp (NODE_T *, MP_T *, MP_T *, int);
3122 extern MP_T *round_mp (NODE_T *, MP_T *, MP_T *, int);
3123 extern MP_T *entier_mp (NODE_T *, MP_T *, MP_T *, int);
3124 extern void eq_mp (NODE_T *, A68_BOOL *, MP_T *, MP_T *, int);
3125 extern void ne_mp (NODE_T *, A68_BOOL *, MP_T *, MP_T *, int);
3126 extern void lt_mp (NODE_T *, A68_BOOL *, MP_T *, MP_T *, int);
3127 extern void le_mp (NODE_T *, A68_BOOL *, MP_T *, MP_T *, int);
3128 extern void gt_mp (NODE_T *, A68_BOOL *, MP_T *, MP_T *, int);
3129 extern void ge_mp (NODE_T *, A68_BOOL *, MP_T *, MP_T *, int);
3130 extern MP_T *acos_mp (NODE_T *, MP_T *, MP_T *, int);
3131 extern MP_T *acosh_mp (NODE_T *, MP_T *, MP_T *, int);
3132 extern MP_T *add_mp (NODE_T *, MP_T *, MP_T *, MP_T *, int);
3133 extern MP_T *asin_mp (NODE_T *, MP_T *, MP_T *, int);
3134 extern MP_T *asinh_mp (NODE_T *, MP_T *, MP_T *, int);
3135 extern MP_T *atan2_mp (NODE_T *, MP_T *, MP_T *, MP_T *, int);
3136 extern MP_T *atan_mp (NODE_T *, MP_T *, MP_T *, int);
3137 extern MP_T *atanh_mp (NODE_T *, MP_T *, MP_T *, int);
3138 extern MP_T *cacos_mp (NODE_T *, MP_T *, MP_T *, int);
3139 extern MP_T *casin_mp (NODE_T *, MP_T *, MP_T *, int);
3140 extern MP_T *catan_mp (NODE_T *, MP_T *, MP_T *, int);
3141 extern MP_T *ccos_mp (NODE_T *, MP_T *, MP_T *, int);
3142 extern MP_T *cdiv_mp (NODE_T *, MP_T *, MP_T *, MP_T *, MP_T *, int);
3143 extern MP_T *cexp_mp (NODE_T *, MP_T *, MP_T *, int);
3144 extern MP_T *cln_mp (NODE_T *, MP_T *, MP_T *, int);
3145 extern MP_T *cmul_mp (NODE_T *, MP_T *, MP_T *, MP_T *, MP_T *, int);
3146 extern MP_T *cos_mp (NODE_T *, MP_T *, MP_T *, int);
3147 extern MP_T *cosh_mp (NODE_T *, MP_T *, MP_T *, int);
3148 extern MP_T *csin_mp (NODE_T *, MP_T *, MP_T *, int);
3149 extern MP_T *csqrt_mp (NODE_T *, MP_T *, MP_T *, int);
3150 extern MP_T *ctan_mp (NODE_T *, MP_T *, MP_T *, int);
3151 extern MP_T *curt_mp (NODE_T *, MP_T *, MP_T *, int);
3152 extern MP_T *div_mp (NODE_T *, MP_T *, MP_T *, MP_T *, int);
3153 extern MP_T *div_mp_digit (NODE_T *, MP_T *, MP_T *, MP_T, int);
3154 extern MP_T *exp_mp (NODE_T *, MP_T *, MP_T *, int);
3155 extern MP_T *expm1_mp (NODE_T *, MP_T *, MP_T *, int);
3156 extern MP_T *hyp_mp (NODE_T *, MP_T *, MP_T *, MP_T *, int);
3157 extern MP_T *hypot_mp (NODE_T *, MP_T *, MP_T *, MP_T *, int);
3158 extern MP_T *int_to_mp (NODE_T *, MP_T *, int, int);
3159 extern MP_T *lengthen_mp (NODE_T *, MP_T *, int, MP_T *, int);
3160 extern MP_T *ln_mp (NODE_T *, MP_T *, MP_T *, int);
3161 extern MP_T *log_mp (NODE_T *, MP_T *, MP_T *, int);
3162 extern MP_T *mod_mp (NODE_T *, MP_T *, MP_T *, MP_T *, int);
3163 extern MP_T *mp_pi (NODE_T *, MP_T *, int, int);
3164 extern MP_T *mp_ten_up (NODE_T *, MP_T *, int, int);
3165 extern MP_T *mul_mp (NODE_T *, MP_T *, MP_T *, MP_T *, int);
3166 extern MP_T *mul_mp_digit (NODE_T *, MP_T *, MP_T *, MP_T, int);
3167 extern MP_T *over_mp (NODE_T *, MP_T *, MP_T *, MP_T *, int);
3168 extern MP_T *over_mp_digit (NODE_T *, MP_T *, MP_T *, MP_T, int);
3169 extern MP_T *pack_mp_bits (NODE_T *, MP_T *, unsigned *, MOID_T *);
3170 extern MP_T *pow_mp_int (NODE_T *, MP_T *, MP_T *, int, int);
3171 extern MP_T *real_to_mp (NODE_T *, MP_T *, double, int);
3172 extern MP_T *set_mp_short (MP_T *, MP_T, int, int);
3173 extern MP_T *shorten_mp (NODE_T *, MP_T *, int, MP_T *, int);
3174 extern MP_T *sin_mp (NODE_T *, MP_T *, MP_T *, int);
3175 extern MP_T *sinh_mp (NODE_T *, MP_T *, MP_T *, int);
3176 extern MP_T *sqrt_mp (NODE_T *, MP_T *, MP_T *, int);
3177 extern MP_T *string_to_mp (NODE_T *, MP_T *, char *, int);
3178 extern MP_T *sub_mp (NODE_T *, MP_T *, MP_T *, MP_T *, int);
3179 extern MP_T *tan_mp (NODE_T *, MP_T *, MP_T *, int);
3180 extern MP_T *tanh_mp (NODE_T *, MP_T *, MP_T *, int);
3181 extern MP_T *unsigned_to_mp (NODE_T *, MP_T *, unsigned, int);
3182 extern char *long_sub_fixed (NODE_T *, MP_T *, int, int, int);
3183 extern char *long_sub_whole (NODE_T *, MP_T *, int, int);
3184 extern double mp_to_real (NODE_T *, MP_T *, int);
3185 extern int get_mp_bits_width (MOID_T *);
3186 extern int get_mp_bits_words (MOID_T *);
3187 extern int int_to_mp_digits (int);
3188 extern int long_mp_digits (void);
3189 extern int longlong_mp_digits (void);
3190 extern int mp_to_int (NODE_T *, MP_T *, int);
3191 extern size_t size_long_mp (void);
3192 extern size_t size_longlong_mp (void);
3193 extern unsigned *stack_mp_bits (NODE_T *, MP_T *, MOID_T *);
3194 extern unsigned mp_to_unsigned (NODE_T *, MP_T *, int);
3195 extern void check_long_bits_value (NODE_T *, MP_T *, MOID_T *);
3196 extern void long_standardise (NODE_T *, MP_T *, int, int, int, int *);
3197 extern void raw_write_mp (char *, MP_T *, int);
3198 extern void set_longlong_mp_digits (int);
3199 extern void trunc_mp (NODE_T *, MP_T *, MP_T *, int);
3200 
3201 /* Standard prelude RTS */
3202 
3203 extern GPROC genie_abend;
3204 extern GPROC genie_abs_bits;
3205 extern GPROC genie_abs_bool;
3206 extern GPROC genie_abs_char;
3207 extern GPROC genie_abs_complex;
3208 extern GPROC genie_abs_int;
3209 extern GPROC genie_abs_long_complex;
3210 extern GPROC genie_abs_long_mp;
3211 extern GPROC genie_abs_real;
3212 extern GPROC genie_acos_long_complex;
3213 extern GPROC genie_acos_long_mp;
3214 extern GPROC genie_acronym;
3215 extern GPROC genie_add_bytes;
3216 extern GPROC genie_add_char;
3217 extern GPROC genie_add_complex;
3218 extern GPROC genie_add_int;
3219 extern GPROC genie_add_long_bytes;
3220 extern GPROC genie_add_long_complex;
3221 extern GPROC genie_add_long_int;
3222 extern GPROC genie_add_long_mp;
3223 extern GPROC genie_add_real;
3224 extern GPROC genie_add_string;
3225 extern GPROC genie_and_bits;
3226 extern GPROC genie_and_bool;
3227 extern GPROC genie_and_long_mp;
3228 extern GPROC genie_arccos_complex;
3229 extern GPROC genie_arccos_real;
3230 extern GPROC genie_arccosh_complex;
3231 extern GPROC genie_arccosh_long_mp;
3232 extern GPROC genie_arccosh_real;
3233 extern GPROC genie_arcsin_complex;
3234 extern GPROC genie_arcsin_real;
3235 extern GPROC genie_arcsinh_complex;
3236 extern GPROC genie_arcsinh_long_mp;
3237 extern GPROC genie_arcsinh_real;
3238 extern GPROC genie_arctan_complex;
3239 extern GPROC genie_arctan_real;
3240 extern GPROC genie_arctanh_complex;
3241 extern GPROC genie_arctanh_long_mp;
3242 extern GPROC genie_arctanh_real;
3243 extern GPROC genie_arg_complex;
3244 extern GPROC genie_arg_long_complex;
3245 extern GPROC genie_asin_long_complex;
3246 extern GPROC genie_asin_long_mp;
3247 extern GPROC genie_associate;
3248 extern GPROC genie_atan2_long_mp;
3249 extern GPROC genie_atan2_real;
3250 extern GPROC genie_atan_long_complex;
3251 extern GPROC genie_atan_long_mp;
3252 extern GPROC genie_backspace;
3253 extern GPROC genie_bin_int;
3254 extern GPROC genie_bin_long_mp;
3255 extern GPROC genie_bin_possible;
3256 extern GPROC genie_bits_lengths;
3257 extern GPROC genie_bits_pack;
3258 extern GPROC genie_bits_shorths;
3259 extern GPROC genie_bits_width;
3260 extern GPROC genie_blank_char;
3261 extern GPROC genie_block;
3262 extern GPROC genie_break;
3263 extern GPROC genie_bytes_lengths;
3264 extern GPROC genie_bytes_shorths;
3265 extern GPROC genie_bytes_width;
3266 extern GPROC genie_bytespack;
3267 extern GPROC genie_cd;
3268 extern GPROC genie_char_in_string;
3269 extern GPROC genie_clear_bits;
3270 extern GPROC genie_clear_long_bits;
3271 extern GPROC genie_clear_longlong_bits;
3272 extern GPROC genie_close;
3273 extern GPROC genie_complex_lengths;
3274 extern GPROC genie_complex_shorths;
3275 extern GPROC genie_compressible;
3276 extern GPROC genie_conj_complex;
3277 extern GPROC genie_conj_long_complex;
3278 extern GPROC genie_cos_complex;
3279 extern GPROC genie_cos_long_complex;
3280 extern GPROC genie_cos_long_mp;
3281 extern GPROC genie_cos_real;
3282 extern GPROC genie_cosh_complex;
3283 extern GPROC genie_cosh_long_mp;
3284 extern GPROC genie_cosh_real;
3285 extern GPROC genie_cputime;
3286 extern GPROC genie_create;
3287 extern GPROC genie_curt_long_mp;
3288 extern GPROC genie_curt_real;
3289 extern GPROC genie_debug;
3290 extern GPROC genie_directory;
3291 extern GPROC genie_div_complex;
3292 extern GPROC genie_div_int;
3293 extern GPROC genie_div_long_complex;
3294 extern GPROC genie_div_long_mp;
3295 extern GPROC genie_div_real;
3296 extern GPROC genie_divab_complex;
3297 extern GPROC genie_divab_long_complex;
3298 extern GPROC genie_divab_long_mp;
3299 extern GPROC genie_divab_real;
3300 extern GPROC genie_draw_possible;
3301 extern GPROC genie_dyad_elems;
3302 extern GPROC genie_dyad_lwb;
3303 extern GPROC genie_dyad_upb;
3304 extern GPROC genie_elem_bits;
3305 extern GPROC genie_elem_bytes;
3306 extern GPROC genie_elem_long_bits;
3307 extern GPROC genie_elem_long_bits;
3308 extern GPROC genie_elem_long_bytes;
3309 extern GPROC genie_elem_longlong_bits;
3310 extern GPROC genie_elem_string;
3311 extern GPROC genie_entier_long_mp;
3312 extern GPROC genie_entier_real;
3313 extern GPROC genie_eof;
3314 extern GPROC genie_eoln;
3315 extern GPROC genie_eq_bits;
3316 extern GPROC genie_eq_bool;
3317 extern GPROC genie_eq_bytes;
3318 extern GPROC genie_eq_char;
3319 extern GPROC genie_eq_complex;
3320 extern GPROC genie_eq_int;
3321 extern GPROC genie_eq_long_bytes;
3322 extern GPROC genie_eq_long_complex;
3323 extern GPROC genie_eq_long_mp;
3324 extern GPROC genie_eq_real;
3325 extern GPROC genie_eq_string;
3326 extern GPROC genie_erase;
3327 extern GPROC genie_erf_real;
3328 extern GPROC genie_erfc_real;
3329 extern GPROC genie_error_char;
3330 extern GPROC genie_establish;
3331 extern GPROC genie_evaluate;
3332 extern GPROC genie_exp_char;
3333 extern GPROC genie_exp_complex;
3334 extern GPROC genie_exp_long_complex;
3335 extern GPROC genie_exp_long_mp;
3336 extern GPROC genie_exp_real;
3337 extern GPROC genie_exp_width;
3338 extern GPROC genie_file_is_block_device;
3339 extern GPROC genie_file_is_char_device;
3340 extern GPROC genie_file_is_directory;
3341 extern GPROC genie_file_is_regular;
3342 extern GPROC genie_file_mode;
3343 extern GPROC genie_first_random;
3344 extern GPROC genie_fixed;
3345 extern GPROC genie_flip_char;
3346 extern GPROC genie_float;
3347 extern GPROC genie_flop_char;
3348 extern GPROC genie_formfeed_char;
3349 extern GPROC genie_garbage_collections;
3350 extern GPROC genie_garbage_freed;
3351 extern GPROC genie_garbage_seconds;
3352 extern GPROC genie_gc_heap;
3353 extern GPROC genie_ge_bits;
3354 extern GPROC genie_ge_bytes;
3355 extern GPROC genie_ge_char;
3356 extern GPROC genie_ge_int;
3357 extern GPROC genie_ge_long_bits;
3358 extern GPROC genie_ge_long_bytes;
3359 extern GPROC genie_ge_long_mp;
3360 extern GPROC genie_ge_real;
3361 extern GPROC genie_ge_string;
3362 extern GPROC genie_get_possible;
3363 extern GPROC genie_get_sound;
3364 extern GPROC genie_gt_bytes;
3365 extern GPROC genie_gt_char;
3366 extern GPROC genie_gt_int;
3367 extern GPROC genie_gt_long_bytes;
3368 extern GPROC genie_gt_long_mp;
3369 extern GPROC genie_gt_real;
3370 extern GPROC genie_gt_string;
3371 extern GPROC genie_icomplex;
3372 extern GPROC genie_idf;
3373 extern GPROC genie_idle;
3374 extern GPROC genie_iint_complex;
3375 extern GPROC genie_im_complex;
3376 extern GPROC genie_im_long_complex;
3377 extern GPROC genie_init_transput;
3378 extern GPROC genie_int_lengths;
3379 extern GPROC genie_int_shorths;
3380 extern GPROC genie_int_width;
3381 extern GPROC genie_inverf_real;
3382 extern GPROC genie_inverfc_real;
3383 extern GPROC genie_is_alnum;
3384 extern GPROC genie_is_alpha;
3385 extern GPROC genie_is_cntrl;
3386 extern GPROC genie_is_digit;
3387 extern GPROC genie_is_graph;
3388 extern GPROC genie_is_lower;
3389 extern GPROC genie_is_print;
3390 extern GPROC genie_is_punct;
3391 extern GPROC genie_is_space;
3392 extern GPROC genie_is_upper;
3393 extern GPROC genie_is_xdigit;
3394 extern GPROC genie_last_char_in_string;
3395 extern GPROC genie_le_bits;
3396 extern GPROC genie_le_bytes;
3397 extern GPROC genie_le_char;
3398 extern GPROC genie_le_int;
3399 extern GPROC genie_le_long_bits;
3400 extern GPROC genie_le_long_bytes;
3401 extern GPROC genie_le_long_mp;
3402 extern GPROC genie_le_real;
3403 extern GPROC genie_le_string;
3404 extern GPROC genie_leng_bytes;
3405 extern GPROC genie_lengthen_complex_to_long_complex;
3406 extern GPROC genie_lengthen_int_to_long_mp;
3407 extern GPROC genie_lengthen_long_complex_to_longlong_complex;
3408 extern GPROC genie_lengthen_long_mp_to_longlong_mp;
3409 extern GPROC genie_lengthen_real_to_long_mp;
3410 extern GPROC genie_lengthen_unsigned_to_long_mp;
3411 extern GPROC genie_lj_e_12_6;
3412 extern GPROC genie_lj_f_12_6;
3413 extern GPROC genie_ln_complex;
3414 extern GPROC genie_ln_long_complex;
3415 extern GPROC genie_ln_long_mp;
3416 extern GPROC genie_ln_real;
3417 extern GPROC genie_lock;
3418 extern GPROC genie_log_long_mp;
3419 extern GPROC genie_log_real;
3420 extern GPROC genie_long_bits_pack;
3421 extern GPROC genie_long_bits_width;
3422 extern GPROC genie_long_bytes_width;
3423 extern GPROC genie_long_bytespack;
3424 extern GPROC genie_long_exp_width;
3425 extern GPROC genie_long_int_width;
3426 extern GPROC genie_long_max_bits;
3427 extern GPROC genie_long_max_int;
3428 extern GPROC genie_long_max_real;
3429 extern GPROC genie_long_min_real;
3430 extern GPROC genie_long_next_random;
3431 extern GPROC genie_long_real_width;
3432 extern GPROC genie_long_small_real;
3433 extern GPROC genie_longlong_bits_width;
3434 extern GPROC genie_longlong_exp_width;
3435 extern GPROC genie_longlong_int_width;
3436 extern GPROC genie_longlong_max_bits;
3437 extern GPROC genie_longlong_max_int;
3438 extern GPROC genie_longlong_max_real;
3439 extern GPROC genie_longlong_min_real;
3440 extern GPROC genie_longlong_real_width;
3441 extern GPROC genie_longlong_small_real;
3442 extern GPROC genie_lt_bytes;
3443 extern GPROC genie_lt_char;
3444 extern GPROC genie_lt_int;
3445 extern GPROC genie_lt_long_bytes;
3446 extern GPROC genie_lt_long_mp;
3447 extern GPROC genie_lt_real;
3448 extern GPROC genie_lt_string;
3449 extern GPROC genie_make_term;
3450 extern GPROC genie_max_abs_char;
3451 extern GPROC genie_max_bits;
3452 extern GPROC genie_max_int;
3453 extern GPROC genie_max_real;
3454 extern GPROC genie_min_real;
3455 extern GPROC genie_minus_complex;
3456 extern GPROC genie_minus_int;
3457 extern GPROC genie_minus_long_complex;
3458 extern GPROC genie_minus_long_mp;
3459 extern GPROC genie_minus_real;
3460 extern GPROC genie_minusab_complex;
3461 extern GPROC genie_minusab_int;
3462 extern GPROC genie_minusab_long_complex;
3463 extern GPROC genie_minusab_long_int;
3464 extern GPROC genie_minusab_long_mp;
3465 extern GPROC genie_minusab_real;
3466 extern GPROC genie_mod_int;
3467 extern GPROC genie_mod_long_mp;
3468 extern GPROC genie_modab_int;
3469 extern GPROC genie_modab_long_mp;
3470 extern GPROC genie_monad_elems;
3471 extern GPROC genie_monad_lwb;
3472 extern GPROC genie_monad_upb;
3473 extern GPROC genie_mul_complex;
3474 extern GPROC genie_mul_int;
3475 extern GPROC genie_mul_long_complex;
3476 extern GPROC genie_mul_long_int;
3477 extern GPROC genie_mul_long_mp;
3478 extern GPROC genie_mul_real;
3479 extern GPROC genie_ne_bits;
3480 extern GPROC genie_ne_bool;
3481 extern GPROC genie_ne_bytes;
3482 extern GPROC genie_ne_char;
3483 extern GPROC genie_ne_complex;
3484 extern GPROC genie_ne_int;
3485 extern GPROC genie_ne_long_bytes;
3486 extern GPROC genie_ne_long_complex;
3487 extern GPROC genie_ne_long_mp;
3488 extern GPROC genie_ne_real;
3489 extern GPROC genie_ne_string;
3490 extern GPROC genie_new_line;
3491 extern GPROC genie_new_page;
3492 extern GPROC genie_new_sound;
3493 extern GPROC genie_newline_char;
3494 extern GPROC genie_next_random;
3495 extern GPROC genie_next_rnd;
3496 extern GPROC genie_not_bits;
3497 extern GPROC genie_not_bool;
3498 extern GPROC genie_not_long_mp;
3499 extern GPROC genie_null_char;
3500 extern GPROC genie_odd_int;
3501 extern GPROC genie_odd_long_mp;
3502 extern GPROC genie_on_file_end;
3503 extern GPROC genie_on_format_end;
3504 extern GPROC genie_on_format_error;
3505 extern GPROC genie_on_gc_event;
3506 extern GPROC genie_on_line_end;
3507 extern GPROC genie_on_open_error;
3508 extern GPROC genie_on_page_end;
3509 extern GPROC genie_on_transput_error;
3510 extern GPROC genie_on_value_error;
3511 extern GPROC genie_open;
3512 extern GPROC genie_or_bits;
3513 extern GPROC genie_or_bool;
3514 extern GPROC genie_or_long_mp;
3515 extern GPROC genie_over_int;
3516 extern GPROC genie_over_long_mp;
3517 extern GPROC genie_overab_int;
3518 extern GPROC genie_overab_long_mp;
3519 extern GPROC genie_pi;
3520 extern GPROC genie_pi_long_mp;
3521 extern GPROC genie_plusab_bytes;
3522 extern GPROC genie_plusab_complex;
3523 extern GPROC genie_plusab_int;
3524 extern GPROC genie_plusab_long_bytes;
3525 extern GPROC genie_plusab_long_complex;
3526 extern GPROC genie_plusab_long_int;
3527 extern GPROC genie_plusab_long_mp;
3528 extern GPROC genie_plusab_real;
3529 extern GPROC genie_plusab_string;
3530 extern GPROC genie_plusto_bytes;
3531 extern GPROC genie_plusto_long_bytes;
3532 extern GPROC genie_plusto_string;
3533 extern GPROC genie_pow_complex_int;
3534 extern GPROC genie_pow_int;
3535 extern GPROC genie_pow_long_complex_int;
3536 extern GPROC genie_pow_long_mp;
3537 extern GPROC genie_pow_long_mp_int;
3538 extern GPROC genie_pow_long_mp_int_int;
3539 extern GPROC genie_pow_real;
3540 extern GPROC genie_pow_real_int;
3541 extern GPROC genie_preemptive_gc_heap;
3542 extern GPROC genie_print_bits;
3543 extern GPROC genie_print_bool;
3544 extern GPROC genie_print_char;
3545 extern GPROC genie_print_complex;
3546 extern GPROC genie_print_int;
3547 extern GPROC genie_print_long_bits;
3548 extern GPROC genie_print_long_complex;
3549 extern GPROC genie_print_long_int;
3550 extern GPROC genie_print_long_real;
3551 extern GPROC genie_print_longlong_bits;
3552 extern GPROC genie_print_longlong_complex;
3553 extern GPROC genie_print_longlong_int;
3554 extern GPROC genie_print_longlong_real;
3555 extern GPROC genie_print_real;
3556 extern GPROC genie_print_string;
3557 extern GPROC genie_put_bits;
3558 extern GPROC genie_put_bool;
3559 extern GPROC genie_put_char;
3560 extern GPROC genie_put_complex;
3561 extern GPROC genie_put_int;
3562 extern GPROC genie_put_string;
3563 extern GPROC genie_put_long_bits;
3564 extern GPROC genie_put_long_complex;
3565 extern GPROC genie_put_long_int;
3566 extern GPROC genie_put_long_real;
3567 extern GPROC genie_put_longlong_bits;
3568 extern GPROC genie_put_longlong_complex;
3569 extern GPROC genie_put_longlong_int;
3570 extern GPROC genie_put_longlong_real;
3571 extern GPROC genie_put_real;
3572 extern GPROC genie_print_string;
3573 extern GPROC genie_program_idf;
3574 extern GPROC genie_put_possible;
3575 extern GPROC genie_pwd;
3576 extern GPROC genie_re_complex;
3577 extern GPROC genie_re_long_complex;
3578 extern GPROC genie_read;
3579 extern GPROC genie_read_bin;
3580 extern GPROC genie_read_bin_file;
3581 extern GPROC genie_read_bits;
3582 extern GPROC genie_read_bool;
3583 extern GPROC genie_read_char;
3584 extern GPROC genie_read_complex;
3585 extern GPROC genie_read_file;
3586 extern GPROC genie_read_file_format;
3587 extern GPROC genie_read_format;
3588 extern GPROC genie_read_int;
3589 extern GPROC genie_read_long_bits;
3590 extern GPROC genie_read_long_complex;
3591 extern GPROC genie_read_long_int;
3592 extern GPROC genie_read_long_real;
3593 extern GPROC genie_read_longlong_bits;
3594 extern GPROC genie_read_longlong_complex;
3595 extern GPROC genie_read_longlong_int;
3596 extern GPROC genie_read_longlong_real;
3597 extern GPROC genie_read_real;
3598 extern GPROC genie_read_string;
3599 extern GPROC genie_get_bits;
3600 extern GPROC genie_get_bool;
3601 extern GPROC genie_get_char;
3602 extern GPROC genie_get_complex;
3603 extern GPROC genie_get_int;
3604 extern GPROC genie_get_long_bits;
3605 extern GPROC genie_get_long_complex;
3606 extern GPROC genie_get_long_int;
3607 extern GPROC genie_get_long_real;
3608 extern GPROC genie_get_longlong_bits;
3609 extern GPROC genie_get_longlong_complex;
3610 extern GPROC genie_get_longlong_int;
3611 extern GPROC genie_get_longlong_real;
3612 extern GPROC genie_get_real;
3613 extern GPROC genie_get_string;
3614 extern GPROC genie_read_line;
3615 extern GPROC genie_real;
3616 extern GPROC genie_real_lengths;
3617 extern GPROC genie_real_shorths;
3618 extern GPROC genie_real_width;
3619 extern GPROC genie_reidf_possible;
3620 extern GPROC genie_repr_char;
3621 extern GPROC genie_reset;
3622 extern GPROC genie_reset_possible;
3623 extern GPROC genie_round_long_mp;
3624 extern GPROC genie_round_real;
3625 extern GPROC genie_set;
3626 extern GPROC genie_set_bits;
3627 extern GPROC genie_set_long_bits;
3628 extern GPROC genie_set_longlong_bits;
3629 extern GPROC genie_set_possible;
3630 extern GPROC genie_set_sound;
3631 extern GPROC genie_set_return_code;
3632 extern GPROC genie_shl_bits;
3633 extern GPROC genie_shl_long_mp;
3634 extern GPROC genie_shorten_bytes;
3635 extern GPROC genie_shorten_long_complex_to_complex;
3636 extern GPROC genie_shorten_long_mp_to_bits;
3637 extern GPROC genie_shorten_long_mp_to_int;
3638 extern GPROC genie_shorten_long_mp_to_real;
3639 extern GPROC genie_shorten_longlong_complex_to_long_complex;
3640 extern GPROC genie_shorten_longlong_mp_to_long_mp;
3641 extern GPROC genie_shr_bits;
3642 extern GPROC genie_shr_long_mp;
3643 extern GPROC genie_sign_int;
3644 extern GPROC genie_sign_long_mp;
3645 extern GPROC genie_sign_real;
3646 extern GPROC genie_sin_complex;
3647 extern GPROC genie_sin_long_complex;
3648 extern GPROC genie_sin_long_mp;
3649 extern GPROC genie_sin_real;
3650 extern GPROC genie_sinh_complex;
3651 extern GPROC genie_sinh_long_mp;
3652 extern GPROC genie_sinh_real;
3653 extern GPROC genie_sleep;
3654 extern GPROC genie_small_real;
3655 extern GPROC genie_sort_row_string;
3656 extern GPROC genie_sound_channels;
3657 extern GPROC genie_sound_rate;
3658 extern GPROC genie_sound_resolution;
3659 extern GPROC genie_sound_samples;
3660 extern GPROC genie_space;
3661 extern GPROC genie_sqrt_complex;
3662 extern GPROC genie_sqrt_long_complex;
3663 extern GPROC genie_sqrt_long_mp;
3664 extern GPROC genie_sqrt_real;
3665 extern GPROC genie_stack_pointer;
3666 extern GPROC genie_stand_back;
3667 extern GPROC genie_stand_back_channel;
3668 extern GPROC genie_stand_draw_channel;
3669 extern GPROC genie_stand_error;
3670 extern GPROC genie_stand_error_channel;
3671 extern GPROC genie_stand_in;
3672 extern GPROC genie_stand_in_channel;
3673 extern GPROC genie_stand_out;
3674 extern GPROC genie_stand_out_channel;
3675 extern GPROC genie_string_in_string;
3676 extern GPROC genie_sub_complex;
3677 extern GPROC genie_sub_int;
3678 extern GPROC genie_sub_long_complex;
3679 extern GPROC genie_sub_long_int;
3680 extern GPROC genie_sub_long_mp;
3681 extern GPROC genie_sub_real;
3682 extern GPROC genie_system;
3683 extern GPROC genie_system_heap_pointer;
3684 extern GPROC genie_system_stack_pointer;
3685 extern GPROC genie_system_stack_size;
3686 extern GPROC genie_tab_char;
3687 extern GPROC genie_tan_complex;
3688 extern GPROC genie_tan_long_complex;
3689 extern GPROC genie_tan_long_mp;
3690 extern GPROC genie_tan_real;
3691 extern GPROC genie_tanh_complex;
3692 extern GPROC genie_tanh_long_mp;
3693 extern GPROC genie_tanh_real;
3694 extern GPROC genie_term;
3695 extern GPROC genie_times_char_int;
3696 extern GPROC genie_times_int_char;
3697 extern GPROC genie_times_int_string;
3698 extern GPROC genie_times_string_int;
3699 extern GPROC genie_timesab_complex;
3700 extern GPROC genie_timesab_int;
3701 extern GPROC genie_timesab_long_complex;
3702 extern GPROC genie_timesab_long_int;
3703 extern GPROC genie_timesab_long_mp;
3704 extern GPROC genie_timesab_real;
3705 extern GPROC genie_timesab_string;
3706 extern GPROC genie_to_lower;
3707 extern GPROC genie_to_upper;
3708 extern GPROC genie_unimplemented;
3709 extern GPROC genie_whole;
3710 extern GPROC genie_write;
3711 extern GPROC genie_write_bin;
3712 extern GPROC genie_write_bin_file;
3713 extern GPROC genie_write_file;
3714 extern GPROC genie_write_file_format;
3715 extern GPROC genie_write_format;
3716 extern GPROC genie_xor_bits;
3717 extern GPROC genie_xor_bool;
3718 extern GPROC genie_xor_long_mp;
3719 
3720 #if defined __S_IFIFO
3721 extern GPROC genie_file_is_fifo;
3722 #endif
3723 
3724 #if defined __S_IFLNK
3725 extern GPROC genie_file_is_link;
3726 #endif
3727 
3728 #if defined HAVE_PARALLEL_CLAUSE
3729 extern GPROC genie_down_sema;
3730 extern GPROC genie_level_int_sema;
3731 extern GPROC genie_level_sema_int;
3732 extern GPROC genie_up_sema;
3733 #endif
3734 
3735 #if defined HAVE_HTTP
3736 extern GPROC genie_http_content;
3737 extern GPROC genie_tcp_request;
3738 #endif
3739 
3740 #if defined HAVE_REGEX_H
3741 extern GPROC genie_grep_in_string;
3742 extern GPROC genie_grep_in_substring;
3743 extern GPROC genie_sub_in_string;
3744 #endif
3745 
3746 /* Constants ex GSL */
3747 
3748 extern GPROC genie_cgs_acre;
3749 extern GPROC genie_cgs_angstrom;
3750 extern GPROC genie_cgs_astronomical_unit;
3751 extern GPROC genie_cgs_bar;
3752 extern GPROC genie_cgs_barn;
3753 extern GPROC genie_cgs_bohr_magneton;
3754 extern GPROC genie_cgs_bohr_radius;
3755 extern GPROC genie_cgs_boltzmann;
3756 extern GPROC genie_cgs_btu;
3757 extern GPROC genie_cgs_calorie;
3758 extern GPROC genie_cgs_canadian_gallon;
3759 extern GPROC genie_cgs_carat;
3760 extern GPROC genie_cgs_cup;
3761 extern GPROC genie_cgs_curie;
3762 extern GPROC genie_cgs_day;
3763 extern GPROC genie_cgs_dyne;
3764 extern GPROC genie_cgs_electron_charge;
3765 extern GPROC genie_cgs_electron_magnetic_moment;
3766 extern GPROC genie_cgs_electron_volt;
3767 extern GPROC genie_cgs_erg;
3768 extern GPROC genie_cgs_faraday;
3769 extern GPROC genie_cgs_fathom;
3770 extern GPROC genie_cgs_fluid_ounce;
3771 extern GPROC genie_cgs_foot;
3772 extern GPROC genie_cgs_footcandle;
3773 extern GPROC genie_cgs_footlambert;
3774 extern GPROC genie_cgs_gauss;
3775 extern GPROC genie_cgs_gram_force;
3776 extern GPROC genie_cgs_grav_accel;
3777 extern GPROC genie_cgs_gravitational_constant;
3778 extern GPROC genie_cgs_hectare;
3779 extern GPROC genie_cgs_horsepower;
3780 extern GPROC genie_cgs_hour;
3781 extern GPROC genie_cgs_inch;
3782 extern GPROC genie_cgs_inch_of_mercury;
3783 extern GPROC genie_cgs_inch_of_water;
3784 extern GPROC genie_cgs_joule;
3785 extern GPROC genie_cgs_kilometers_per_hour;
3786 extern GPROC genie_cgs_kilopound_force;
3787 extern GPROC genie_cgs_knot;
3788 extern GPROC genie_cgs_lambert;
3789 extern GPROC genie_cgs_light_year;
3790 extern GPROC genie_cgs_liter;
3791 extern GPROC genie_cgs_lumen;
3792 extern GPROC genie_cgs_lux;
3793 extern GPROC genie_cgs_mass_electron;
3794 extern GPROC genie_cgs_mass_muon;
3795 extern GPROC genie_cgs_mass_neutron;
3796 extern GPROC genie_cgs_mass_proton;
3797 extern GPROC genie_cgs_meter_of_mercury;
3798 extern GPROC genie_cgs_metric_ton;
3799 extern GPROC genie_cgs_micron;
3800 extern GPROC genie_cgs_mil;
3801 extern GPROC genie_cgs_mile;
3802 extern GPROC genie_cgs_miles_per_hour;
3803 extern GPROC genie_cgs_minute;
3804 extern GPROC genie_cgs_molar_gas;
3805 extern GPROC genie_cgs_nautical_mile;
3806 extern GPROC genie_cgs_newton;
3807 extern GPROC genie_cgs_nuclear_magneton;
3808 extern GPROC genie_cgs_ounce_mass;
3809 extern GPROC genie_cgs_parsec;
3810 extern GPROC genie_cgs_phot;
3811 extern GPROC genie_cgs_pint;
3812 extern GPROC genie_cgs_planck_constant_h;
3813 extern GPROC genie_cgs_planck_constant_hbar;
3814 extern GPROC genie_cgs_point;
3815 extern GPROC genie_cgs_poise;
3816 extern GPROC genie_cgs_pound_force;
3817 extern GPROC genie_cgs_pound_mass;
3818 extern GPROC genie_cgs_poundal;
3819 extern GPROC genie_cgs_proton_magnetic_moment;
3820 extern GPROC genie_cgs_psi;
3821 extern GPROC genie_cgs_quart;
3822 extern GPROC genie_cgs_rad;
3823 extern GPROC genie_cgs_roentgen;
3824 extern GPROC genie_cgs_rydberg;
3825 extern GPROC genie_cgs_solar_mass;
3826 extern GPROC genie_cgs_speed_of_light;
3827 extern GPROC genie_cgs_standard_gas_volume;
3828 extern GPROC genie_cgs_std_atmosphere;
3829 extern GPROC genie_cgs_stilb;
3830 extern GPROC genie_cgs_stokes;
3831 extern GPROC genie_cgs_tablespoon;
3832 extern GPROC genie_cgs_teaspoon;
3833 extern GPROC genie_cgs_texpoint;
3834 extern GPROC genie_cgs_therm;
3835 extern GPROC genie_cgs_ton;
3836 extern GPROC genie_cgs_torr;
3837 extern GPROC genie_cgs_troy_ounce;
3838 extern GPROC genie_cgs_uk_gallon;
3839 extern GPROC genie_cgs_uk_ton;
3840 extern GPROC genie_cgs_unified_atomic_mass;
3841 extern GPROC genie_cgs_us_gallon;
3842 extern GPROC genie_cgs_week;
3843 extern GPROC genie_cgs_yard;
3844 extern GPROC genie_mks_acre;
3845 extern GPROC genie_mks_angstrom;
3846 extern GPROC genie_mks_astronomical_unit;
3847 extern GPROC genie_mks_bar;
3848 extern GPROC genie_mks_barn;
3849 extern GPROC genie_mks_bohr_magneton;
3850 extern GPROC genie_mks_bohr_radius;
3851 extern GPROC genie_mks_boltzmann;
3852 extern GPROC genie_mks_btu;
3853 extern GPROC genie_mks_calorie;
3854 extern GPROC genie_mks_canadian_gallon;
3855 extern GPROC genie_mks_carat;
3856 extern GPROC genie_mks_cup;
3857 extern GPROC genie_mks_curie;
3858 extern GPROC genie_mks_day;
3859 extern GPROC genie_mks_dyne;
3860 extern GPROC genie_mks_electron_charge;
3861 extern GPROC genie_mks_electron_magnetic_moment;
3862 extern GPROC genie_mks_electron_volt;
3863 extern GPROC genie_mks_erg;
3864 extern GPROC genie_mks_faraday;
3865 extern GPROC genie_mks_fathom;
3866 extern GPROC genie_mks_fluid_ounce;
3867 extern GPROC genie_mks_foot;
3868 extern GPROC genie_mks_footcandle;
3869 extern GPROC genie_mks_footlambert;
3870 extern GPROC genie_mks_gauss;
3871 extern GPROC genie_mks_gram_force;
3872 extern GPROC genie_mks_grav_accel;
3873 extern GPROC genie_mks_gravitational_constant;
3874 extern GPROC genie_mks_hectare;
3875 extern GPROC genie_mks_horsepower;
3876 extern GPROC genie_mks_hour;
3877 extern GPROC genie_mks_inch;
3878 extern GPROC genie_mks_inch_of_mercury;
3879 extern GPROC genie_mks_inch_of_water;
3880 extern GPROC genie_mks_joule;
3881 extern GPROC genie_mks_kilometers_per_hour;
3882 extern GPROC genie_mks_kilopound_force;
3883 extern GPROC genie_mks_knot;
3884 extern GPROC genie_mks_lambert;
3885 extern GPROC genie_mks_light_year;
3886 extern GPROC genie_mks_liter;
3887 extern GPROC genie_mks_lumen;
3888 extern GPROC genie_mks_lux;
3889 extern GPROC genie_mks_mass_electron;
3890 extern GPROC genie_mks_mass_muon;
3891 extern GPROC genie_mks_mass_neutron;
3892 extern GPROC genie_mks_mass_proton;
3893 extern GPROC genie_mks_meter_of_mercury;
3894 extern GPROC genie_mks_metric_ton;
3895 extern GPROC genie_mks_micron;
3896 extern GPROC genie_mks_mil;
3897 extern GPROC genie_mks_mile;
3898 extern GPROC genie_mks_miles_per_hour;
3899 extern GPROC genie_mks_minute;
3900 extern GPROC genie_mks_molar_gas;
3901 extern GPROC genie_mks_nautical_mile;
3902 extern GPROC genie_mks_newton;
3903 extern GPROC genie_mks_nuclear_magneton;
3904 extern GPROC genie_mks_ounce_mass;
3905 extern GPROC genie_mks_parsec;
3906 extern GPROC genie_mks_phot;
3907 extern GPROC genie_mks_pint;
3908 extern GPROC genie_mks_planck_constant_h;
3909 extern GPROC genie_mks_planck_constant_hbar;
3910 extern GPROC genie_mks_point;
3911 extern GPROC genie_mks_poise;
3912 extern GPROC genie_mks_pound_force;
3913 extern GPROC genie_mks_pound_mass;
3914 extern GPROC genie_mks_poundal;
3915 extern GPROC genie_mks_proton_magnetic_moment;
3916 extern GPROC genie_mks_psi;
3917 extern GPROC genie_mks_quart;
3918 extern GPROC genie_mks_rad;
3919 extern GPROC genie_mks_roentgen;
3920 extern GPROC genie_mks_rydberg;
3921 extern GPROC genie_mks_solar_mass;
3922 extern GPROC genie_mks_speed_of_light;
3923 extern GPROC genie_mks_standard_gas_volume;
3924 extern GPROC genie_mks_std_atmosphere;
3925 extern GPROC genie_mks_stilb;
3926 extern GPROC genie_mks_stokes;
3927 extern GPROC genie_mks_tablespoon;
3928 extern GPROC genie_mks_teaspoon;
3929 extern GPROC genie_mks_texpoint;
3930 extern GPROC genie_mks_therm;
3931 extern GPROC genie_mks_ton;
3932 extern GPROC genie_mks_torr;
3933 extern GPROC genie_mks_troy_ounce;
3934 extern GPROC genie_mks_uk_gallon;
3935 extern GPROC genie_mks_uk_ton;
3936 extern GPROC genie_mks_unified_atomic_mass;
3937 extern GPROC genie_mks_us_gallon;
3938 extern GPROC genie_mks_vacuum_permeability;
3939 extern GPROC genie_mks_vacuum_permittivity;
3940 extern GPROC genie_mks_week;
3941 extern GPROC genie_mks_yard;
3942 extern GPROC genie_num_atto;
3943 extern GPROC genie_num_avogadro;
3944 extern GPROC genie_num_exa;
3945 extern GPROC genie_num_femto;
3946 extern GPROC genie_num_fine_structure;
3947 extern GPROC genie_num_giga;
3948 extern GPROC genie_num_kilo;
3949 extern GPROC genie_num_mega;
3950 extern GPROC genie_num_micro;
3951 extern GPROC genie_num_milli;
3952 extern GPROC genie_num_nano;
3953 extern GPROC genie_num_peta;
3954 extern GPROC genie_num_pico;
3955 extern GPROC genie_num_tera;
3956 extern GPROC genie_num_yocto;
3957 extern GPROC genie_num_yotta;
3958 extern GPROC genie_num_zepto;
3959 extern GPROC genie_num_zetta;
3960 
3961 #if defined HAVE_GNU_PLOTUTILS
3962 extern GPROC genie_draw_aspect;
3963 extern GPROC genie_draw_atom;
3964 extern GPROC genie_draw_background_colour;
3965 extern GPROC genie_draw_background_colour_name;
3966 extern GPROC genie_draw_circle;
3967 extern GPROC genie_draw_clear;
3968 extern GPROC genie_draw_colour;
3969 extern GPROC genie_draw_colour_name;
3970 extern GPROC genie_draw_fillstyle;
3971 extern GPROC genie_draw_fontname;
3972 extern GPROC genie_draw_fontsize;
3973 extern GPROC genie_draw_get_colour_name;
3974 extern GPROC genie_draw_line;
3975 extern GPROC genie_draw_linestyle;
3976 extern GPROC genie_draw_linewidth;
3977 extern GPROC genie_draw_move;
3978 extern GPROC genie_draw_point;
3979 extern GPROC genie_draw_rect;
3980 extern GPROC genie_draw_show;
3981 extern GPROC genie_draw_star;
3982 extern GPROC genie_draw_text;
3983 extern GPROC genie_draw_textangle;
3984 extern GPROC genie_make_device;
3985 #endif
3986 
3987 #if defined HAVE_GNU_GSL
3988 extern GPROC genie_airy_ai_deriv_real;
3989 extern GPROC genie_airy_ai_real;
3990 extern GPROC genie_airy_bi_deriv_real;
3991 extern GPROC genie_airy_bi_real;
3992 extern GPROC genie_bessel_exp_il_real;
3993 extern GPROC genie_bessel_exp_in_real;
3994 extern GPROC genie_bessel_exp_inu_real;
3995 extern GPROC genie_bessel_exp_kl_real;
3996 extern GPROC genie_bessel_exp_kn_real;
3997 extern GPROC genie_bessel_exp_knu_real;
3998 extern GPROC genie_bessel_in_real;
3999 extern GPROC genie_bessel_inu_real;
4000 extern GPROC genie_bessel_jl_real;
4001 extern GPROC genie_bessel_jn_real;
4002 extern GPROC genie_bessel_jnu_real;
4003 extern GPROC genie_bessel_kn_real;
4004 extern GPROC genie_bessel_knu_real;
4005 extern GPROC genie_bessel_yl_real;
4006 extern GPROC genie_bessel_yn_real;
4007 extern GPROC genie_bessel_ynu_real;
4008 extern GPROC genie_beta_inc_real;
4009 extern GPROC genie_beta_real;
4010 extern GPROC genie_complex_scale_matrix_complex;
4011 extern GPROC genie_complex_scale_vector_complex;
4012 extern GPROC genie_elliptic_integral_e_real;
4013 extern GPROC genie_elliptic_integral_k_real;
4014 extern GPROC genie_elliptic_integral_rc_real;
4015 extern GPROC genie_elliptic_integral_rd_real;
4016 extern GPROC genie_elliptic_integral_rf_real;
4017 extern GPROC genie_elliptic_integral_rj_real;
4018 extern GPROC genie_factorial_real;
4019 extern GPROC genie_fft_backward;
4020 extern GPROC genie_fft_complex_backward;
4021 extern GPROC genie_fft_complex_forward;
4022 extern GPROC genie_fft_complex_inverse;
4023 extern GPROC genie_fft_forward;
4024 extern GPROC genie_fft_inverse;
4025 extern GPROC genie_gamma_inc_real;
4026 extern GPROC genie_gamma_real;
4027 extern GPROC genie_laplace;
4028 extern GPROC genie_lngamma_real;
4029 extern GPROC genie_matrix_add;
4030 extern GPROC genie_matrix_ch;
4031 extern GPROC genie_matrix_ch_solve;
4032 extern GPROC genie_matrix_complex_add;
4033 extern GPROC genie_matrix_complex_det;
4034 extern GPROC genie_matrix_complex_div_complex;
4035 extern GPROC genie_matrix_complex_div_complex_ab;
4036 extern GPROC genie_matrix_complex_echo;
4037 extern GPROC genie_matrix_complex_eq;
4038 extern GPROC genie_matrix_complex_inv;
4039 extern GPROC genie_matrix_complex_lu;
4040 extern GPROC genie_matrix_complex_lu_det;
4041 extern GPROC genie_matrix_complex_lu_inv;
4042 extern GPROC genie_matrix_complex_lu_solve;
4043 extern GPROC genie_matrix_complex_minus;
4044 extern GPROC genie_matrix_complex_minusab;
4045 extern GPROC genie_matrix_complex_ne;
4046 extern GPROC genie_matrix_complex_plusab;
4047 extern GPROC genie_matrix_complex_scale_complex;
4048 extern GPROC genie_matrix_complex_scale_complex_ab;
4049 extern GPROC genie_matrix_complex_sub;
4050 extern GPROC genie_matrix_complex_times_matrix;
4051 extern GPROC genie_matrix_complex_times_vector;
4052 extern GPROC genie_matrix_complex_trace;
4053 extern GPROC genie_matrix_complex_transpose;
4054 extern GPROC genie_matrix_det;
4055 extern GPROC genie_matrix_div_real;
4056 extern GPROC genie_matrix_div_real_ab;
4057 extern GPROC genie_matrix_echo;
4058 extern GPROC genie_matrix_eq;
4059 extern GPROC genie_matrix_inv;
4060 extern GPROC genie_matrix_lu;
4061 extern GPROC genie_matrix_lu_det;
4062 extern GPROC genie_matrix_lu_inv;
4063 extern GPROC genie_matrix_lu_solve;
4064 extern GPROC genie_matrix_minus;
4065 extern GPROC genie_matrix_minusab;
4066 extern GPROC genie_matrix_ne;
4067 extern GPROC genie_matrix_plusab;
4068 extern GPROC genie_matrix_qr;
4069 extern GPROC genie_matrix_qr_ls_solve;
4070 extern GPROC genie_matrix_qr_solve;
4071 extern GPROC genie_matrix_scale_real;
4072 extern GPROC genie_matrix_scale_real_ab;
4073 extern GPROC genie_matrix_sub;
4074 extern GPROC genie_matrix_svd;
4075 extern GPROC genie_matrix_svd_solve;
4076 extern GPROC genie_matrix_times_matrix;
4077 extern GPROC genie_matrix_times_vector;
4078 extern GPROC genie_matrix_trace;
4079 extern GPROC genie_matrix_transpose;
4080 extern GPROC genie_prime_factors;
4081 extern GPROC genie_real_scale_matrix;
4082 extern GPROC genie_real_scale_vector;
4083 extern GPROC genie_vector_add;
4084 extern GPROC genie_vector_complex_add;
4085 extern GPROC genie_vector_complex_div_complex;
4086 extern GPROC genie_vector_complex_div_complex_ab;
4087 extern GPROC genie_vector_complex_dot;
4088 extern GPROC genie_vector_complex_dyad;
4089 extern GPROC genie_vector_complex_echo;
4090 extern GPROC genie_vector_complex_eq;
4091 extern GPROC genie_vector_complex_minus;
4092 extern GPROC genie_vector_complex_minusab;
4093 extern GPROC genie_vector_complex_ne;
4094 extern GPROC genie_vector_complex_norm;
4095 extern GPROC genie_vector_complex_plusab;
4096 extern GPROC genie_vector_complex_scale_complex;
4097 extern GPROC genie_vector_complex_scale_complex_ab;
4098 extern GPROC genie_vector_complex_sub;
4099 extern GPROC genie_vector_complex_times_matrix;
4100 extern GPROC genie_vector_div_real;
4101 extern GPROC genie_vector_div_real_ab;
4102 extern GPROC genie_vector_dot;
4103 extern GPROC genie_vector_dyad;
4104 extern GPROC genie_vector_echo;
4105 extern GPROC genie_vector_eq;
4106 extern GPROC genie_vector_minus;
4107 extern GPROC genie_vector_minusab;
4108 extern GPROC genie_vector_ne;
4109 extern GPROC genie_vector_norm;
4110 extern GPROC genie_vector_plusab;
4111 extern GPROC genie_vector_scale_real;
4112 extern GPROC genie_vector_scale_real_ab;
4113 extern GPROC genie_vector_sub;
4114 extern GPROC genie_vector_times_matrix;
4115 #endif
4116 
4117 #if defined HAVE_CURSES
4118 extern GPROC genie_curses_clear;
4119 extern GPROC genie_curses_del_char;
4120 extern GPROC genie_curses_green;
4121 extern GPROC genie_curses_cyan;
4122 extern GPROC genie_curses_white;
4123 extern GPROC genie_curses_red;
4124 extern GPROC genie_curses_yellow;
4125 extern GPROC genie_curses_magenta;
4126 extern GPROC genie_curses_blue;
4127 extern GPROC genie_curses_green_inverse;
4128 extern GPROC genie_curses_cyan_inverse;
4129 extern GPROC genie_curses_white_inverse;
4130 extern GPROC genie_curses_red_inverse;
4131 extern GPROC genie_curses_yellow_inverse;
4132 extern GPROC genie_curses_magenta_inverse;
4133 extern GPROC genie_curses_blue_inverse;
4134 extern GPROC genie_curses_columns;
4135 extern GPROC genie_curses_end;
4136 extern GPROC genie_curses_getchar;
4137 extern GPROC genie_curses_lines;
4138 extern GPROC genie_curses_move;
4139 extern GPROC genie_curses_putchar;
4140 extern GPROC genie_curses_refresh;
4141 extern GPROC genie_curses_start;
4142 #endif
4143 
4144 #if defined HAVE_POSTGRESQL
4145 extern GPROC genie_pq_backendpid;
4146 extern GPROC genie_pq_cmdstatus;
4147 extern GPROC genie_pq_cmdtuples;
4148 extern GPROC genie_pq_connectdb;
4149 extern GPROC genie_pq_db;
4150 extern GPROC genie_pq_errormessage;
4151 extern GPROC genie_pq_exec;
4152 extern GPROC genie_pq_fformat;
4153 extern GPROC genie_pq_finish;
4154 extern GPROC genie_pq_fname;
4155 extern GPROC genie_pq_fnumber;
4156 extern GPROC genie_pq_getisnull;
4157 extern GPROC genie_pq_getvalue;
4158 extern GPROC genie_pq_host;
4159 extern GPROC genie_pq_nfields;
4160 extern GPROC genie_pq_ntuples;
4161 extern GPROC genie_pq_options;
4162 extern GPROC genie_pq_parameterstatus;
4163 extern GPROC genie_pq_pass;
4164 extern GPROC genie_pq_port;
4165 extern GPROC genie_pq_protocolversion;
4166 extern GPROC genie_pq_reset;
4167 extern GPROC genie_pq_resulterrormessage;
4168 extern GPROC genie_pq_serverversion;
4169 extern GPROC genie_pq_socket;
4170 extern GPROC genie_pq_tty;
4171 extern GPROC genie_pq_user;
4172 #endif
4173 
4174 /********************/
4175 /* Diagnostic texts */
4176 /********************/
4177 
4178 #define ERROR_ACCESSING_NIL "attempt to access N"
4179 #define ERROR_ALIGNMENT "alignment error"
4180 #define ERROR_ARGUMENT_NUMBER "incorrect number of arguments for M"
4181 #define ERROR_CANNOT_OPEN_NAME "cannot open Z"
4182 #define ERROR_CANNOT_WIDEN "cannot widen M to M"
4183 #define ERROR_CANNOT_WRITE_LISTING "cannot write listing file"
4184 #define ERROR_CHANNEL_DOES_NOT_ALLOW "channel does not allow Y"
4185 #define ERROR_CLAUSE_WITHOUT_VALUE "clause does not yield a value"
4186 #define ERROR_CLOSING_DEVICE "error while closing device"
4187 #define ERROR_CLOSING_FILE "error while closing file"
4188 #define ERROR_CODE "clause should be compiled"
4189 #define ERROR_COMMA_MUST_SEPARATE "A and A must be separated by a comma-symbol"
4190 #define ERROR_COMPONENT_NUMBER "M must have at least two components"
4191 #define ERROR_COMPONENT_RELATED "M has firmly related components"
4192 #define ERROR_CURSES "error in curses operation"
4193 #define ERROR_CURSES_OFF_SCREEN "curses operation moves cursor off the screen"
4194 #define ERROR_DEVICE_ALREADY_SET "device parameters already set"
4195 #define ERROR_DEVICE_CANNOT_ALLOCATE "cannot allocate device parameters"
4196 #define ERROR_DEVICE_CANNOT_OPEN "cannot open device"
4197 #define ERROR_DEVICE_NOT_OPEN "device is not open"
4198 #define ERROR_DEVICE_NOT_SET "device parameters not set"
4199 #define ERROR_DIFFERENT_BOUNDS "rows have different bounds"
4200 #define ERROR_DIVISION_BY_ZERO "attempt at M division by zero"
4201 #define ERROR_DYADIC_PRIORITY "dyadic S has no priority declaration"
4202 #define ERROR_EMPTY_ARGUMENT "empty argument"
4203 #define ERROR_EMPTY_VALUE "attempt to use an uninitialised M value"
4204 #define ERROR_EMPTY_VALUE_FROM (ERROR_EMPTY_VALUE)
4205 #define ERROR_EXPECTED "Y expected"
4206 #define ERROR_EXPECTED_NEAR "B expected in A, near Z L"
4207 #define ERROR_EXPONENT_DIGIT "invalid exponent digit"
4208 #define ERROR_EXPONENT_INVALID "invalid M exponent"
4209 #define ERROR_FALSE_ASSERTION "false assertion"
4210 #define ERROR_FFT "fourier transform error; U; U"
4211 #define ERROR_FILE_ACCESS "file access error"
4212 #define ERROR_FILE_ALREADY_OPEN "file is already open"
4213 #define ERROR_FILE_CANNOT_OPEN_FOR "cannot open Z for Y"
4214 #define ERROR_FILE_CANT_RESET "cannot reset file"
4215 #define ERROR_FILE_CANT_SET "cannot set file"
4216 #define ERROR_FILE_CLOSE "error while closing file"
4217 #define ERROR_FILE_ENDED "end of file reached"
4218 #define ERROR_FILE_INCLUDE_CTRL "control characters in include file"
4219 #define ERROR_FILE_LOCK "error while locking file"
4220 #define ERROR_FILE_NOT_OPEN "file is not open"
4221 #define ERROR_FILE_NO_TEMP "cannot create unique temporary file name"
4222 #define ERROR_FILE_READ "error while reading file"
4223 #define ERROR_FILE_RESET "error while resetting file"
4224 #define ERROR_FILE_SCRATCH "error while scratching file"
4225 #define ERROR_FILE_SET "error while setting file"
4226 #define ERROR_FILE_SOURCE_CTRL "control characters in source file"
4227 #define ERROR_FILE_TRANSPUT "error transputting M value"
4228 #define ERROR_FILE_TRANSPUT_SIGN "error transputting sign in M value"
4229 #define ERROR_FILE_WRONG_MOOD "file is in Y mood"
4230 #define ERROR_FORMAT_CANNOT_TRANSPUT "cannot transput M value with A"
4231 #define ERROR_FORMAT_EXHAUSTED "patterns exhausted in format"
4232 #define ERROR_FORMAT_INTS_REQUIRED "1 .. 3 M arguments required"
4233 #define ERROR_FORMAT_INVALID_REPLICATOR "negative replicator"
4234 #define ERROR_FORMAT_PICTURES "number of pictures does not match number of arguments"
4235 #define ERROR_FORMAT_PICTURE_NUMBER "incorrect number of pictures for A"
4236 #define ERROR_FORMAT_UNDEFINED "cannot use undefined format"
4237 #define ERROR_INCORRECT_FILENAME "incorrect filename"
4238 #define ERROR_INDEXER_NUMBER "incorrect number of indexers for M"
4239 #define ERROR_INDEX_OUT_OF_BOUNDS "index out of bounds"
4240 #define ERROR_INTERNAL_CONSISTENCY "internal consistency check failure"
4241 #define ERROR_INVALID_ARGUMENT "invalid M argument"
4242 #define ERROR_INVALID_DIMENSION "invalid dimension D"
4243 #define ERROR_INVALID_OPERAND "M construct is an invalid operand"
4244 #define ERROR_INVALID_OPERATOR_TAG "invalid operator tag"
4245 #define ERROR_INVALID_PARAMETER "invalid parameter (U Z)"
4246 #define ERROR_INVALID_PRIORITY "invalid priority declaration"
4247 #define ERROR_INVALID_RADIX "invalid radix D"
4248 #define ERROR_INVALID_SEQUENCE "U is not a valid A"
4249 #define ERROR_INVALID_SIZE "object of invalid size"
4250 #define ERROR_IN_DENOTATION "error in M denotation"
4251 #define ERROR_KEYWORD "check for missing or unmatched keyword in clause starting at S"
4252 #define ERROR_LABELED_UNIT_MUST_FOLLOW "S must be followed by a labeled unit"
4253 #define ERROR_LABEL_BEFORE_DECLARATION "declaration cannot follow a labeled unit"
4254 #define ERROR_LAPLACE "laplace transform error; U; U"
4255 #define ERROR_LONG_STRING "string exceeds end of line"
4256 #define ERROR_MATH "M math error"
4257 #define ERROR_MATH_EXCEPTION "math exception E"
4258 #define ERROR_MODE_SPECIFICATION "M construct must yield a routine, row or structured value"
4259 #define ERROR_MP_OUT_OF_BOUNDS "multiprecision value out of bounds"
4260 #define ERROR_MULTIPLE_FIELD "multiple declaration of field S"
4261 #define ERROR_MULTIPLE_TAG "multiple declaration of tag S"
4262 #define ERROR_NOT_WELL_FORMED "M does not specify a well formed mode"
4263 #define ERROR_NO_COMPONENT "M is neither component nor subset of M"
4264 #define ERROR_NO_DYADIC "dyadic operator O S O has not been declared"
4265 #define ERROR_NO_FIELD "M has no field Z"
4266 #define ERROR_NO_FLEX_ARGUMENT "M value from A cannot be flexible"
4267 #define ERROR_NO_MATRIX "M A does not yield a two-dimensional row"
4268 #define ERROR_NO_MONADIC "monadic operator S O has not been declared"
4269 #define ERROR_NO_NAME "M A does not yield a name"
4270 #define ERROR_NO_NAME_REQUIRED "context does not require a name"
4271 #define ERROR_NO_PARALLEL_CLAUSE "interpreter was compiled without support for the parallel-clause"
4272 #define ERROR_NO_PRIORITY "S has no priority declaration"
4273 #define ERROR_NO_ROW_OR_PROC "M A does not yield a row or procedure"
4274 #define ERROR_NO_SOURCE_FILE "no source file specified"
4275 #define ERROR_NO_SQUARE_MATRIX "M matrix is not square"
4276 #define ERROR_NO_STRUCT "M A does not yield a structured value"
4277 #define ERROR_NO_UNION "M is not a united mode"
4278 #define ERROR_NO_UNIQUE_MODE "construct has no unique mode"
4279 #define ERROR_NO_VECTOR "M A does not yield a one-dimensional row"
4280 #define ERROR_OPERAND_NUMBER "incorrect number of operands for S"
4281 #define ERROR_OPERATOR_INVALID "monadic S cannot start with a character from Z"
4282 #define ERROR_OPERATOR_INVALID_END "probably missing symbol near invalid operator S"
4283 #define ERROR_OPERATOR_RELATED "M Z is firmly related to M Z"
4284 #define ERROR_OUT_OF_BOUNDS "M value out of bounds"
4285 #define ERROR_OUT_OF_CORE "insufficient memory"
4286 #define ERROR_PAGE_SIZE "error in page size"
4287 #define ERROR_PARALLEL_JUMP "jump into different thread"
4288 #define ERROR_PARALLEL_CANNOT_CREATE "cannot create thread"
4289 #define ERROR_PARALLEL_OUTSIDE "invalid outside a parallel clause"
4290 #define ERROR_PARALLEL_OVERFLOW "too many parallel units"
4291 #define ERROR_PARENTHESIS "incorrect parenthesis nesting; check for Y"
4292 #define ERROR_PARENTHESIS_2 "incorrect parenthesis nesting; encountered X L but expected X; check for Y"
4293 #define ERROR_PRAGMENT "error in pragment"
4294 #define ERROR_QUOTED_BOLD_TAG "error in quoted bold tag"
4295 #define ERROR_REDEFINED_KEYWORD "attempt to redefine keyword U in A"
4296 #define ERROR_REFINEMENT_APPLIED "refinement is applied more than once"
4297 #define ERROR_REFINEMENT_DEFINED "refinement already defined"
4298 #define ERROR_REFINEMENT_EMPTY "empty refinement at end of source"
4299 #define ERROR_REFINEMENT_INVALID "invalid refinement"
4300 #define ERROR_REFINEMENT_NOT_APPLIED "refinement is not applied"
4301 #define ERROR_SCOPE_DYNAMIC_0 "value is exported out of its scope"
4302 #define ERROR_SCOPE_DYNAMIC_1 "M value is exported out of its scope"
4303 #define ERROR_SCOPE_DYNAMIC_2 "M value from %s is exported out of its scope"
4304 #define ERROR_SHELL_SCRIPT "source is a shell script"
4305 #define ERROR_SOUND_INTERNAL "error while processing M value (Y)"
4306 #define ERROR_SOUND_INTERNAL_STRING "error while processing M value (Y \"Y\")"
4307 #define ERROR_SOURCE_FILE_OPEN "error while opening source file"
4308 #define ERROR_STACK_OVERFLOW "stack overflow"
4309 #define ERROR_SUBSET_RELATED "M has firmly related subset M"
4310 #define ERROR_SYNTAX "detected in A"
4311 #define ERROR_SYNTAX_EXPECTED "expected A"
4312 #define ERROR_SYNTAX_MIXED_DECLARATION "possibly mixed identity and variable declaration"
4313 #define ERROR_SYNTAX_STRANGE_SEPARATOR "possibly a missing or erroneous separator nearby"
4314 #define ERROR_SYNTAX_STRANGE_TOKENS "possibly a missing or erroneous symbol nearby"
4315 #define ERROR_TIME_LIMIT_EXCEEDED "time limit exceeded"
4316 #define ERROR_TOO_MANY_ARGUMENTS "too many arguments"
4317 #define ERROR_TOO_MANY_OPEN_FILES "too many open files"
4318 #define ERROR_TORRIX "linear algebra error; U; U"
4319 #define ERROR_TRANSIENT_NAME "attempt at storing a transient name"
4320 #define ERROR_UNBALANCED_KEYWORD "missing or unbalanced keyword in A, near Z L"
4321 #define ERROR_UNDECLARED_TAG "tag S has not been declared properly"
4322 #define ERROR_UNDECLARED_TAG_2 "tag Z has not been declared properly"
4323 #define ERROR_UNDEFINED_TRANSPUT "transput of M value by this procedure is not defined"
4324 #define ERROR_UNIMPLEMENTED "S is either not implemented or not compiled"
4325 #define ERROR_UNSPECIFIED "unspecified error"
4326 #define ERROR_UNTERMINATED_COMMENT "unterminated comment"
4327 #define ERROR_UNTERMINATED_PRAGMAT "unterminated pragmat"
4328 #define ERROR_UNTERMINATED_PRAGMENT "unterminated pragment"
4329 #define ERROR_UNTERMINATED_STRING "unterminated string"
4330 #define ERROR_UNWORTHY_CHARACTER "unworthy character"
4331 #define ERROR_VACUO "this vacuum cannot have row elements (use a U generator)"
4332 #define ERROR_VACUUM "this vacuum cannot have row elements (use a U M generator)"
4333 #define INFO_APPROPRIATE_DECLARER "appropriate declarer"
4334 #define INFO_MISSING_KEYWORDS "missing or unmatched keyword"
4335 #define WARNING_EXTENSION "@ is an extension"
4336 #define WARNING_HIDES "declaration hides a declaration of S with larger reach"
4337 #define WARNING_HIDES_PRELUDE "declaration hides prelude declaration of M S"
4338 #define WARNING_OPTIMISATION "optimisation has no effect on this platform"
4339 #define WARNING_OVERFLOW "M constant overflow"
4340 #define WARNING_SCOPE_STATIC "M A is a potential scope violation"
4341 #define WARNING_SKIPPED_SUPERFLUOUS "skipped superfluous A"
4342 #define WARNING_TAG_NOT_PORTABLE "tag S is not portable"
4343 #define WARNING_TAG_UNUSED "tag S is not used"
4344 #define WARNING_TRAILING "ignoring trailing character H in A"
4345 #define WARNING_UNDERFLOW "M constant underflow"
4346 #define WARNING_UNINITIALISED "identifier S might be used before being initialised"
4347 #define WARNING_UNINTENDED "possibly unintended M A in M A"
4348 #define WARNING_VOIDED "value of M @ will be voided"
4349 #define WARNING_WIDENING_NOT_PORTABLE "implicit widening is not portable"
4350 
4351 #endif /* ! defined A68G_ALGOL68G_H */
4352 
4353 extern A68_PROCEDURE on_gc_event;
4354