]> git.ipfire.org Git - thirdparty/gcc.git/blob - gcc/m2/mc-boot/Gdecl.cc
Update copyright years.
[thirdparty/gcc.git] / gcc / m2 / mc-boot / Gdecl.cc
1 /* do not edit automatically generated by mc from decl. */
2 /* decl.mod declaration nodes used to create the AST.
3
4 Copyright (C) 2015-2024 Free Software Foundation, Inc.
5 Contributed by Gaius Mulley <gaius@glam.ac.uk>.
6
7 This file is part of GNU Modula-2.
8
9 GNU Modula-2 is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 3, or (at your option)
12 any later version.
13
14 GNU Modula-2 is distributed in the hope that it will be useful, but
15 WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with GNU Modula-2; see the file COPYING3. If not see
21 <http://www.gnu.org/licenses/>. */
22
23 #include "config.h"
24 #include "system.h"
25 #include <stdbool.h>
26 # if !defined (PROC_D)
27 # define PROC_D
28 typedef void (*PROC_t) (void);
29 typedef struct { PROC_t proc; } PROC;
30 # endif
31
32 # if !defined (TRUE)
33 # define TRUE (1==1)
34 # endif
35
36 # if !defined (FALSE)
37 # define FALSE (1==0)
38 # endif
39
40 # include "GStorage.h"
41 # include "Gmcrts.h"
42 #if defined(__cplusplus)
43 # undef NULL
44 # define NULL 0
45 #endif
46 typedef unsigned int nameKey_Name;
47
48 # define nameKey_NulName 0
49 typedef struct mcPretty_writeProc_p mcPretty_writeProc;
50
51 typedef struct symbolKey__T8_r symbolKey__T8;
52
53 typedef symbolKey__T8 *symbolKey_symbolTree;
54
55 typedef struct mcPretty_writeLnProc_p mcPretty_writeLnProc;
56
57 typedef unsigned int FIO_File;
58
59 extern FIO_File FIO_StdOut;
60 # define symbolKey_NulKey NULL
61 typedef struct symbolKey_performOperation_p symbolKey_performOperation;
62
63 # define ASCII_tab ASCII_ht
64 typedef struct alists__T13_r alists__T13;
65
66 typedef alists__T13 *alists_alist;
67
68 typedef struct alists__T14_a alists__T14;
69
70 # define ASCII_ht (char) 011
71 # define ASCII_lf ASCII_nl
72 # define ASCII_nl (char) 012
73 typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure;
74
75 typedef struct decl_isNodeF_p decl_isNodeF;
76
77 # define SYSTEM_BITSPERBYTE 8
78 # define SYSTEM_BYTESPERWORD 4
79 typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
80
81 typedef struct symbolKey_isSymbol_p symbolKey_isSymbol;
82
83 # define ASCII_nul (char) 000
84 # define ASCII_soh (char) 001
85 # define ASCII_stx (char) 002
86 # define ASCII_etx (char) 003
87 # define ASCII_eot (char) 004
88 # define ASCII_enq (char) 005
89 # define ASCII_ack (char) 006
90 # define ASCII_bel (char) 007
91 # define ASCII_bs (char) 010
92 # define ASCII_vt (char) 013
93 # define ASCII_np (char) 014
94 # define ASCII_cr (char) 015
95 # define ASCII_so (char) 016
96 # define ASCII_si (char) 017
97 # define ASCII_dle (char) 020
98 # define ASCII_dc1 (char) 021
99 # define ASCII_dc2 (char) 022
100 # define ASCII_dc3 (char) 023
101 # define ASCII_dc4 (char) 024
102 # define ASCII_nak (char) 025
103 # define ASCII_syn (char) 026
104 # define ASCII_etb (char) 027
105 # define ASCII_can (char) 030
106 # define ASCII_em (char) 031
107 # define ASCII_sub (char) 032
108 # define ASCII_esc (char) 033
109 # define ASCII_fs (char) 034
110 # define ASCII_gs (char) 035
111 # define ASCII_rs (char) 036
112 # define ASCII_us (char) 037
113 # define ASCII_sp (char) 040
114 # define ASCII_ff ASCII_np
115 # define ASCII_eof ASCII_eot
116 # define ASCII_del (char) 0177
117 # define ASCII_EOL ASCII_nl
118 extern FIO_File FIO_StdErr;
119 extern FIO_File FIO_StdIn;
120 typedef long int libc_time_t;
121
122 typedef struct libc_tm_r libc_tm;
123
124 typedef libc_tm *libc_ptrToTM;
125
126 typedef struct libc_timeb_r libc_timeb;
127
128 typedef struct libc_exitP_p libc_exitP;
129
130 typedef struct mcError__T11_r mcError__T11;
131
132 typedef mcError__T11 *mcError_error;
133
134 extern int mcLexBuf_currentinteger;
135 extern unsigned int mcLexBuf_currentcolumn;
136 extern void * mcLexBuf_currentstring;
137 typedef struct alists_performOperation_p alists_performOperation;
138
139 typedef struct wlists_performOperation_p wlists_performOperation;
140
141 typedef struct StdIO_ProcWrite_p StdIO_ProcWrite;
142
143 typedef struct StdIO_ProcRead_p StdIO_ProcRead;
144
145 # define indentation 3
146 # define indentationC 2
147 # define debugScopes false
148 # define debugDecl false
149 # define caseException true
150 # define returnException true
151 # define forceCompoundStatement true
152 # define enableDefForCStrings false
153 # define enableMemsetOnAllocation true
154 # define forceQualified true
155 typedef struct decl_nodeRec_r decl_nodeRec;
156
157 typedef struct decl_intrinsicT_r decl_intrinsicT;
158
159 typedef struct decl_fixupInfo_r decl_fixupInfo;
160
161 typedef struct decl_explistT_r decl_explistT;
162
163 typedef struct decl_setvalueT_r decl_setvalueT;
164
165 typedef struct decl_identlistT_r decl_identlistT;
166
167 typedef struct decl_funccallT_r decl_funccallT;
168
169 typedef struct decl_commentT_r decl_commentT;
170
171 typedef struct decl_stmtT_r decl_stmtT;
172
173 typedef struct decl_returnT_r decl_returnT;
174
175 typedef struct decl_exitT_r decl_exitT;
176
177 typedef struct decl_vardeclT_r decl_vardeclT;
178
179 typedef struct decl_typeT_r decl_typeT;
180
181 typedef struct decl_recordT_r decl_recordT;
182
183 typedef struct decl_varientT_r decl_varientT;
184
185 typedef struct decl_varT_r decl_varT;
186
187 typedef struct decl_enumerationT_r decl_enumerationT;
188
189 typedef struct decl_subrangeT_r decl_subrangeT;
190
191 typedef struct decl_subscriptT_r decl_subscriptT;
192
193 typedef struct decl_arrayT_r decl_arrayT;
194
195 typedef struct decl_stringT_r decl_stringT;
196
197 typedef struct decl_literalT_r decl_literalT;
198
199 typedef struct decl_constT_r decl_constT;
200
201 typedef struct decl_varparamT_r decl_varparamT;
202
203 typedef struct decl_paramT_r decl_paramT;
204
205 typedef struct decl_varargsT_r decl_varargsT;
206
207 typedef struct decl_optargT_r decl_optargT;
208
209 typedef struct decl_pointerT_r decl_pointerT;
210
211 typedef struct decl_recordfieldT_r decl_recordfieldT;
212
213 typedef struct decl_varientfieldT_r decl_varientfieldT;
214
215 typedef struct decl_enumerationfieldT_r decl_enumerationfieldT;
216
217 typedef struct decl_setT_r decl_setT;
218
219 typedef struct decl_componentrefT_r decl_componentrefT;
220
221 typedef struct decl_pointerrefT_r decl_pointerrefT;
222
223 typedef struct decl_arrayrefT_r decl_arrayrefT;
224
225 typedef struct decl_commentPair_r decl_commentPair;
226
227 typedef struct decl_assignmentT_r decl_assignmentT;
228
229 typedef struct decl_ifT_r decl_ifT;
230
231 typedef struct decl_elsifT_r decl_elsifT;
232
233 typedef struct decl_loopT_r decl_loopT;
234
235 typedef struct decl_whileT_r decl_whileT;
236
237 typedef struct decl_repeatT_r decl_repeatT;
238
239 typedef struct decl_caseT_r decl_caseT;
240
241 typedef struct decl_caselabellistT_r decl_caselabellistT;
242
243 typedef struct decl_caselistT_r decl_caselistT;
244
245 typedef struct decl_rangeT_r decl_rangeT;
246
247 typedef struct decl_forT_r decl_forT;
248
249 typedef struct decl_statementT_r decl_statementT;
250
251 typedef struct decl_scopeT_r decl_scopeT;
252
253 typedef struct decl_procedureT_r decl_procedureT;
254
255 typedef struct decl_proctypeT_r decl_proctypeT;
256
257 typedef struct decl_binaryT_r decl_binaryT;
258
259 typedef struct decl_unaryT_r decl_unaryT;
260
261 typedef struct decl_moduleT_r decl_moduleT;
262
263 typedef struct decl_defT_r decl_defT;
264
265 typedef struct decl_impT_r decl_impT;
266
267 typedef struct decl_where_r decl_where;
268
269 typedef struct decl_nodeProcedure_p decl_nodeProcedure;
270
271 typedef struct decl_cnameT_r decl_cnameT;
272
273 # define MaxBuf 127
274 # define maxNoOfElements 5
275 typedef enum {decl_explist, decl_funccall, decl_exit, decl_return, decl_stmtseq, decl_comment, decl_halt, decl_new, decl_dispose, decl_inc, decl_dec, decl_incl, decl_excl, decl_length, decl_nil, decl_true, decl_false, decl_address, decl_loc, decl_byte, decl_word, decl_csizet, decl_cssizet, decl_char, decl_cardinal, decl_longcard, decl_shortcard, decl_integer, decl_longint, decl_shortint, decl_real, decl_longreal, decl_shortreal, decl_bitset, decl_boolean, decl_proc, decl_ztype, decl_rtype, decl_complex, decl_longcomplex, decl_shortcomplex, decl_type, decl_record, decl_varient, decl_var, decl_enumeration, decl_subrange, decl_array, decl_subscript, decl_string, decl_const, decl_literal, decl_varparam, decl_param, decl_varargs, decl_optarg, decl_pointer, decl_recordfield, decl_varientfield, decl_enumerationfield, decl_set, decl_proctype, decl_procedure, decl_def, decl_imp, decl_module, decl_loop, decl_while, decl_for, decl_repeat, decl_case, decl_caselabellist, decl_caselist, decl_range, decl_assignment, decl_if, decl_elsif, decl_constexp, decl_neg, decl_cast, decl_val, decl_plus, decl_sub, decl_div, decl_mod, decl_mult, decl_divide, decl_in, decl_adr, decl_size, decl_tsize, decl_ord, decl_float, decl_trunc, decl_chr, decl_abs, decl_cap, decl_high, decl_throw, decl_unreachable, decl_cmplx, decl_re, decl_im, decl_min, decl_max, decl_componentref, decl_pointerref, decl_arrayref, decl_deref, decl_equal, decl_notequal, decl_less, decl_greater, decl_greequal, decl_lessequal, decl_lsl, decl_lsr, decl_lor, decl_land, decl_lnot, decl_lxor, decl_and, decl_or, decl_not, decl_identlist, decl_vardecl, decl_setvalue} decl_nodeT;
276
277 # define MaxnoOfelements 5
278 typedef enum {mcReserved_eoftok, mcReserved_plustok, mcReserved_minustok, mcReserved_timestok, mcReserved_dividetok, mcReserved_becomestok, mcReserved_ambersandtok, mcReserved_periodtok, mcReserved_commatok, mcReserved_semicolontok, mcReserved_lparatok, mcReserved_rparatok, mcReserved_lsbratok, mcReserved_rsbratok, mcReserved_lcbratok, mcReserved_rcbratok, mcReserved_uparrowtok, mcReserved_singlequotetok, mcReserved_equaltok, mcReserved_hashtok, mcReserved_lesstok, mcReserved_greatertok, mcReserved_lessgreatertok, mcReserved_lessequaltok, mcReserved_greaterequaltok, mcReserved_ldirectivetok, mcReserved_rdirectivetok, mcReserved_periodperiodtok, mcReserved_colontok, mcReserved_doublequotestok, mcReserved_bartok, mcReserved_andtok, mcReserved_arraytok, mcReserved_begintok, mcReserved_bytok, mcReserved_casetok, mcReserved_consttok, mcReserved_definitiontok, mcReserved_divtok, mcReserved_dotok, mcReserved_elsetok, mcReserved_elsiftok, mcReserved_endtok, mcReserved_excepttok, mcReserved_exittok, mcReserved_exporttok, mcReserved_finallytok, mcReserved_fortok, mcReserved_fromtok, mcReserved_iftok, mcReserved_implementationtok, mcReserved_importtok, mcReserved_intok, mcReserved_looptok, mcReserved_modtok, mcReserved_moduletok, mcReserved_nottok, mcReserved_oftok, mcReserved_ortok, mcReserved_packedsettok, mcReserved_pointertok, mcReserved_proceduretok, mcReserved_qualifiedtok, mcReserved_unqualifiedtok, mcReserved_recordtok, mcReserved_remtok, mcReserved_repeattok, mcReserved_retrytok, mcReserved_returntok, mcReserved_settok, mcReserved_thentok, mcReserved_totok, mcReserved_typetok, mcReserved_untiltok, mcReserved_vartok, mcReserved_whiletok, mcReserved_withtok, mcReserved_asmtok, mcReserved_volatiletok, mcReserved_periodperiodperiodtok, mcReserved_datetok, mcReserved_linetok, mcReserved_filetok, mcReserved_attributetok, mcReserved_builtintok, mcReserved_inlinetok, mcReserved_integertok, mcReserved_identtok, mcReserved_realtok, mcReserved_stringtok, mcReserved_commenttok} mcReserved_toktype;
279
280 extern mcReserved_toktype mcLexBuf_currenttoken;
281 typedef enum {decl_ansiC, decl_ansiCP, decl_pim4} decl_language;
282
283 typedef enum {decl_completed, decl_blocked, decl_partial, decl_recursive} decl_dependentState;
284
285 typedef enum {decl_text, decl_punct, decl_space} decl_outputStates;
286
287 typedef decl_nodeRec *decl_node;
288
289 typedef struct Indexing__T5_r Indexing__T5;
290
291 typedef struct mcComment__T6_r mcComment__T6;
292
293 typedef enum {mcComment_unknown, mcComment_procedureHeading, mcComment_inBody, mcComment_afterStatement} mcComment_commentType;
294
295 typedef struct DynamicStrings_stringRecord_r DynamicStrings_stringRecord;
296
297 typedef struct DynamicStrings_Contents_r DynamicStrings_Contents;
298
299 typedef struct wlists__T9_r wlists__T9;
300
301 typedef struct mcPretty__T12_r mcPretty__T12;
302
303 typedef struct wlists__T10_a wlists__T10;
304
305 typedef struct DynamicStrings__T7_a DynamicStrings__T7;
306
307 typedef Indexing__T5 *Indexing_Index;
308
309 typedef mcComment__T6 *mcComment_commentDesc;
310
311 extern mcComment_commentDesc mcLexBuf_currentcomment;
312 extern mcComment_commentDesc mcLexBuf_lastcomment;
313 typedef DynamicStrings_stringRecord *DynamicStrings_String;
314
315 typedef wlists__T9 *wlists_wlist;
316
317 typedef mcPretty__T12 *mcPretty_pretty;
318
319 typedef void (*mcPretty_writeProc_t) (char);
320 struct mcPretty_writeProc_p { mcPretty_writeProc_t proc; };
321
322 struct symbolKey__T8_r {
323 nameKey_Name name;
324 void *key;
325 symbolKey_symbolTree left;
326 symbolKey_symbolTree right;
327 };
328
329 typedef void (*mcPretty_writeLnProc_t) (void);
330 struct mcPretty_writeLnProc_p { mcPretty_writeLnProc_t proc; };
331
332 typedef void (*symbolKey_performOperation_t) (void *);
333 struct symbolKey_performOperation_p { symbolKey_performOperation_t proc; };
334
335 struct alists__T14_a { void * array[MaxnoOfelements-1+1]; };
336 typedef void (*Indexing_IndexProcedure_t) (void *);
337 struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; };
338
339 typedef bool (*decl_isNodeF_t) (decl_node);
340 struct decl_isNodeF_p { decl_isNodeF_t proc; };
341
342 typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
343 struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
344
345 typedef bool (*symbolKey_isSymbol_t) (void *);
346 struct symbolKey_isSymbol_p { symbolKey_isSymbol_t proc; };
347
348 struct libc_tm_r {
349 int tm_sec;
350 int tm_min;
351 int tm_hour;
352 int tm_mday;
353 int tm_mon;
354 int tm_year;
355 int tm_wday;
356 int tm_yday;
357 int tm_isdst;
358 long int tm_gmtoff;
359 void *tm_zone;
360 };
361
362 struct libc_timeb_r {
363 libc_time_t time_;
364 short unsigned int millitm;
365 short unsigned int timezone;
366 short unsigned int dstflag;
367 };
368
369 typedef int (*libc_exitP_t) (void);
370 typedef libc_exitP_t libc_exitP_C;
371
372 struct libc_exitP_p { libc_exitP_t proc; };
373
374 struct mcError__T11_r {
375 mcError_error parent;
376 mcError_error child;
377 mcError_error next;
378 bool fatal;
379 DynamicStrings_String s;
380 unsigned int token;
381 };
382
383 typedef void (*alists_performOperation_t) (void *);
384 struct alists_performOperation_p { alists_performOperation_t proc; };
385
386 typedef void (*wlists_performOperation_t) (unsigned int);
387 struct wlists_performOperation_p { wlists_performOperation_t proc; };
388
389 typedef void (*StdIO_ProcWrite_t) (char);
390 struct StdIO_ProcWrite_p { StdIO_ProcWrite_t proc; };
391
392 typedef void (*StdIO_ProcRead_t) (char *);
393 struct StdIO_ProcRead_p { StdIO_ProcRead_t proc; };
394
395 struct decl_fixupInfo_r {
396 unsigned int count;
397 Indexing_Index info;
398 };
399
400 struct decl_explistT_r {
401 Indexing_Index exp;
402 };
403
404 struct decl_setvalueT_r {
405 decl_node type;
406 Indexing_Index values;
407 };
408
409 struct decl_identlistT_r {
410 wlists_wlist names;
411 bool cnamed;
412 };
413
414 struct decl_commentT_r {
415 mcComment_commentDesc content;
416 };
417
418 struct decl_stmtT_r {
419 Indexing_Index statements;
420 };
421
422 struct decl_exitT_r {
423 decl_node loop;
424 };
425
426 struct decl_vardeclT_r {
427 wlists_wlist names;
428 decl_node type;
429 decl_node scope;
430 };
431
432 struct decl_typeT_r {
433 nameKey_Name name;
434 decl_node type;
435 decl_node scope;
436 bool isHidden;
437 bool isInternal;
438 };
439
440 struct decl_recordT_r {
441 symbolKey_symbolTree localSymbols;
442 Indexing_Index listOfSons;
443 decl_node scope;
444 };
445
446 struct decl_varientT_r {
447 Indexing_Index listOfSons;
448 decl_node varient;
449 decl_node tag;
450 decl_node scope;
451 };
452
453 struct decl_enumerationT_r {
454 unsigned int noOfElements;
455 symbolKey_symbolTree localSymbols;
456 Indexing_Index listOfSons;
457 decl_node low;
458 decl_node high;
459 decl_node scope;
460 };
461
462 struct decl_subrangeT_r {
463 decl_node low;
464 decl_node high;
465 decl_node type;
466 decl_node scope;
467 };
468
469 struct decl_subscriptT_r {
470 decl_node type;
471 decl_node expr;
472 };
473
474 struct decl_arrayT_r {
475 decl_node subr;
476 decl_node type;
477 decl_node scope;
478 bool isUnbounded;
479 };
480
481 struct decl_stringT_r {
482 nameKey_Name name;
483 unsigned int length;
484 bool isCharCompatible;
485 DynamicStrings_String cstring;
486 unsigned int clength;
487 DynamicStrings_String cchar;
488 };
489
490 struct decl_literalT_r {
491 nameKey_Name name;
492 decl_node type;
493 };
494
495 struct decl_constT_r {
496 nameKey_Name name;
497 decl_node type;
498 decl_node value;
499 decl_node scope;
500 };
501
502 struct decl_varparamT_r {
503 decl_node namelist;
504 decl_node type;
505 decl_node scope;
506 bool isUnbounded;
507 bool isForC;
508 bool isUsed;
509 };
510
511 struct decl_paramT_r {
512 decl_node namelist;
513 decl_node type;
514 decl_node scope;
515 bool isUnbounded;
516 bool isForC;
517 bool isUsed;
518 };
519
520 struct decl_varargsT_r {
521 decl_node scope;
522 };
523
524 struct decl_optargT_r {
525 decl_node namelist;
526 decl_node type;
527 decl_node scope;
528 decl_node init;
529 };
530
531 struct decl_pointerT_r {
532 decl_node type;
533 decl_node scope;
534 };
535
536 struct decl_varientfieldT_r {
537 nameKey_Name name;
538 decl_node parent;
539 decl_node varient;
540 bool simple;
541 Indexing_Index listOfSons;
542 decl_node scope;
543 };
544
545 struct decl_setT_r {
546 decl_node type;
547 decl_node scope;
548 };
549
550 struct decl_componentrefT_r {
551 decl_node rec;
552 decl_node field;
553 decl_node resultType;
554 };
555
556 struct decl_pointerrefT_r {
557 decl_node ptr;
558 decl_node field;
559 decl_node resultType;
560 };
561
562 struct decl_arrayrefT_r {
563 decl_node array;
564 decl_node index;
565 decl_node resultType;
566 };
567
568 struct decl_commentPair_r {
569 decl_node after;
570 decl_node body;
571 };
572
573 struct decl_loopT_r {
574 decl_node statements;
575 unsigned int labelno;
576 };
577
578 struct decl_caseT_r {
579 decl_node expression;
580 Indexing_Index caseLabelList;
581 decl_node else_;
582 };
583
584 struct decl_caselabellistT_r {
585 decl_node caseList;
586 decl_node statements;
587 };
588
589 struct decl_caselistT_r {
590 Indexing_Index rangePairs;
591 };
592
593 struct decl_rangeT_r {
594 decl_node lo;
595 decl_node hi;
596 };
597
598 struct decl_forT_r {
599 decl_node des;
600 decl_node start;
601 decl_node end;
602 decl_node increment;
603 decl_node statements;
604 };
605
606 struct decl_statementT_r {
607 Indexing_Index sequence;
608 };
609
610 struct decl_scopeT_r {
611 symbolKey_symbolTree symbols;
612 Indexing_Index constants;
613 Indexing_Index types;
614 Indexing_Index procedures;
615 Indexing_Index variables;
616 };
617
618 struct decl_proctypeT_r {
619 Indexing_Index parameters;
620 bool returnopt;
621 bool vararg;
622 decl_node optarg_;
623 decl_node scope;
624 decl_node returnType;
625 };
626
627 struct decl_binaryT_r {
628 decl_node left;
629 decl_node right;
630 decl_node resultType;
631 };
632
633 struct decl_unaryT_r {
634 decl_node arg;
635 decl_node resultType;
636 };
637
638 struct decl_where_r {
639 unsigned int defDeclared;
640 unsigned int modDeclared;
641 unsigned int firstUsed;
642 };
643
644 typedef void (*decl_nodeProcedure_t) (decl_node);
645 struct decl_nodeProcedure_p { decl_nodeProcedure_t proc; };
646
647 struct decl_cnameT_r {
648 nameKey_Name name;
649 bool init;
650 };
651
652 struct Indexing__T5_r {
653 void *ArrayStart;
654 unsigned int ArraySize;
655 unsigned int Used;
656 unsigned int Low;
657 unsigned int High;
658 bool Debug;
659 unsigned int Map;
660 };
661
662 struct mcComment__T6_r {
663 mcComment_commentType type;
664 DynamicStrings_String content;
665 nameKey_Name procName;
666 bool used;
667 };
668
669 struct wlists__T10_a { unsigned int array[maxNoOfElements-1+1]; };
670 struct DynamicStrings__T7_a { char array[(MaxBuf-1)+1]; };
671 struct alists__T13_r {
672 unsigned int noOfelements;
673 alists__T14 elements;
674 alists_alist next;
675 };
676
677 struct decl_intrinsicT_r {
678 decl_node args;
679 unsigned int noArgs;
680 decl_node type;
681 decl_commentPair intrinsicComment;
682 bool postUnreachable;
683 };
684
685 struct decl_funccallT_r {
686 decl_node function;
687 decl_node args;
688 decl_node type;
689 decl_commentPair funccallComment;
690 };
691
692 struct decl_returnT_r {
693 decl_node exp;
694 decl_node scope;
695 decl_commentPair returnComment;
696 };
697
698 struct decl_varT_r {
699 nameKey_Name name;
700 decl_node type;
701 decl_node decl;
702 decl_node scope;
703 bool isInitialised;
704 bool isParameter;
705 bool isVarParameter;
706 bool isUsed;
707 decl_cnameT cname;
708 };
709
710 struct decl_recordfieldT_r {
711 nameKey_Name name;
712 decl_node type;
713 bool tag;
714 decl_node parent;
715 decl_node varient;
716 decl_node scope;
717 decl_cnameT cname;
718 };
719
720 struct decl_enumerationfieldT_r {
721 nameKey_Name name;
722 decl_node type;
723 decl_node scope;
724 unsigned int value;
725 decl_cnameT cname;
726 };
727
728 struct decl_assignmentT_r {
729 decl_node des;
730 decl_node expr;
731 decl_commentPair assignComment;
732 };
733
734 struct decl_ifT_r {
735 decl_node expr;
736 decl_node elsif;
737 decl_node then;
738 decl_node else_;
739 decl_commentPair ifComment;
740 decl_commentPair elseComment;
741 decl_commentPair endComment;
742 };
743
744 struct decl_elsifT_r {
745 decl_node expr;
746 decl_node elsif;
747 decl_node then;
748 decl_node else_;
749 decl_commentPair elseComment;
750 };
751
752 struct decl_whileT_r {
753 decl_node expr;
754 decl_node statements;
755 decl_commentPair doComment;
756 decl_commentPair endComment;
757 };
758
759 struct decl_repeatT_r {
760 decl_node expr;
761 decl_node statements;
762 decl_commentPair repeatComment;
763 decl_commentPair untilComment;
764 };
765
766 struct decl_procedureT_r {
767 nameKey_Name name;
768 decl_scopeT decls;
769 decl_node scope;
770 Indexing_Index parameters;
771 bool isForC;
772 bool built;
773 bool checking;
774 bool returnopt;
775 bool vararg;
776 bool noreturnused;
777 bool noreturn;
778 unsigned int paramcount;
779 decl_node optarg_;
780 decl_node returnType;
781 decl_node beginStatements;
782 decl_cnameT cname;
783 mcComment_commentDesc defComment;
784 mcComment_commentDesc modComment;
785 };
786
787 struct decl_moduleT_r {
788 nameKey_Name name;
789 nameKey_Name source;
790 Indexing_Index importedModules;
791 decl_fixupInfo constFixup;
792 decl_fixupInfo enumFixup;
793 decl_scopeT decls;
794 decl_node beginStatements;
795 decl_node finallyStatements;
796 bool enumsComplete;
797 bool constsComplete;
798 bool visited;
799 decl_commentPair com;
800 };
801
802 struct decl_defT_r {
803 nameKey_Name name;
804 nameKey_Name source;
805 bool hasHidden;
806 bool forC;
807 Indexing_Index exported;
808 Indexing_Index importedModules;
809 decl_fixupInfo constFixup;
810 decl_fixupInfo enumFixup;
811 decl_scopeT decls;
812 bool enumsComplete;
813 bool constsComplete;
814 bool visited;
815 decl_commentPair com;
816 };
817
818 struct decl_impT_r {
819 nameKey_Name name;
820 nameKey_Name source;
821 Indexing_Index importedModules;
822 decl_fixupInfo constFixup;
823 decl_fixupInfo enumFixup;
824 decl_node beginStatements;
825 decl_node finallyStatements;
826 decl_node definitionModule;
827 decl_scopeT decls;
828 bool enumsComplete;
829 bool constsComplete;
830 bool visited;
831 decl_commentPair com;
832 };
833
834 struct DynamicStrings_Contents_r {
835 DynamicStrings__T7 buf;
836 unsigned int len;
837 DynamicStrings_String next;
838 };
839
840 struct wlists__T9_r {
841 unsigned int noOfElements;
842 wlists__T10 elements;
843 wlists_wlist next;
844 };
845
846 struct mcPretty__T12_r {
847 mcPretty_writeProc write_;
848 mcPretty_writeLnProc writeln;
849 bool needsSpace;
850 bool needsIndent;
851 unsigned int seekPos;
852 unsigned int curLine;
853 unsigned int curPos;
854 unsigned int indent;
855 mcPretty_pretty stacked;
856 };
857
858 typedef struct DynamicStrings_descriptor_r DynamicStrings_descriptor;
859
860 typedef DynamicStrings_descriptor *DynamicStrings_Descriptor;
861
862 typedef struct DynamicStrings_DebugInfo_r DynamicStrings_DebugInfo;
863
864 typedef enum {DynamicStrings_inuse, DynamicStrings_marked, DynamicStrings_onlist, DynamicStrings_poisoned} DynamicStrings_desState;
865
866 struct DynamicStrings_descriptor_r {
867 bool charStarUsed;
868 void *charStar;
869 unsigned int charStarSize;
870 bool charStarValid;
871 DynamicStrings_desState state;
872 DynamicStrings_String garbage;
873 };
874
875 struct DynamicStrings_DebugInfo_r {
876 DynamicStrings_String next;
877 void *file;
878 unsigned int line;
879 void *proc;
880 };
881
882 struct decl_nodeRec_r {
883 decl_nodeT kind; /* case tag */
884 union {
885 decl_intrinsicT intrinsicF;
886 decl_explistT explistF;
887 decl_exitT exitF;
888 decl_returnT returnF;
889 decl_stmtT stmtF;
890 decl_commentT commentF;
891 decl_typeT typeF;
892 decl_recordT recordF;
893 decl_varientT varientF;
894 decl_varT varF;
895 decl_enumerationT enumerationF;
896 decl_subrangeT subrangeF;
897 decl_subscriptT subscriptF;
898 decl_arrayT arrayF;
899 decl_stringT stringF;
900 decl_constT constF;
901 decl_literalT literalF;
902 decl_varparamT varparamF;
903 decl_paramT paramF;
904 decl_varargsT varargsF;
905 decl_optargT optargF;
906 decl_pointerT pointerF;
907 decl_recordfieldT recordfieldF;
908 decl_varientfieldT varientfieldF;
909 decl_enumerationfieldT enumerationfieldF;
910 decl_setT setF;
911 decl_proctypeT proctypeF;
912 decl_procedureT procedureF;
913 decl_defT defF;
914 decl_impT impF;
915 decl_moduleT moduleF;
916 decl_loopT loopF;
917 decl_whileT whileF;
918 decl_forT forF;
919 decl_repeatT repeatF;
920 decl_caseT caseF;
921 decl_caselabellistT caselabellistF;
922 decl_caselistT caselistF;
923 decl_rangeT rangeF;
924 decl_ifT ifF;
925 decl_elsifT elsifF;
926 decl_assignmentT assignmentF;
927 decl_arrayrefT arrayrefF;
928 decl_pointerrefT pointerrefF;
929 decl_componentrefT componentrefF;
930 decl_binaryT binaryF;
931 decl_unaryT unaryF;
932 decl_identlistT identlistF;
933 decl_vardeclT vardeclF;
934 decl_funccallT funccallF;
935 decl_setvalueT setvalueF;
936 };
937 decl_where at;
938 };
939
940 struct DynamicStrings_stringRecord_r {
941 DynamicStrings_Contents contents;
942 DynamicStrings_Descriptor head;
943 DynamicStrings_DebugInfo debug;
944 };
945
946 static FIO_File outputFile;
947 static decl_language lang;
948 static decl_node bitsperunitN;
949 static decl_node bitsperwordN;
950 static decl_node bitspercharN;
951 static decl_node unitsperwordN;
952 static decl_node mainModule;
953 static decl_node currentModule;
954 static decl_node defModule;
955 static decl_node systemN;
956 static decl_node addressN;
957 static decl_node locN;
958 static decl_node byteN;
959 static decl_node wordN;
960 static decl_node csizetN;
961 static decl_node cssizetN;
962 static decl_node adrN;
963 static decl_node sizeN;
964 static decl_node tsizeN;
965 static decl_node newN;
966 static decl_node disposeN;
967 static decl_node lengthN;
968 static decl_node incN;
969 static decl_node decN;
970 static decl_node inclN;
971 static decl_node exclN;
972 static decl_node highN;
973 static decl_node m2rtsN;
974 static decl_node haltN;
975 static decl_node throwN;
976 static decl_node chrN;
977 static decl_node capN;
978 static decl_node absN;
979 static decl_node floatN;
980 static decl_node truncN;
981 static decl_node ordN;
982 static decl_node valN;
983 static decl_node minN;
984 static decl_node maxN;
985 static decl_node booleanN;
986 static decl_node procN;
987 static decl_node charN;
988 static decl_node integerN;
989 static decl_node cardinalN;
990 static decl_node longcardN;
991 static decl_node shortcardN;
992 static decl_node longintN;
993 static decl_node shortintN;
994 static decl_node bitsetN;
995 static decl_node bitnumN;
996 static decl_node ztypeN;
997 static decl_node rtypeN;
998 static decl_node complexN;
999 static decl_node longcomplexN;
1000 static decl_node shortcomplexN;
1001 static decl_node cmplxN;
1002 static decl_node reN;
1003 static decl_node imN;
1004 static decl_node realN;
1005 static decl_node longrealN;
1006 static decl_node shortrealN;
1007 static decl_node nilN;
1008 static decl_node trueN;
1009 static decl_node falseN;
1010 static Indexing_Index scopeStack;
1011 static Indexing_Index defUniverseI;
1012 static Indexing_Index modUniverseI;
1013 static symbolKey_symbolTree modUniverse;
1014 static symbolKey_symbolTree defUniverse;
1015 static symbolKey_symbolTree baseSymbols;
1016 static decl_outputStates outputState;
1017 static mcPretty_pretty doP;
1018 static alists_alist todoQ;
1019 static alists_alist partialQ;
1020 static alists_alist doneQ;
1021 static bool mustVisitScope;
1022 static bool simplified;
1023 static unsigned int tempCount;
1024 static decl_node globalNode;
1025 extern "C" void SYSTEM_ShiftVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int ShiftCount);
1026 extern "C" void SYSTEM_ShiftLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount);
1027 extern "C" void SYSTEM_ShiftRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount);
1028 extern "C" void SYSTEM_RotateVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int RotateCount);
1029 extern "C" void SYSTEM_RotateLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
1030 extern "C" void SYSTEM_RotateRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
1031 extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, void * overrideliborder, int argc, void * argv, void * envp);
1032 extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
1033 extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
1034 extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
1035 extern "C" bool M2RTS_InstallTerminationProcedure (PROC p);
1036 extern "C" void M2RTS_ExecuteInitialProcedures (void);
1037 extern "C" bool M2RTS_InstallInitialProcedure (PROC p);
1038 extern "C" void M2RTS_ExecuteTerminationProcedures (void);
1039 extern "C" void M2RTS_Terminate (void) __attribute__ ((noreturn));
1040 extern "C" void M2RTS_HALT (int exitcode) __attribute__ ((noreturn));
1041 extern "C" void M2RTS_Halt (const char *description_, unsigned int _description_high, const char *filename_, unsigned int _filename_high, const char *function_, unsigned int _function_high, unsigned int line) __attribute__ ((noreturn));
1042 extern "C" void M2RTS_HaltC (void * description, void * filename, void * function, unsigned int line) __attribute__ ((noreturn));
1043 extern "C" void M2RTS_ExitOnHalt (int e);
1044 extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high) __attribute__ ((noreturn));
1045 extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
1046 extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1047 extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1048 extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1049 extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1050 extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1051 extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1052 extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1053 extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1054 extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1055 extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1056 extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1057 extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1058 extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1059 extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1060 extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1061 extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1062 extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1063 extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1064 extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1065 extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1066 extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1067 extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1068 extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1069 extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
1070
1071 /*
1072 getDeclaredMod - returns the token number associated with the nodes declaration
1073 in the implementation or program module.
1074 */
1075
1076 extern "C" unsigned int decl_getDeclaredMod (decl_node n);
1077
1078 /*
1079 getDeclaredDef - returns the token number associated with the nodes declaration
1080 in the definition module.
1081 */
1082
1083 extern "C" unsigned int decl_getDeclaredDef (decl_node n);
1084
1085 /*
1086 getFirstUsed - returns the token number associated with the first use of
1087 node, n.
1088 */
1089
1090 extern "C" unsigned int decl_getFirstUsed (decl_node n);
1091
1092 /*
1093 isDef - return TRUE if node, n, is a definition module.
1094 */
1095
1096 extern "C" bool decl_isDef (decl_node n);
1097
1098 /*
1099 isImp - return TRUE if node, n, is an implementation module.
1100 */
1101
1102 extern "C" bool decl_isImp (decl_node n);
1103
1104 /*
1105 isImpOrModule - returns TRUE if, n, is a program module or implementation module.
1106 */
1107
1108 extern "C" bool decl_isImpOrModule (decl_node n);
1109
1110 /*
1111 isVisited - returns TRUE if the node was visited.
1112 */
1113
1114 extern "C" bool decl_isVisited (decl_node n);
1115
1116 /*
1117 unsetVisited - unset the visited flag on a def/imp/module node.
1118 */
1119
1120 extern "C" void decl_unsetVisited (decl_node n);
1121
1122 /*
1123 setVisited - set the visited flag on a def/imp/module node.
1124 */
1125
1126 extern "C" void decl_setVisited (decl_node n);
1127
1128 /*
1129 setEnumsComplete - sets the field inside the def or imp or module, n.
1130 */
1131
1132 extern "C" void decl_setEnumsComplete (decl_node n);
1133
1134 /*
1135 getEnumsComplete - gets the field from the def or imp or module, n.
1136 */
1137
1138 extern "C" bool decl_getEnumsComplete (decl_node n);
1139
1140 /*
1141 resetEnumPos - resets the index into the saved list of enums inside
1142 module, n.
1143 */
1144
1145 extern "C" void decl_resetEnumPos (decl_node n);
1146
1147 /*
1148 getNextEnum - returns the next enumeration node.
1149 */
1150
1151 extern "C" decl_node decl_getNextEnum (void);
1152
1153 /*
1154 isModule - return TRUE if node, n, is a program module.
1155 */
1156
1157 extern "C" bool decl_isModule (decl_node n);
1158
1159 /*
1160 isMainModule - return TRUE if node, n, is the main module specified
1161 by the source file. This might be a definition,
1162 implementation or program module.
1163 */
1164
1165 extern "C" bool decl_isMainModule (decl_node n);
1166
1167 /*
1168 setMainModule - sets node, n, as the main module to be compiled.
1169 */
1170
1171 extern "C" void decl_setMainModule (decl_node n);
1172
1173 /*
1174 setCurrentModule - sets node, n, as the current module being compiled.
1175 */
1176
1177 extern "C" void decl_setCurrentModule (decl_node n);
1178
1179 /*
1180 lookupDef - returns a definition module node named, n.
1181 */
1182
1183 extern "C" decl_node decl_lookupDef (nameKey_Name n);
1184
1185 /*
1186 lookupImp - returns an implementation module node named, n.
1187 */
1188
1189 extern "C" decl_node decl_lookupImp (nameKey_Name n);
1190
1191 /*
1192 lookupModule - returns a module node named, n.
1193 */
1194
1195 extern "C" decl_node decl_lookupModule (nameKey_Name n);
1196
1197 /*
1198 putDefForC - the definition module was defined FOR "C".
1199 */
1200
1201 extern "C" void decl_putDefForC (decl_node n);
1202
1203 /*
1204 lookupInScope - looks up a symbol named, n, from, scope.
1205 */
1206
1207 extern "C" decl_node decl_lookupInScope (decl_node scope, nameKey_Name n);
1208
1209 /*
1210 isConst - returns TRUE if node, n, is a const.
1211 */
1212
1213 extern "C" bool decl_isConst (decl_node n);
1214
1215 /*
1216 isType - returns TRUE if node, n, is a type.
1217 */
1218
1219 extern "C" bool decl_isType (decl_node n);
1220
1221 /*
1222 putType - places, exp, as the type alias to des.
1223 TYPE des = exp ;
1224 */
1225
1226 extern "C" void decl_putType (decl_node des, decl_node exp);
1227
1228 /*
1229 getType - returns the type associated with node, n.
1230 */
1231
1232 extern "C" decl_node decl_getType (decl_node n);
1233
1234 /*
1235 skipType - skips over type aliases.
1236 */
1237
1238 extern "C" decl_node decl_skipType (decl_node n);
1239
1240 /*
1241 putTypeHidden - marks type, des, as being a hidden type.
1242 TYPE des ;
1243 */
1244
1245 extern "C" void decl_putTypeHidden (decl_node des);
1246
1247 /*
1248 isTypeHidden - returns TRUE if type, n, is hidden.
1249 */
1250
1251 extern "C" bool decl_isTypeHidden (decl_node n);
1252
1253 /*
1254 hasHidden - returns TRUE if module, n, has a hidden type.
1255 */
1256
1257 extern "C" bool decl_hasHidden (decl_node n);
1258
1259 /*
1260 isVar - returns TRUE if node, n, is a type.
1261 */
1262
1263 extern "C" bool decl_isVar (decl_node n);
1264
1265 /*
1266 isTemporary - returns TRUE if node, n, is a variable and temporary.
1267 */
1268
1269 extern "C" bool decl_isTemporary (decl_node n);
1270
1271 /*
1272 isExported - returns TRUE if symbol, n, is exported from
1273 the definition module.
1274 */
1275
1276 extern "C" bool decl_isExported (decl_node n);
1277
1278 /*
1279 getDeclScope - returns the node representing the
1280 current declaration scope.
1281 */
1282
1283 extern "C" decl_node decl_getDeclScope (void);
1284
1285 /*
1286 getScope - returns the scope associated with node, n.
1287 */
1288
1289 extern "C" decl_node decl_getScope (decl_node n);
1290
1291 /*
1292 isLiteral - returns TRUE if, n, is a literal.
1293 */
1294
1295 extern "C" bool decl_isLiteral (decl_node n);
1296
1297 /*
1298 isConstSet - returns TRUE if, n, is a constant set.
1299 */
1300
1301 extern "C" bool decl_isConstSet (decl_node n);
1302
1303 /*
1304 isEnumerationField - returns TRUE if, n, is an enumeration field.
1305 */
1306
1307 extern "C" bool decl_isEnumerationField (decl_node n);
1308
1309 /*
1310 isEnumeration - returns TRUE if node, n, is an enumeration type.
1311 */
1312
1313 extern "C" bool decl_isEnumeration (decl_node n);
1314
1315 /*
1316 isUnbounded - returns TRUE if, n, is an unbounded array.
1317 */
1318
1319 extern "C" bool decl_isUnbounded (decl_node n);
1320
1321 /*
1322 isParameter - returns TRUE if, n, is a parameter.
1323 */
1324
1325 extern "C" bool decl_isParameter (decl_node n);
1326
1327 /*
1328 isVarParam - returns TRUE if, n, is a var parameter.
1329 */
1330
1331 extern "C" bool decl_isVarParam (decl_node n);
1332
1333 /*
1334 isParam - returns TRUE if, n, is a non var parameter.
1335 */
1336
1337 extern "C" bool decl_isParam (decl_node n);
1338
1339 /*
1340 isNonVarParam - is an alias to isParam.
1341 */
1342
1343 extern "C" bool decl_isNonVarParam (decl_node n);
1344
1345 /*
1346 addOptParameter - returns an optarg which has been created and added to
1347 procedure node, proc. It has a name, id, and, type,
1348 and an initial value, init.
1349 */
1350
1351 extern "C" decl_node decl_addOptParameter (decl_node proc, nameKey_Name id, decl_node type, decl_node init);
1352
1353 /*
1354 isOptarg - returns TRUE if, n, is an optarg.
1355 */
1356
1357 extern "C" bool decl_isOptarg (decl_node n);
1358
1359 /*
1360 isRecord - returns TRUE if, n, is a record.
1361 */
1362
1363 extern "C" bool decl_isRecord (decl_node n);
1364
1365 /*
1366 isRecordField - returns TRUE if, n, is a record field.
1367 */
1368
1369 extern "C" bool decl_isRecordField (decl_node n);
1370
1371 /*
1372 isVarientField - returns TRUE if, n, is a varient field.
1373 */
1374
1375 extern "C" bool decl_isVarientField (decl_node n);
1376
1377 /*
1378 isArray - returns TRUE if, n, is an array.
1379 */
1380
1381 extern "C" bool decl_isArray (decl_node n);
1382
1383 /*
1384 isProcType - returns TRUE if, n, is a procedure type.
1385 */
1386
1387 extern "C" bool decl_isProcType (decl_node n);
1388
1389 /*
1390 isPointer - returns TRUE if, n, is a pointer.
1391 */
1392
1393 extern "C" bool decl_isPointer (decl_node n);
1394
1395 /*
1396 isProcedure - returns TRUE if, n, is a procedure.
1397 */
1398
1399 extern "C" bool decl_isProcedure (decl_node n);
1400
1401 /*
1402 isVarient - returns TRUE if, n, is a varient record.
1403 */
1404
1405 extern "C" bool decl_isVarient (decl_node n);
1406
1407 /*
1408 isSet - returns TRUE if, n, is a set type.
1409 */
1410
1411 extern "C" bool decl_isSet (decl_node n);
1412
1413 /*
1414 isSubrange - returns TRUE if, n, is a subrange type.
1415 */
1416
1417 extern "C" bool decl_isSubrange (decl_node n);
1418
1419 /*
1420 isZtype - returns TRUE if, n, is the Z type.
1421 */
1422
1423 extern "C" bool decl_isZtype (decl_node n);
1424
1425 /*
1426 isRtype - returns TRUE if, n, is the R type.
1427 */
1428
1429 extern "C" bool decl_isRtype (decl_node n);
1430
1431 /*
1432 makeConst - create, initialise and return a const node.
1433 */
1434
1435 extern "C" decl_node decl_makeConst (nameKey_Name n);
1436
1437 /*
1438 putConst - places value, v, into node, n.
1439 */
1440
1441 extern "C" void decl_putConst (decl_node n, decl_node v);
1442
1443 /*
1444 makeType - create, initialise and return a type node.
1445 */
1446
1447 extern "C" decl_node decl_makeType (nameKey_Name n);
1448
1449 /*
1450 makeTypeImp - lookup a type in the definition module
1451 and return it. Otherwise create a new type.
1452 */
1453
1454 extern "C" decl_node decl_makeTypeImp (nameKey_Name n);
1455
1456 /*
1457 makeVar - create, initialise and return a var node.
1458 */
1459
1460 extern "C" decl_node decl_makeVar (nameKey_Name n);
1461
1462 /*
1463 putVar - places, type, as the type for var.
1464 */
1465
1466 extern "C" void decl_putVar (decl_node var, decl_node type, decl_node decl);
1467
1468 /*
1469 makeVarDecl - create a vardecl node and create a shadow variable in the
1470 current scope.
1471 */
1472
1473 extern "C" decl_node decl_makeVarDecl (decl_node i, decl_node type);
1474
1475 /*
1476 makeEnum - creates an enumerated type and returns the node.
1477 */
1478
1479 extern "C" decl_node decl_makeEnum (void);
1480
1481 /*
1482 makeEnumField - returns an enumeration field, named, n.
1483 */
1484
1485 extern "C" decl_node decl_makeEnumField (decl_node e, nameKey_Name n);
1486
1487 /*
1488 makeSubrange - returns a subrange node, built from range: low..high.
1489 */
1490
1491 extern "C" decl_node decl_makeSubrange (decl_node low, decl_node high);
1492
1493 /*
1494 putSubrangeType - assigns, type, to the subrange type, sub.
1495 */
1496
1497 extern "C" void decl_putSubrangeType (decl_node sub, decl_node type);
1498
1499 /*
1500 makePointer - returns a pointer of, type, node.
1501 */
1502
1503 extern "C" decl_node decl_makePointer (decl_node type);
1504
1505 /*
1506 makeSet - returns a set of, type, node.
1507 */
1508
1509 extern "C" decl_node decl_makeSet (decl_node type);
1510
1511 /*
1512 makeArray - returns a node representing ARRAY subr OF type.
1513 */
1514
1515 extern "C" decl_node decl_makeArray (decl_node subr, decl_node type);
1516
1517 /*
1518 putUnbounded - sets array, n, as unbounded.
1519 */
1520
1521 extern "C" void decl_putUnbounded (decl_node n);
1522
1523 /*
1524 makeRecord - creates and returns a record node.
1525 */
1526
1527 extern "C" decl_node decl_makeRecord (void);
1528
1529 /*
1530 makeVarient - creates a new symbol, a varient symbol for record or varient field
1531 symbol, r.
1532 */
1533
1534 extern "C" decl_node decl_makeVarient (decl_node r);
1535
1536 /*
1537 addFieldsToRecord - adds fields, i, of type, t, into a record, r.
1538 It returns, r.
1539 */
1540
1541 extern "C" decl_node decl_addFieldsToRecord (decl_node r, decl_node v, decl_node i, decl_node t);
1542
1543 /*
1544 buildVarientSelector - builds a field of name, tag, of, type onto:
1545 record or varient field, r.
1546 varient, v.
1547 */
1548
1549 extern "C" void decl_buildVarientSelector (decl_node r, decl_node v, nameKey_Name tag, decl_node type);
1550
1551 /*
1552 buildVarientFieldRecord - builds a varient field into a varient symbol, v.
1553 The varient field is returned.
1554 */
1555
1556 extern "C" decl_node decl_buildVarientFieldRecord (decl_node v, decl_node p);
1557
1558 /*
1559 getSymName - returns the name of symbol, n.
1560 */
1561
1562 extern "C" nameKey_Name decl_getSymName (decl_node n);
1563
1564 /*
1565 import - attempts to add node, n, into the scope of module, m.
1566 It might fail due to a name clash in which case the
1567 previous named symbol is returned. On success, n,
1568 is returned.
1569 */
1570
1571 extern "C" decl_node decl_import (decl_node m, decl_node n);
1572
1573 /*
1574 lookupExported - attempts to lookup a node named, i, from definition
1575 module, n. The node is returned if found.
1576 NIL is returned if not found.
1577 */
1578
1579 extern "C" decl_node decl_lookupExported (decl_node n, nameKey_Name i);
1580
1581 /*
1582 lookupSym - returns the symbol named, n, from the scope stack.
1583 */
1584
1585 extern "C" decl_node decl_lookupSym (nameKey_Name n);
1586
1587 /*
1588 addImportedModule - add module, i, to be imported by, m.
1589 If scoped then module, i, is added to the
1590 module, m, scope.
1591 */
1592
1593 extern "C" void decl_addImportedModule (decl_node m, decl_node i, bool scoped);
1594
1595 /*
1596 setSource - sets the source filename for module, n, to s.
1597 */
1598
1599 extern "C" void decl_setSource (decl_node n, nameKey_Name s);
1600
1601 /*
1602 getSource - returns the source filename for module, n.
1603 */
1604
1605 extern "C" nameKey_Name decl_getSource (decl_node n);
1606
1607 /*
1608 getMainModule - returns the main module node.
1609 */
1610
1611 extern "C" decl_node decl_getMainModule (void);
1612
1613 /*
1614 getCurrentModule - returns the current module being compiled.
1615 */
1616
1617 extern "C" decl_node decl_getCurrentModule (void);
1618
1619 /*
1620 foreachDefModuleDo - foreach definition node, n, in the module universe,
1621 call p (n).
1622 */
1623
1624 extern "C" void decl_foreachDefModuleDo (symbolKey_performOperation p);
1625
1626 /*
1627 foreachModModuleDo - foreach implementation or module node, n, in the module universe,
1628 call p (n).
1629 */
1630
1631 extern "C" void decl_foreachModModuleDo (symbolKey_performOperation p);
1632
1633 /*
1634 enterScope - pushes symbol, n, to the scope stack.
1635 */
1636
1637 extern "C" void decl_enterScope (decl_node n);
1638
1639 /*
1640 leaveScope - removes the top level scope.
1641 */
1642
1643 extern "C" void decl_leaveScope (void);
1644
1645 /*
1646 makeProcedure - create, initialise and return a procedure node.
1647 */
1648
1649 extern "C" decl_node decl_makeProcedure (nameKey_Name n);
1650
1651 /*
1652 putCommentDefProcedure - remembers the procedure comment (if it exists) as a
1653 definition module procedure heading. NIL is placed
1654 if there is no procedure comment available.
1655 */
1656
1657 extern "C" void decl_putCommentDefProcedure (decl_node n);
1658
1659 /*
1660 putCommentModProcedure - remembers the procedure comment (if it exists) as an
1661 implementation/program module procedure heading. NIL is placed
1662 if there is no procedure comment available.
1663 */
1664
1665 extern "C" void decl_putCommentModProcedure (decl_node n);
1666
1667 /*
1668 makeProcType - returns a proctype node.
1669 */
1670
1671 extern "C" decl_node decl_makeProcType (void);
1672
1673 /*
1674 putReturnType - sets the return type of procedure or proctype, proc, to, type.
1675 */
1676
1677 extern "C" void decl_putReturnType (decl_node proc, decl_node type);
1678
1679 /*
1680 putOptReturn - sets, proctype or procedure, proc, to have an optional return type.
1681 */
1682
1683 extern "C" void decl_putOptReturn (decl_node proc);
1684
1685 /*
1686 makeVarParameter - returns a var parameter node with, name: type.
1687 */
1688
1689 extern "C" decl_node decl_makeVarParameter (decl_node l, decl_node type, decl_node proc, bool isused);
1690
1691 /*
1692 makeNonVarParameter - returns a non var parameter node with, name: type.
1693 */
1694
1695 extern "C" decl_node decl_makeNonVarParameter (decl_node l, decl_node type, decl_node proc, bool isused);
1696
1697 /*
1698 paramEnter - reset the parameter count.
1699 */
1700
1701 extern "C" void decl_paramEnter (decl_node n);
1702
1703 /*
1704 paramLeave - set paramater checking to TRUE from now onwards.
1705 */
1706
1707 extern "C" void decl_paramLeave (decl_node n);
1708
1709 /*
1710 makeIdentList - returns a node which will be used to maintain an ident list.
1711 */
1712
1713 extern "C" decl_node decl_makeIdentList (void);
1714
1715 /*
1716 putIdent - places ident, i, into identlist, n. It returns TRUE if
1717 ident, i, is unique.
1718 */
1719
1720 extern "C" bool decl_putIdent (decl_node n, nameKey_Name i);
1721
1722 /*
1723 addVarParameters - adds the identlist, i, of, type, to be VAR parameters
1724 in procedure, n.
1725 */
1726
1727 extern "C" void decl_addVarParameters (decl_node n, decl_node i, decl_node type, bool isused);
1728
1729 /*
1730 addNonVarParameters - adds the identlist, i, of, type, to be parameters
1731 in procedure, n.
1732 */
1733
1734 extern "C" void decl_addNonVarParameters (decl_node n, decl_node i, decl_node type, bool isused);
1735
1736 /*
1737 makeVarargs - returns a varargs node.
1738 */
1739
1740 extern "C" decl_node decl_makeVarargs (void);
1741
1742 /*
1743 isVarargs - returns TRUE if, n, is a varargs node.
1744 */
1745
1746 extern "C" bool decl_isVarargs (decl_node n);
1747
1748 /*
1749 addParameter - adds a parameter, param, to procedure or proctype, proc.
1750 */
1751
1752 extern "C" void decl_addParameter (decl_node proc, decl_node param);
1753
1754 /*
1755 makeBinaryTok - creates and returns a boolean type node with,
1756 l, and, r, nodes.
1757 */
1758
1759 extern "C" decl_node decl_makeBinaryTok (mcReserved_toktype op, decl_node l, decl_node r);
1760
1761 /*
1762 makeUnaryTok - creates and returns a boolean type node with,
1763 e, node.
1764 */
1765
1766 extern "C" decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e);
1767
1768 /*
1769 makeComponentRef - build a componentref node which accesses, field,
1770 within, record, rec.
1771 */
1772
1773 extern "C" decl_node decl_makeComponentRef (decl_node rec, decl_node field);
1774
1775 /*
1776 makePointerRef - build a pointerref node which accesses, field,
1777 within, pointer to record, ptr.
1778 */
1779
1780 extern "C" decl_node decl_makePointerRef (decl_node ptr, decl_node field);
1781
1782 /*
1783 isPointerRef - returns TRUE if, n, is a pointerref node.
1784 */
1785
1786 extern "C" bool decl_isPointerRef (decl_node n);
1787
1788 /*
1789 makeDeRef - dereferences the pointer defined by, n.
1790 */
1791
1792 extern "C" decl_node decl_makeDeRef (decl_node n);
1793
1794 /*
1795 makeArrayRef - build an arrayref node which access element,
1796 index, in, array. array is a variable/expression/constant
1797 which has a type array.
1798 */
1799
1800 extern "C" decl_node decl_makeArrayRef (decl_node array, decl_node index);
1801
1802 /*
1803 getLastOp - return the right most non leaf node.
1804 */
1805
1806 extern "C" decl_node decl_getLastOp (decl_node n);
1807
1808 /*
1809 getCardinal - returns the cardinal type node.
1810 */
1811
1812 extern "C" decl_node decl_getCardinal (void);
1813
1814 /*
1815 makeLiteralInt - creates and returns a literal node based on an integer type.
1816 */
1817
1818 extern "C" decl_node decl_makeLiteralInt (nameKey_Name n);
1819
1820 /*
1821 makeLiteralReal - creates and returns a literal node based on a real type.
1822 */
1823
1824 extern "C" decl_node decl_makeLiteralReal (nameKey_Name n);
1825
1826 /*
1827 makeString - creates and returns a node containing string, n.
1828 */
1829
1830 extern "C" decl_node decl_makeString (nameKey_Name n);
1831
1832 /*
1833 makeSetValue - creates and returns a setvalue node.
1834 */
1835
1836 extern "C" decl_node decl_makeSetValue (void);
1837
1838 /*
1839 isSetValue - returns TRUE if, n, is a setvalue node.
1840 */
1841
1842 extern "C" bool decl_isSetValue (decl_node n);
1843
1844 /*
1845 putSetValue - assigns the type, t, to the set value, n. The
1846 node, n, is returned.
1847 */
1848
1849 extern "C" decl_node decl_putSetValue (decl_node n, decl_node t);
1850
1851 /*
1852 includeSetValue - includes the range l..h into the setvalue.
1853 h might be NIL indicating that a single element
1854 is to be included into the set.
1855 n is returned.
1856 */
1857
1858 extern "C" decl_node decl_includeSetValue (decl_node n, decl_node l, decl_node h);
1859
1860 /*
1861 getBuiltinConst - creates and returns a builtin const if available.
1862 */
1863
1864 extern "C" decl_node decl_getBuiltinConst (nameKey_Name n);
1865
1866 /*
1867 makeExpList - creates and returns an expList node.
1868 */
1869
1870 extern "C" decl_node decl_makeExpList (void);
1871
1872 /*
1873 isExpList - returns TRUE if, n, is an explist node.
1874 */
1875
1876 extern "C" bool decl_isExpList (decl_node n);
1877
1878 /*
1879 putExpList - places, expression, e, within the explist, n.
1880 */
1881
1882 extern "C" void decl_putExpList (decl_node n, decl_node e);
1883
1884 /*
1885 makeConstExp - returns a constexp node.
1886 */
1887
1888 extern "C" decl_node decl_makeConstExp (void);
1889
1890 /*
1891 getNextConstExp - returns the next constexp node.
1892 */
1893
1894 extern "C" decl_node decl_getNextConstExp (void);
1895
1896 /*
1897 setConstExpComplete - sets the field inside the def or imp or module, n.
1898 */
1899
1900 extern "C" void decl_setConstExpComplete (decl_node n);
1901
1902 /*
1903 fixupConstExp - assign fixup expression, e, into the argument of, c.
1904 */
1905
1906 extern "C" decl_node decl_fixupConstExp (decl_node c, decl_node e);
1907
1908 /*
1909 resetConstExpPos - resets the index into the saved list of constexps inside
1910 module, n.
1911 */
1912
1913 extern "C" void decl_resetConstExpPos (decl_node n);
1914
1915 /*
1916 makeFuncCall - builds a function call to c with param list, n.
1917 */
1918
1919 extern "C" decl_node decl_makeFuncCall (decl_node c, decl_node n);
1920
1921 /*
1922 makeStatementSequence - create and return a statement sequence node.
1923 */
1924
1925 extern "C" decl_node decl_makeStatementSequence (void);
1926
1927 /*
1928 isStatementSequence - returns TRUE if node, n, is a statement sequence.
1929 */
1930
1931 extern "C" bool decl_isStatementSequence (decl_node n);
1932
1933 /*
1934 addStatement - adds node, n, as a statement to statememt sequence, s.
1935 */
1936
1937 extern "C" void decl_addStatement (decl_node s, decl_node n);
1938
1939 /*
1940 addCommentBody - adds a body comment to a statement sequence node.
1941 */
1942
1943 extern "C" void decl_addCommentBody (decl_node n);
1944
1945 /*
1946 addCommentAfter - adds an after comment to a statement sequence node.
1947 */
1948
1949 extern "C" void decl_addCommentAfter (decl_node n);
1950
1951 /*
1952 addIfComments - adds the, body, and, after, comments to if node, n.
1953 */
1954
1955 extern "C" void decl_addIfComments (decl_node n, decl_node body, decl_node after);
1956
1957 /*
1958 addElseComments - adds the, body, and, after, comments to an, if, or an elsif, node, n.
1959 */
1960
1961 extern "C" void decl_addElseComments (decl_node n, decl_node body, decl_node after);
1962
1963 /*
1964 addIfEndComments - adds the, body, and, after, comments to an, if, node, n.
1965 */
1966
1967 extern "C" void decl_addIfEndComments (decl_node n, decl_node body, decl_node after);
1968
1969 /*
1970 makeReturn - creates and returns a return node.
1971 */
1972
1973 extern "C" decl_node decl_makeReturn (void);
1974
1975 /*
1976 isReturn - returns TRUE if node, n, is a return.
1977 */
1978
1979 extern "C" bool decl_isReturn (decl_node n);
1980
1981 /*
1982 putReturn - assigns node, e, as the expression on the return node.
1983 */
1984
1985 extern "C" void decl_putReturn (decl_node n, decl_node e);
1986
1987 /*
1988 makeWhile - creates and returns a while node.
1989 */
1990
1991 extern "C" decl_node decl_makeWhile (void);
1992
1993 /*
1994 putWhile - places an expression, e, and statement sequence, s, into the while
1995 node, n.
1996 */
1997
1998 extern "C" void decl_putWhile (decl_node n, decl_node e, decl_node s);
1999
2000 /*
2001 isWhile - returns TRUE if node, n, is a while.
2002 */
2003
2004 extern "C" bool decl_isWhile (decl_node n);
2005
2006 /*
2007 addWhileDoComment - adds body and after comments to while node, w.
2008 */
2009
2010 extern "C" void decl_addWhileDoComment (decl_node w, decl_node body, decl_node after);
2011
2012 /*
2013 addWhileEndComment - adds body and after comments to the end of a while node, w.
2014 */
2015
2016 extern "C" void decl_addWhileEndComment (decl_node w, decl_node body, decl_node after);
2017
2018 /*
2019 makeAssignment - creates and returns an assignment node.
2020 The designator is, d, and expression, e.
2021 */
2022
2023 extern "C" decl_node decl_makeAssignment (decl_node d, decl_node e);
2024
2025 /*
2026 putBegin - assigns statements, s, to be the normal part in
2027 block, b. The block may be a procedure or module,
2028 or implementation node.
2029 */
2030
2031 extern "C" void decl_putBegin (decl_node b, decl_node s);
2032
2033 /*
2034 putFinally - assigns statements, s, to be the final part in
2035 block, b. The block may be a module
2036 or implementation node.
2037 */
2038
2039 extern "C" void decl_putFinally (decl_node b, decl_node s);
2040
2041 /*
2042 makeExit - creates and returns an exit node.
2043 */
2044
2045 extern "C" decl_node decl_makeExit (decl_node l, unsigned int n);
2046
2047 /*
2048 isExit - returns TRUE if node, n, is an exit.
2049 */
2050
2051 extern "C" bool decl_isExit (decl_node n);
2052
2053 /*
2054 makeLoop - creates and returns a loop node.
2055 */
2056
2057 extern "C" decl_node decl_makeLoop (void);
2058
2059 /*
2060 isLoop - returns TRUE if, n, is a loop node.
2061 */
2062
2063 extern "C" bool decl_isLoop (decl_node n);
2064
2065 /*
2066 putLoop - places statement sequence, s, into loop, l.
2067 */
2068
2069 extern "C" void decl_putLoop (decl_node l, decl_node s);
2070
2071 /*
2072 makeComment - creates and returns a comment node.
2073 */
2074
2075 extern "C" decl_node decl_makeComment (const char *a_, unsigned int _a_high);
2076
2077 /*
2078 makeCommentS - creates and returns a comment node.
2079 */
2080
2081 extern "C" decl_node decl_makeCommentS (mcComment_commentDesc c);
2082
2083 /*
2084 makeIf - creates and returns an if node. The if node
2085 will have expression, e, and statement sequence, s,
2086 as the then component.
2087 */
2088
2089 extern "C" decl_node decl_makeIf (decl_node e, decl_node s);
2090
2091 /*
2092 isIf - returns TRUE if, n, is an if node.
2093 */
2094
2095 extern "C" bool decl_isIf (decl_node n);
2096
2097 /*
2098 makeElsif - creates and returns an elsif node.
2099 This node has an expression, e, and statement
2100 sequence, s.
2101 */
2102
2103 extern "C" decl_node decl_makeElsif (decl_node i, decl_node e, decl_node s);
2104
2105 /*
2106 isElsif - returns TRUE if node, n, is an elsif node.
2107 */
2108
2109 extern "C" bool decl_isElsif (decl_node n);
2110
2111 /*
2112 putElse - the else is grafted onto the if/elsif node, i,
2113 and the statement sequence will be, s.
2114 */
2115
2116 extern "C" void decl_putElse (decl_node i, decl_node s);
2117
2118 /*
2119 makeFor - creates and returns a for node.
2120 */
2121
2122 extern "C" decl_node decl_makeFor (void);
2123
2124 /*
2125 isFor - returns TRUE if node, n, is a for node.
2126 */
2127
2128 extern "C" bool decl_isFor (decl_node n);
2129
2130 /*
2131 putFor - assigns the fields of the for node with
2132 ident, i,
2133 start, s,
2134 end, e,
2135 increment, i,
2136 statements, sq.
2137 */
2138
2139 extern "C" void decl_putFor (decl_node f, decl_node i, decl_node s, decl_node e, decl_node b, decl_node sq);
2140
2141 /*
2142 makeRepeat - creates and returns a repeat node.
2143 */
2144
2145 extern "C" decl_node decl_makeRepeat (void);
2146
2147 /*
2148 isRepeat - returns TRUE if node, n, is a repeat node.
2149 */
2150
2151 extern "C" bool decl_isRepeat (decl_node n);
2152
2153 /*
2154 putRepeat - places statements, s, and expression, e, into
2155 repeat statement, n.
2156 */
2157
2158 extern "C" void decl_putRepeat (decl_node n, decl_node s, decl_node e);
2159
2160 /*
2161 addRepeatComment - adds body and after comments to repeat node, r.
2162 */
2163
2164 extern "C" void decl_addRepeatComment (decl_node r, decl_node body, decl_node after);
2165
2166 /*
2167 addUntilComment - adds body and after comments to the until section of a repeat node, r.
2168 */
2169
2170 extern "C" void decl_addUntilComment (decl_node r, decl_node body, decl_node after);
2171
2172 /*
2173 makeCase - builds and returns a case statement node.
2174 */
2175
2176 extern "C" decl_node decl_makeCase (void);
2177
2178 /*
2179 isCase - returns TRUE if node, n, is a case statement.
2180 */
2181
2182 extern "C" bool decl_isCase (decl_node n);
2183
2184 /*
2185 putCaseExpression - places expression, e, into case statement, n.
2186 n is returned.
2187 */
2188
2189 extern "C" decl_node decl_putCaseExpression (decl_node n, decl_node e);
2190
2191 /*
2192 putCaseElse - places else statement, e, into case statement, n.
2193 n is returned.
2194 */
2195
2196 extern "C" decl_node decl_putCaseElse (decl_node n, decl_node e);
2197
2198 /*
2199 putCaseStatement - places a caselist, l, and associated
2200 statement sequence, s, into case statement, n.
2201 n is returned.
2202 */
2203
2204 extern "C" decl_node decl_putCaseStatement (decl_node n, decl_node l, decl_node s);
2205
2206 /*
2207 makeCaseLabelList - creates and returns a caselabellist node.
2208 */
2209
2210 extern "C" decl_node decl_makeCaseLabelList (decl_node l, decl_node s);
2211
2212 /*
2213 isCaseLabelList - returns TRUE if, n, is a caselabellist.
2214 */
2215
2216 extern "C" bool decl_isCaseLabelList (decl_node n);
2217
2218 /*
2219 makeCaseList - creates and returns a case statement node.
2220 */
2221
2222 extern "C" decl_node decl_makeCaseList (void);
2223
2224 /*
2225 isCaseList - returns TRUE if, n, is a case list.
2226 */
2227
2228 extern "C" bool decl_isCaseList (decl_node n);
2229
2230 /*
2231 putCaseRange - places the case range lo..hi into caselist, n.
2232 */
2233
2234 extern "C" decl_node decl_putCaseRange (decl_node n, decl_node lo, decl_node hi);
2235
2236 /*
2237 makeRange - creates and returns a case range.
2238 */
2239
2240 extern "C" decl_node decl_makeRange (decl_node lo, decl_node hi);
2241
2242 /*
2243 isRange - returns TRUE if node, n, is a range.
2244 */
2245
2246 extern "C" bool decl_isRange (decl_node n);
2247
2248 /*
2249 setNoReturn - sets noreturn field inside procedure.
2250 */
2251
2252 extern "C" void decl_setNoReturn (decl_node n, bool value);
2253
2254 /*
2255 dupExpr - duplicate the expression nodes, it does not duplicate
2256 variables, literals, constants but only the expression
2257 operators (including function calls and parameter lists).
2258 */
2259
2260 extern "C" decl_node decl_dupExpr (decl_node n);
2261
2262 /*
2263 setLangC -
2264 */
2265
2266 extern "C" void decl_setLangC (void);
2267
2268 /*
2269 setLangCP -
2270 */
2271
2272 extern "C" void decl_setLangCP (void);
2273
2274 /*
2275 setLangM2 -
2276 */
2277
2278 extern "C" void decl_setLangM2 (void);
2279
2280 /*
2281 out - walks the tree of node declarations for the main module
2282 and writes the output to the outputFile specified in
2283 mcOptions. It outputs the declarations in the language
2284 specified above.
2285 */
2286
2287 extern "C" void decl_out (void);
2288 extern "C" nameKey_Name nameKey_makeKey (const char *a_, unsigned int _a_high);
2289 extern "C" nameKey_Name nameKey_makekey (void * a);
2290 extern "C" void nameKey_getKey (nameKey_Name key, char *a, unsigned int _a_high);
2291 extern "C" unsigned int nameKey_lengthKey (nameKey_Name key);
2292 extern "C" bool nameKey_isKey (const char *a_, unsigned int _a_high);
2293 extern "C" void nameKey_writeKey (nameKey_Name key);
2294 extern "C" bool nameKey_isSameExcludingCase (nameKey_Name key1, nameKey_Name key2);
2295 extern "C" void * nameKey_keyToCharStar (nameKey_Name key);
2296 extern "C" symbolKey_symbolTree symbolKey_initTree (void);
2297 extern "C" void symbolKey_killTree (symbolKey_symbolTree *t);
2298 extern "C" void * symbolKey_getSymKey (symbolKey_symbolTree t, nameKey_Name name);
2299 extern "C" void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name, void * key);
2300
2301 /*
2302 delSymKey - deletes an entry in the binary tree.
2303
2304 NB in order for this to work we must ensure that the InitTree sets
2305 both left and right to NIL.
2306 */
2307
2308 extern "C" void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name);
2309
2310 /*
2311 isEmptyTree - returns true if symbolTree, t, is empty.
2312 */
2313
2314 extern "C" bool symbolKey_isEmptyTree (symbolKey_symbolTree t);
2315
2316 /*
2317 doesTreeContainAny - returns true if symbolTree, t, contains any
2318 symbols which in turn return true when procedure,
2319 p, is called with a symbol as its parameter.
2320 The symbolTree root is empty apart from the field,
2321 left, hence we need two procedures.
2322 */
2323
2324 extern "C" bool symbolKey_doesTreeContainAny (symbolKey_symbolTree t, symbolKey_isSymbol p);
2325
2326 /*
2327 foreachNodeDo - for each node in symbolTree, t, a procedure, p,
2328 is called with the node symbol as its parameter.
2329 The tree root node only contains a legal left pointer,
2330 therefore we need two procedures to examine this tree.
2331 */
2332
2333 extern "C" void symbolKey_foreachNodeDo (symbolKey_symbolTree t, symbolKey_performOperation p);
2334
2335 /*
2336 initComment - the start of a new comment has been seen by the lexical analyser.
2337 A new comment block is created and all addText contents are placed
2338 in this block. onlySpaces indicates whether we have only seen
2339 spaces on this line.
2340 */
2341
2342 extern "C" mcComment_commentDesc mcComment_initComment (bool onlySpaces);
2343
2344 /*
2345 addText - cs is a C string (null terminated) which contains comment text.
2346 This is appended to the comment, cd.
2347 */
2348
2349 extern "C" void mcComment_addText (mcComment_commentDesc cd, void * cs);
2350
2351 /*
2352 getContent - returns the content of comment, cd.
2353 */
2354
2355 extern "C" DynamicStrings_String mcComment_getContent (mcComment_commentDesc cd);
2356
2357 /*
2358 getCommentCharStar - returns the C string content of comment, cd.
2359 */
2360
2361 extern "C" void * mcComment_getCommentCharStar (mcComment_commentDesc cd);
2362
2363 /*
2364 setProcedureComment - changes the type of comment, cd, to a
2365 procedure heading comment,
2366 providing it has the procname as the first word.
2367 */
2368
2369 extern "C" void mcComment_setProcedureComment (mcComment_commentDesc cd, nameKey_Name procname);
2370
2371 /*
2372 getProcedureComment - returns the current procedure comment if available.
2373 */
2374
2375 extern "C" DynamicStrings_String mcComment_getProcedureComment (mcComment_commentDesc cd);
2376
2377 /*
2378 getAfterStatementComment - returns the current statement after comment if available.
2379 */
2380
2381 extern "C" DynamicStrings_String mcComment_getAfterStatementComment (mcComment_commentDesc cd);
2382
2383 /*
2384 getInbodyStatementComment - returns the current statement after comment if available.
2385 */
2386
2387 extern "C" DynamicStrings_String mcComment_getInbodyStatementComment (mcComment_commentDesc cd);
2388
2389 /*
2390 isProcedureComment - returns TRUE if, cd, is a procedure comment.
2391 */
2392
2393 extern "C" bool mcComment_isProcedureComment (mcComment_commentDesc cd);
2394
2395 /*
2396 isBodyComment - returns TRUE if, cd, is a body comment.
2397 */
2398
2399 extern "C" bool mcComment_isBodyComment (mcComment_commentDesc cd);
2400
2401 /*
2402 isAfterComment - returns TRUE if, cd, is an after comment.
2403 */
2404
2405 extern "C" bool mcComment_isAfterComment (mcComment_commentDesc cd);
2406 extern "C" void mcDebug_assert (bool q);
2407 extern "C" void mcDebug_writeDebug (const char *a_, unsigned int _a_high);
2408 extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size);
2409 extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size);
2410 extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size);
2411 extern "C" bool Storage_Available (unsigned int Size);
2412 extern "C" bool SFIO_Exists (DynamicStrings_String fname);
2413 extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname);
2414 extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname);
2415 extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, bool towrite, bool newfile);
2416 extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s);
2417 extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file);
2418 extern "C" bool FIO_IsNoError (FIO_File f);
2419 extern "C" bool FIO_IsActive (FIO_File f);
2420 extern "C" bool FIO_Exists (const char *fname_, unsigned int _fname_high);
2421 extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high);
2422 extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high);
2423 extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, bool towrite, bool newfile);
2424 extern "C" void FIO_Close (FIO_File f);
2425 extern "C" bool FIO_exists (void * fname, unsigned int flength);
2426 extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength);
2427 extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength);
2428 extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, bool towrite, bool newfile);
2429 extern "C" void FIO_FlushBuffer (FIO_File f);
2430 extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest);
2431 extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high);
2432 extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src);
2433 extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high);
2434 extern "C" void FIO_WriteChar (FIO_File f, char ch);
2435 extern "C" bool FIO_EOF (FIO_File f);
2436 extern "C" bool FIO_EOLN (FIO_File f);
2437 extern "C" bool FIO_WasEOLN (FIO_File f);
2438 extern "C" char FIO_ReadChar (FIO_File f);
2439 extern "C" void FIO_UnReadChar (FIO_File f, char ch);
2440 extern "C" void FIO_WriteLine (FIO_File f);
2441 extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high);
2442 extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high);
2443 extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c);
2444 extern "C" unsigned int FIO_ReadCardinal (FIO_File f);
2445 extern "C" int FIO_GetUnixFileDescriptor (FIO_File f);
2446 extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos);
2447 extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos);
2448 extern "C" long int FIO_FindPosition (FIO_File f);
2449 extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high);
2450 extern "C" void * FIO_getFileName (FIO_File f);
2451 extern "C" unsigned int FIO_getFileNameLength (FIO_File f);
2452 extern "C" void FIO_FlushOutErr (void);
2453
2454 /*
2455 InitString - creates and returns a String type object.
2456 Initial contents are, a.
2457 */
2458
2459 extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high);
2460
2461 /*
2462 KillString - frees String, s, and its contents.
2463 NIL is returned.
2464 */
2465
2466 extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s);
2467
2468 /*
2469 Fin - finishes with a string, it calls KillString with, s.
2470 The purpose of the procedure is to provide a short cut
2471 to calling KillString and then testing the return result.
2472 */
2473
2474 extern "C" void DynamicStrings_Fin (DynamicStrings_String s);
2475
2476 /*
2477 InitStringCharStar - initializes and returns a String to contain the C string.
2478 */
2479
2480 extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a);
2481
2482 /*
2483 InitStringChar - initializes and returns a String to contain the single character, ch.
2484 */
2485
2486 extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch);
2487
2488 /*
2489 Mark - marks String, s, ready for garbage collection.
2490 */
2491
2492 extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s);
2493
2494 /*
2495 Length - returns the length of the String, s.
2496 */
2497
2498 extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s);
2499
2500 /*
2501 ConCat - returns String, a, after the contents of, b, have been appended.
2502 */
2503
2504 extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b);
2505
2506 /*
2507 ConCatChar - returns String, a, after character, ch, has been appended.
2508 */
2509
2510 extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch);
2511
2512 /*
2513 Assign - assigns the contents of, b, into, a.
2514 String, a, is returned.
2515 */
2516
2517 extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b);
2518
2519 /*
2520 ReplaceChar - returns string s after it has changed all occurances of from to to.
2521 */
2522
2523 extern "C" DynamicStrings_String DynamicStrings_ReplaceChar (DynamicStrings_String s, char from, char to);
2524
2525 /*
2526 Dup - duplicate a String, s, returning the copy of s.
2527 */
2528
2529 extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s);
2530
2531 /*
2532 Add - returns a new String which contains the contents of a and b.
2533 */
2534
2535 extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b);
2536
2537 /*
2538 Equal - returns TRUE if String, a, and, b, are equal.
2539 */
2540
2541 extern "C" bool DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b);
2542
2543 /*
2544 EqualCharStar - returns TRUE if contents of String, s, is the same as the
2545 string, a.
2546 */
2547
2548 extern "C" bool DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a);
2549
2550 /*
2551 EqualArray - returns TRUE if contents of String, s, is the same as the
2552 string, a.
2553 */
2554
2555 extern "C" bool DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high);
2556
2557 /*
2558 Mult - returns a new string which is n concatenations of String, s.
2559 */
2560
2561 extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n);
2562
2563 /*
2564 Slice - returns a new string which contains the elements
2565 low..high-1
2566
2567 strings start at element 0
2568 Slice(s, 0, 2) will return elements 0, 1 but not 2
2569 Slice(s, 1, 3) will return elements 1, 2 but not 3
2570 Slice(s, 2, 0) will return elements 2..max
2571 Slice(s, 3, -1) will return elements 3..max-1
2572 Slice(s, 4, -2) will return elements 4..max-2
2573 */
2574
2575 extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high);
2576
2577 /*
2578 Index - returns the indice of the first occurance of, ch, in
2579 String, s. -1 is returned if, ch, does not exist.
2580 The search starts at position, o.
2581 */
2582
2583 extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o);
2584
2585 /*
2586 RIndex - returns the indice of the last occurance of, ch,
2587 in String, s. The search starts at position, o.
2588 -1 is returned if, ch, is not found.
2589 */
2590
2591 extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o);
2592
2593 /*
2594 RemoveComment - assuming that, comment, is a comment delimiter
2595 which indicates anything to its right is a comment
2596 then strip off the comment and also any white space
2597 on the remaining right hand side.
2598 It leaves any white space on the left hand side alone.
2599 */
2600
2601 extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment);
2602
2603 /*
2604 RemoveWhitePrefix - removes any leading white space from String, s.
2605 A new string is returned.
2606 */
2607
2608 extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s);
2609
2610 /*
2611 RemoveWhitePostfix - removes any leading white space from String, s.
2612 A new string is returned.
2613 */
2614
2615 extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s);
2616
2617 /*
2618 ToUpper - returns string, s, after it has had its lower case characters
2619 replaced by upper case characters.
2620 The string, s, is not duplicated.
2621 */
2622
2623 extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s);
2624
2625 /*
2626 ToLower - returns string, s, after it has had its upper case characters
2627 replaced by lower case characters.
2628 The string, s, is not duplicated.
2629 */
2630
2631 extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s);
2632
2633 /*
2634 CopyOut - copies string, s, to a.
2635 */
2636
2637 extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s);
2638
2639 /*
2640 char - returns the character, ch, at position, i, in String, s.
2641 */
2642
2643 extern "C" char DynamicStrings_char (DynamicStrings_String s, int i);
2644
2645 /*
2646 string - returns the C style char * of String, s.
2647 */
2648
2649 extern "C" void * DynamicStrings_string (DynamicStrings_String s);
2650
2651 /*
2652 InitStringDB - the debug version of InitString.
2653 */
2654
2655 extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line);
2656
2657 /*
2658 InitStringCharStarDB - the debug version of InitStringCharStar.
2659 */
2660
2661 extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line);
2662
2663 /*
2664 InitStringCharDB - the debug version of InitStringChar.
2665 */
2666
2667 extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line);
2668
2669 /*
2670 MultDB - the debug version of MultDB.
2671 */
2672
2673 extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line);
2674
2675 /*
2676 DupDB - the debug version of Dup.
2677 */
2678
2679 extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line);
2680
2681 /*
2682 SliceDB - debug version of Slice.
2683 */
2684
2685 extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line);
2686
2687 /*
2688 PushAllocation - pushes the current allocation/deallocation lists.
2689 */
2690
2691 extern "C" void DynamicStrings_PushAllocation (void);
2692
2693 /*
2694 PopAllocation - test to see that all strings are deallocated since
2695 the last push. Then it pops to the previous
2696 allocation/deallocation lists.
2697
2698 If halt is true then the application terminates
2699 with an exit code of 1.
2700 */
2701
2702 extern "C" void DynamicStrings_PopAllocation (bool halt);
2703
2704 /*
2705 PopAllocationExemption - test to see that all strings are deallocated, except
2706 string e since the last push.
2707 Post-condition: it pops to the previous allocation/deallocation
2708 lists.
2709
2710 If halt is true then the application terminates
2711 with an exit code of 1.
2712 */
2713
2714 extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (bool halt, DynamicStrings_String e);
2715 extern "C" DynamicStrings_String StringConvert_IntegerToString (int i, unsigned int width, char padding, bool sign, unsigned int base, bool lower);
2716 extern "C" DynamicStrings_String StringConvert_CardinalToString (unsigned int c, unsigned int width, char padding, unsigned int base, bool lower);
2717 extern "C" int StringConvert_StringToInteger (DynamicStrings_String s, unsigned int base, bool *found);
2718 extern "C" unsigned int StringConvert_StringToCardinal (DynamicStrings_String s, unsigned int base, bool *found);
2719 extern "C" DynamicStrings_String StringConvert_LongIntegerToString (long int i, unsigned int width, char padding, bool sign, unsigned int base, bool lower);
2720 extern "C" long int StringConvert_StringToLongInteger (DynamicStrings_String s, unsigned int base, bool *found);
2721 extern "C" DynamicStrings_String StringConvert_LongCardinalToString (long unsigned int c, unsigned int width, char padding, unsigned int base, bool lower);
2722 extern "C" long unsigned int StringConvert_StringToLongCardinal (DynamicStrings_String s, unsigned int base, bool *found);
2723 extern "C" DynamicStrings_String StringConvert_ShortCardinalToString (short unsigned int c, unsigned int width, char padding, unsigned int base, bool lower);
2724 extern "C" short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, bool *found);
2725 extern "C" int StringConvert_stoi (DynamicStrings_String s);
2726 extern "C" DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, bool sign);
2727 extern "C" DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding);
2728 extern "C" unsigned int StringConvert_stoc (DynamicStrings_String s);
2729 extern "C" int StringConvert_hstoi (DynamicStrings_String s);
2730 extern "C" int StringConvert_ostoi (DynamicStrings_String s);
2731 extern "C" int StringConvert_bstoi (DynamicStrings_String s);
2732 extern "C" unsigned int StringConvert_hstoc (DynamicStrings_String s);
2733 extern "C" unsigned int StringConvert_ostoc (DynamicStrings_String s);
2734 extern "C" unsigned int StringConvert_bstoc (DynamicStrings_String s);
2735 extern "C" long double StringConvert_StringToLongreal (DynamicStrings_String s, bool *found);
2736 extern "C" DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth);
2737 extern "C" double StringConvert_stor (DynamicStrings_String s);
2738 extern "C" long double StringConvert_stolr (DynamicStrings_String s);
2739 extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s, unsigned int n);
2740 extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n);
2741 extern "C" DynamicStrings_String mcOptions_handleOptions (void);
2742 extern "C" bool mcOptions_getQuiet (void);
2743 extern "C" bool mcOptions_getVerbose (void);
2744 extern "C" bool mcOptions_getInternalDebugging (void);
2745 extern "C" DynamicStrings_String mcOptions_getCppCommandLine (void);
2746 extern "C" DynamicStrings_String mcOptions_getOutputFile (void);
2747 extern "C" bool mcOptions_getExtendedOpaque (void);
2748 extern "C" void mcOptions_setDebugTopological (bool value);
2749 extern "C" bool mcOptions_getDebugTopological (void);
2750 extern "C" DynamicStrings_String mcOptions_getHPrefix (void);
2751 extern "C" bool mcOptions_getIgnoreFQ (void);
2752 extern "C" bool mcOptions_getGccConfigSystem (void);
2753 extern "C" bool mcOptions_getScaffoldDynamic (void);
2754 extern "C" bool mcOptions_getScaffoldMain (void);
2755 extern "C" void mcOptions_writeGPLheader (FIO_File f);
2756 extern "C" void mcOptions_setSuppressNoReturn (bool value);
2757 extern "C" bool mcOptions_getSuppressNoReturn (void);
2758 extern "C" bool mcOptions_useBool (void);
2759 extern "C" DynamicStrings_String mcOptions_getCRealType (void);
2760 extern "C" DynamicStrings_String mcOptions_getCLongRealType (void);
2761 extern "C" DynamicStrings_String mcOptions_getCShortRealType (void);
2762 extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt);
2763 extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high);
2764 extern "C" DynamicStrings_String FormatStrings_Sprintf2 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
2765 extern "C" DynamicStrings_String FormatStrings_Sprintf3 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
2766 extern "C" DynamicStrings_String FormatStrings_Sprintf4 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
2767 extern "C" DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s);
2768 extern "C" ssize_t libc_write (int d, void * buf, size_t nbytes);
2769 extern "C" ssize_t libc_read (int d, void * buf, size_t nbytes);
2770 extern "C" int libc_system (void * a);
2771 extern "C" void libc_abort (void) __attribute__ ((noreturn));
2772 extern "C" void * libc_malloc (size_t size);
2773 extern "C" void libc_free (void * ptr);
2774 extern "C" void * libc_realloc (void * ptr, size_t size);
2775 extern "C" int libc_isatty (int fd);
2776 extern "C" void libc_exit (int r) __attribute__ ((noreturn));
2777 extern "C" void * libc_getenv (void * s);
2778 extern "C" int libc_putenv (void * s);
2779 extern "C" int libc_getpid (void);
2780 extern "C" int libc_dup (int d);
2781 extern "C" int libc_close (int d);
2782 extern "C" int libc_open (void * filename, int oflag, ...);
2783 extern "C" int libc_creat (void * filename, unsigned int mode);
2784 extern "C" long int libc_lseek (int fd, long int offset, int whence);
2785 extern "C" void libc_perror (const char *string_, unsigned int _string_high);
2786 extern "C" int libc_readv (int fd, void * v, int n);
2787 extern "C" int libc_writev (int fd, void * v, int n);
2788 extern "C" void * libc_getcwd (void * buf, size_t size);
2789 extern "C" int libc_chown (void * filename, int uid, int gid);
2790 extern "C" size_t libc_strlen (void * a);
2791 extern "C" void * libc_strcpy (void * dest, void * src);
2792 extern "C" void * libc_strncpy (void * dest, void * src, unsigned int n);
2793 extern "C" int libc_unlink (void * file);
2794 extern "C" void * libc_memcpy (void * dest, void * src, size_t size);
2795 extern "C" void * libc_memset (void * s, int c, size_t size);
2796 extern "C" void * libc_memmove (void * dest, void * src, size_t size);
2797 extern "C" int libc_printf (const char *format_, unsigned int _format_high, ...);
2798 extern "C" int libc_snprintf (void * dest, size_t size, const char *format_, unsigned int _format_high, ...);
2799 extern "C" int libc_setenv (void * name, void * value, int overwrite);
2800 extern "C" void libc_srand (int seed);
2801 extern "C" int libc_rand (void);
2802 extern "C" libc_time_t libc_time (void * a);
2803 extern "C" void * libc_localtime (libc_time_t *t);
2804 extern "C" int libc_ftime (libc_timeb *t);
2805 extern "C" int libc_shutdown (int s, int how);
2806 extern "C" int libc_rename (void * oldpath, void * newpath);
2807 extern "C" int libc_setjmp (void * env);
2808 extern "C" void libc_longjmp (void * env, int val);
2809 extern "C" int libc_atexit (libc_exitP_C proc);
2810 extern "C" void * libc_ttyname (int filedes);
2811 extern "C" unsigned int libc_sleep (unsigned int seconds);
2812 extern "C" int libc_execv (void * pathname, void * argv);
2813 extern "C" void mcMetaError_metaError1 (const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high);
2814 extern "C" void mcMetaError_metaError2 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
2815 extern "C" void mcMetaError_metaError3 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
2816 extern "C" void mcMetaError_metaError4 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
2817 extern "C" void mcMetaError_metaErrors1 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high);
2818 extern "C" void mcMetaError_metaErrors2 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
2819 extern "C" void mcMetaError_metaErrors3 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
2820 extern "C" void mcMetaError_metaErrors4 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
2821 extern "C" void mcMetaError_metaErrorT1 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high);
2822 extern "C" void mcMetaError_metaErrorT2 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
2823 extern "C" void mcMetaError_metaErrorT3 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
2824 extern "C" void mcMetaError_metaErrorT4 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
2825 extern "C" void mcMetaError_metaErrorsT1 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high);
2826 extern "C" void mcMetaError_metaErrorsT2 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
2827 extern "C" void mcMetaError_metaErrorsT3 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
2828 extern "C" void mcMetaError_metaErrorsT4 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
2829 extern "C" void mcMetaError_metaErrorString1 (DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high);
2830 extern "C" void mcMetaError_metaErrorString2 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
2831 extern "C" void mcMetaError_metaErrorString3 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
2832 extern "C" void mcMetaError_metaErrorString4 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
2833 extern "C" void mcMetaError_metaErrorStringT1 (unsigned int tok, DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high);
2834 extern "C" void mcMetaError_metaErrorStringT2 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
2835 extern "C" void mcMetaError_metaErrorStringT3 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
2836 extern "C" void mcMetaError_metaErrorStringT4 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
2837
2838 /*
2839 internalError - displays an internal error message together with the compiler source
2840 file and line number.
2841 This function is not buffered and is used when the compiler is about
2842 to give up.
2843 */
2844
2845 extern "C" void mcError_internalError (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line);
2846
2847 /*
2848 writeFormat0 - displays the source module and line together
2849 with the encapsulated format string.
2850 Used for simple error messages tied to the current token.
2851 */
2852
2853 extern "C" void mcError_writeFormat0 (const char *a_, unsigned int _a_high);
2854
2855 /*
2856 writeFormat1 - displays the source module and line together
2857 with the encapsulated format string.
2858 Used for simple error messages tied to the current token.
2859 */
2860
2861 extern "C" void mcError_writeFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
2862
2863 /*
2864 writeFormat2 - displays the module and line together with the encapsulated
2865 format strings.
2866 Used for simple error messages tied to the current token.
2867 */
2868
2869 extern "C" void mcError_writeFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
2870
2871 /*
2872 writeFormat3 - displays the module and line together with the encapsulated
2873 format strings.
2874 Used for simple error messages tied to the current token.
2875 */
2876
2877 extern "C" void mcError_writeFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
2878
2879 /*
2880 newError - creates and returns a new error handle.
2881 */
2882
2883 extern "C" mcError_error mcError_newError (unsigned int atTokenNo);
2884
2885 /*
2886 newWarning - creates and returns a new error handle suitable for a warning.
2887 A warning will not stop compilation.
2888 */
2889
2890 extern "C" mcError_error mcError_newWarning (unsigned int atTokenNo);
2891
2892 /*
2893 chainError - creates and returns a new error handle, this new error
2894 is associated with, e, and is chained onto the end of, e.
2895 If, e, is NIL then the result to NewError is returned.
2896 */
2897
2898 extern "C" mcError_error mcError_chainError (unsigned int atTokenNo, mcError_error e);
2899 extern "C" void mcError_errorFormat0 (mcError_error e, const char *a_, unsigned int _a_high);
2900 extern "C" void mcError_errorFormat1 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
2901 extern "C" void mcError_errorFormat2 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
2902 extern "C" void mcError_errorFormat3 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
2903 extern "C" void mcError_errorString (mcError_error e, DynamicStrings_String str);
2904
2905 /*
2906 errorStringAt - given an error string, s, it places this
2907 string at token position, tok.
2908 The string is consumed.
2909 */
2910
2911 extern "C" void mcError_errorStringAt (DynamicStrings_String s, unsigned int tok);
2912
2913 /*
2914 errorStringAt2 - given an error string, s, it places this
2915 string at token positions, tok1 and tok2, respectively.
2916 The string is consumed.
2917 */
2918
2919 extern "C" void mcError_errorStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2);
2920
2921 /*
2922 errorStringsAt2 - given error strings, s1, and, s2, it places these
2923 strings at token positions, tok1 and tok2, respectively.
2924 Both strings are consumed.
2925 */
2926
2927 extern "C" void mcError_errorStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2);
2928
2929 /*
2930 warnStringAt - given an error string, s, it places this
2931 string at token position, tok.
2932 The string is consumed.
2933 */
2934
2935 extern "C" void mcError_warnStringAt (DynamicStrings_String s, unsigned int tok);
2936
2937 /*
2938 warnStringAt2 - given an warning string, s, it places this
2939 string at token positions, tok1 and tok2, respectively.
2940 The string is consumed.
2941 */
2942
2943 extern "C" void mcError_warnStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2);
2944
2945 /*
2946 warnStringsAt2 - given warning strings, s1, and, s2, it places these
2947 strings at token positions, tok1 and tok2, respectively.
2948 Both strings are consumed.
2949 */
2950
2951 extern "C" void mcError_warnStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2);
2952 extern "C" void mcError_warnFormat0 (const char *a_, unsigned int _a_high);
2953
2954 /*
2955 warnFormat1 - displays the source module and line together
2956 with the encapsulated format string.
2957 Used for simple warning messages tied to the current token.
2958 */
2959
2960 extern "C" void mcError_warnFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
2961
2962 /*
2963 flushErrors - switches the output channel to the error channel
2964 and then writes out all errors.
2965 */
2966
2967 extern "C" void mcError_flushErrors (void);
2968
2969 /*
2970 flushWarnings - switches the output channel to the error channel
2971 and then writes out all warnings.
2972 If an error is present the compilation is terminated,
2973 if warnings only were emitted then compilation will
2974 continue.
2975 */
2976
2977 extern "C" void mcError_flushWarnings (void);
2978
2979 /*
2980 errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting.
2981 */
2982
2983 extern "C" void mcError_errorAbort0 (const char *a_, unsigned int _a_high);
2984 extern "C" mcComment_commentDesc mcLexBuf_getProcedureComment (void);
2985 extern "C" mcComment_commentDesc mcLexBuf_getBodyComment (void);
2986 extern "C" mcComment_commentDesc mcLexBuf_getAfterComment (void);
2987 extern "C" bool mcLexBuf_openSource (DynamicStrings_String s);
2988 extern "C" void mcLexBuf_closeSource (void);
2989 extern "C" void mcLexBuf_reInitialize (void);
2990 extern "C" void mcLexBuf_resetForNewPass (void);
2991 extern "C" void mcLexBuf_getToken (void);
2992 extern "C" void mcLexBuf_insertToken (mcReserved_toktype token);
2993 extern "C" void mcLexBuf_insertTokenAndRewind (mcReserved_toktype token);
2994 extern "C" unsigned int mcLexBuf_getPreviousTokenLineNo (void);
2995 extern "C" unsigned int mcLexBuf_getLineNo (void);
2996 extern "C" unsigned int mcLexBuf_getTokenNo (void);
2997 extern "C" unsigned int mcLexBuf_tokenToLineNo (unsigned int tokenNo, unsigned int depth);
2998 extern "C" unsigned int mcLexBuf_getColumnNo (void);
2999 extern "C" unsigned int mcLexBuf_tokenToColumnNo (unsigned int tokenNo, unsigned int depth);
3000 extern "C" DynamicStrings_String mcLexBuf_findFileNameFromToken (unsigned int tokenNo, unsigned int depth);
3001 extern "C" DynamicStrings_String mcLexBuf_getFileName (void);
3002 extern "C" void mcLexBuf_addTok (mcReserved_toktype t);
3003 extern "C" void mcLexBuf_addTokCharStar (mcReserved_toktype t, void * s);
3004 extern "C" void mcLexBuf_addTokInteger (mcReserved_toktype t, int i);
3005 extern "C" void mcLexBuf_addTokComment (mcReserved_toktype t, mcComment_commentDesc com);
3006 extern "C" void mcLexBuf_setFile (void * filename);
3007 extern "C" void mcLexBuf_pushFile (void * filename);
3008 extern "C" void mcLexBuf_popFile (void * filename);
3009 extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high);
3010 extern "C" bool StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
3011 extern "C" bool StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
3012 extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high);
3013 extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high);
3014 extern "C" bool StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
3015 extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
3016
3017 /*
3018 initPretty - initialise a pretty print data structure.
3019 */
3020
3021 extern "C" mcPretty_pretty mcPretty_initPretty (mcPretty_writeProc w, mcPretty_writeLnProc l);
3022
3023 /*
3024 dupPretty - duplicate a pretty print data structure.
3025 */
3026
3027 extern "C" mcPretty_pretty mcPretty_dupPretty (mcPretty_pretty p);
3028
3029 /*
3030 killPretty - destroy a pretty print data structure.
3031 Post condition: p is assigned to NIL.
3032 */
3033
3034 extern "C" void mcPretty_killPretty (mcPretty_pretty *p);
3035
3036 /*
3037 pushPretty - duplicate, p. Push, p, and return the duplicate.
3038 */
3039
3040 extern "C" mcPretty_pretty mcPretty_pushPretty (mcPretty_pretty p);
3041
3042 /*
3043 popPretty - pops the pretty object from the stack.
3044 */
3045
3046 extern "C" mcPretty_pretty mcPretty_popPretty (mcPretty_pretty p);
3047
3048 /*
3049 getindent - returns the current indent value.
3050 */
3051
3052 extern "C" unsigned int mcPretty_getindent (mcPretty_pretty p);
3053
3054 /*
3055 setindent - sets the current indent to, n.
3056 */
3057
3058 extern "C" void mcPretty_setindent (mcPretty_pretty p, unsigned int n);
3059
3060 /*
3061 getcurpos - returns the current cursor position.
3062 */
3063
3064 extern "C" unsigned int mcPretty_getcurpos (mcPretty_pretty s);
3065
3066 /*
3067 getseekpos - returns the seek position.
3068 */
3069
3070 extern "C" unsigned int mcPretty_getseekpos (mcPretty_pretty s);
3071
3072 /*
3073 getcurline - returns the current line number.
3074 */
3075
3076 extern "C" unsigned int mcPretty_getcurline (mcPretty_pretty s);
3077 extern "C" void mcPretty_setNeedSpace (mcPretty_pretty s);
3078
3079 /*
3080 noSpace - unset needsSpace.
3081 */
3082
3083 extern "C" void mcPretty_noSpace (mcPretty_pretty s);
3084
3085 /*
3086 print - print a string using, p.
3087 */
3088
3089 extern "C" void mcPretty_print (mcPretty_pretty p, const char *a_, unsigned int _a_high);
3090
3091 /*
3092 prints - print a string using, p.
3093 */
3094
3095 extern "C" void mcPretty_prints (mcPretty_pretty p, DynamicStrings_String s);
3096
3097 /*
3098 raw - print out string, s, without any translation of
3099 escape sequences.
3100 */
3101
3102 extern "C" void mcPretty_raw (mcPretty_pretty p, DynamicStrings_String s);
3103
3104 /*
3105 InitIndex - creates and returns an Index.
3106 */
3107
3108 extern "C" Indexing_Index Indexing_InitIndex (unsigned int low);
3109
3110 /*
3111 KillIndex - returns Index to free storage.
3112 */
3113
3114 extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i);
3115
3116 /*
3117 DebugIndex - turns on debugging within an index.
3118 */
3119
3120 extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i);
3121
3122 /*
3123 InBounds - returns TRUE if indice, n, is within the bounds
3124 of the dynamic array.
3125 */
3126
3127 extern "C" bool Indexing_InBounds (Indexing_Index i, unsigned int n);
3128
3129 /*
3130 HighIndice - returns the last legally accessible indice of this array.
3131 */
3132
3133 extern "C" unsigned int Indexing_HighIndice (Indexing_Index i);
3134
3135 /*
3136 LowIndice - returns the first legally accessible indice of this array.
3137 */
3138
3139 extern "C" unsigned int Indexing_LowIndice (Indexing_Index i);
3140
3141 /*
3142 PutIndice - places, a, into the dynamic array at position i[n]
3143 */
3144
3145 extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a);
3146
3147 /*
3148 GetIndice - retrieves, element i[n] from the dynamic array.
3149 */
3150
3151 extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n);
3152
3153 /*
3154 IsIndiceInIndex - returns TRUE if, a, is in the index, i.
3155 */
3156
3157 extern "C" bool Indexing_IsIndiceInIndex (Indexing_Index i, void * a);
3158
3159 /*
3160 RemoveIndiceFromIndex - removes, a, from Index, i.
3161 */
3162
3163 extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a);
3164
3165 /*
3166 DeleteIndice - delete i[j] from the array.
3167 */
3168
3169 extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j);
3170
3171 /*
3172 IncludeIndiceIntoIndex - if the indice is not in the index, then
3173 add it at the end.
3174 */
3175
3176 extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a);
3177
3178 /*
3179 ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
3180 */
3181
3182 extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p);
3183
3184 /*
3185 initList - creates a new alist, l.
3186 */
3187
3188 extern "C" alists_alist alists_initList (void);
3189
3190 /*
3191 killList - deletes the complete alist, l.
3192 */
3193
3194 extern "C" void alists_killList (alists_alist *l);
3195
3196 /*
3197 putItemIntoList - places an ADDRESS, c, into alist, l.
3198 */
3199
3200 extern "C" void alists_putItemIntoList (alists_alist l, void * c);
3201
3202 /*
3203 getItemFromList - retrieves the nth WORD from alist, l.
3204 */
3205
3206 extern "C" void * alists_getItemFromList (alists_alist l, unsigned int n);
3207
3208 /*
3209 getIndexOfList - returns the index for WORD, c, in alist, l.
3210 If more than one WORD, c, exists the index
3211 for the first is returned.
3212 */
3213
3214 extern "C" unsigned int alists_getIndexOfList (alists_alist l, void * c);
3215
3216 /*
3217 noOfItemsInList - returns the number of items in alist, l.
3218 */
3219
3220 extern "C" unsigned int alists_noOfItemsInList (alists_alist l);
3221
3222 /*
3223 includeItemIntoList - adds an ADDRESS, c, into a alist providing
3224 the value does not already exist.
3225 */
3226
3227 extern "C" void alists_includeItemIntoList (alists_alist l, void * c);
3228
3229 /*
3230 removeItemFromList - removes a ADDRESS, c, from a alist.
3231 It assumes that this value only appears once.
3232 */
3233
3234 extern "C" void alists_removeItemFromList (alists_alist l, void * c);
3235
3236 /*
3237 isItemInList - returns true if a ADDRESS, c, was found in alist, l.
3238 */
3239
3240 extern "C" bool alists_isItemInList (alists_alist l, void * c);
3241
3242 /*
3243 foreachItemInListDo - calls procedure, P, foreach item in alist, l.
3244 */
3245
3246 extern "C" void alists_foreachItemInListDo (alists_alist l, alists_performOperation p);
3247
3248 /*
3249 duplicateList - returns a duplicate alist derived from, l.
3250 */
3251
3252 extern "C" alists_alist alists_duplicateList (alists_alist l);
3253
3254 /*
3255 initList - creates a new wlist, l.
3256 */
3257
3258 extern "C" wlists_wlist wlists_initList (void);
3259
3260 /*
3261 killList - deletes the complete wlist, l.
3262 */
3263
3264 extern "C" void wlists_killList (wlists_wlist *l);
3265
3266 /*
3267 putItemIntoList - places an WORD, c, into wlist, l.
3268 */
3269
3270 extern "C" void wlists_putItemIntoList (wlists_wlist l, unsigned int c);
3271
3272 /*
3273 getItemFromList - retrieves the nth WORD from wlist, l.
3274 */
3275
3276 extern "C" unsigned int wlists_getItemFromList (wlists_wlist l, unsigned int n);
3277
3278 /*
3279 getIndexOfList - returns the index for WORD, c, in wlist, l.
3280 If more than one WORD, c, exists the index
3281 for the first is returned.
3282 */
3283
3284 extern "C" unsigned int wlists_getIndexOfList (wlists_wlist l, unsigned int c);
3285
3286 /*
3287 noOfItemsInList - returns the number of items in wlist, l.
3288 */
3289
3290 extern "C" unsigned int wlists_noOfItemsInList (wlists_wlist l);
3291
3292 /*
3293 includeItemIntoList - adds an WORD, c, into a wlist providing
3294 the value does not already exist.
3295 */
3296
3297 extern "C" void wlists_includeItemIntoList (wlists_wlist l, unsigned int c);
3298
3299 /*
3300 removeItemFromList - removes a WORD, c, from a wlist.
3301 It assumes that this value only appears once.
3302 */
3303
3304 extern "C" void wlists_removeItemFromList (wlists_wlist l, unsigned int c);
3305
3306 /*
3307 replaceItemInList - replace the nth WORD in wlist, l.
3308 The first item in a wlists is at index, 1.
3309 If the index, n, is out of range nothing is changed.
3310 */
3311
3312 extern "C" void wlists_replaceItemInList (wlists_wlist l, unsigned int n, unsigned int w);
3313
3314 /*
3315 isItemInList - returns true if a WORD, c, was found in wlist, l.
3316 */
3317
3318 extern "C" bool wlists_isItemInList (wlists_wlist l, unsigned int c);
3319
3320 /*
3321 foreachItemInListDo - calls procedure, P, foreach item in wlist, l.
3322 */
3323
3324 extern "C" void wlists_foreachItemInListDo (wlists_wlist l, wlists_performOperation p);
3325
3326 /*
3327 duplicateList - returns a duplicate wlist derived from, l.
3328 */
3329
3330 extern "C" wlists_wlist wlists_duplicateList (wlists_wlist l);
3331 extern "C" void keyc_useUnistd (void);
3332 extern "C" void keyc_useThrow (void);
3333 extern "C" void keyc_useStorage (void);
3334 extern "C" void keyc_useFree (void);
3335 extern "C" void keyc_useMalloc (void);
3336 extern "C" void keyc_useProc (void);
3337 extern "C" void keyc_useTrue (void);
3338 extern "C" void keyc_useFalse (void);
3339 extern "C" void keyc_useNull (void);
3340 extern "C" void keyc_useMemcpy (void);
3341 extern "C" void keyc_useIntMin (void);
3342 extern "C" void keyc_useUIntMin (void);
3343 extern "C" void keyc_useLongMin (void);
3344 extern "C" void keyc_useULongMin (void);
3345 extern "C" void keyc_useCharMin (void);
3346 extern "C" void keyc_useUCharMin (void);
3347 extern "C" void keyc_useIntMax (void);
3348 extern "C" void keyc_useUIntMax (void);
3349 extern "C" void keyc_useLongMax (void);
3350 extern "C" void keyc_useULongMax (void);
3351 extern "C" void keyc_useCharMax (void);
3352 extern "C" void keyc_useUCharMax (void);
3353 extern "C" void keyc_useSize_t (void);
3354 extern "C" void keyc_useSSize_t (void);
3355 extern "C" void keyc_useLabs (void);
3356 extern "C" void keyc_useAbs (void);
3357 extern "C" void keyc_useFabs (void);
3358 extern "C" void keyc_useFabsl (void);
3359 extern "C" void keyc_useException (void);
3360 extern "C" void keyc_useComplex (void);
3361 extern "C" void keyc_useM2RTS (void);
3362 extern "C" void keyc_useStrlen (void);
3363 extern "C" void keyc_useCtype (void);
3364 extern "C" void keyc_genDefs (mcPretty_pretty p);
3365 extern "C" void keyc_genConfigSystem (mcPretty_pretty p);
3366 extern "C" void keyc_enterScope (decl_node n);
3367 extern "C" void keyc_leaveScope (decl_node n);
3368 extern "C" DynamicStrings_String keyc_cname (nameKey_Name n, bool scopes);
3369 extern "C" nameKey_Name keyc_cnamen (nameKey_Name n, bool scopes);
3370 extern "C" void keyc_cp (void);
3371 extern "C" FIO_File mcStream_openFrag (unsigned int id);
3372 extern "C" void mcStream_setDest (FIO_File f);
3373 extern "C" FIO_File mcStream_combine (void);
3374 extern "C" void mcStream_removeFiles (void);
3375 extern "C" void StrIO_WriteLn (void);
3376 extern "C" void StrIO_ReadString (char *a, unsigned int _a_high);
3377 extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high);
3378 extern "C" void NumberIO_ReadCard (unsigned int *x);
3379 extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n);
3380 extern "C" void NumberIO_ReadHex (unsigned int *x);
3381 extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n);
3382 extern "C" void NumberIO_ReadInt (int *x);
3383 extern "C" void NumberIO_WriteInt (int x, unsigned int n);
3384 extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
3385 extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x);
3386 extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
3387 extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x);
3388 extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high);
3389 extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x);
3390 extern "C" void NumberIO_ReadOct (unsigned int *x);
3391 extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n);
3392 extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
3393 extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x);
3394 extern "C" void NumberIO_ReadBin (unsigned int *x);
3395 extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n);
3396 extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
3397 extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x);
3398 extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x);
3399 extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x);
3400 extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x);
3401 extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, const char *Module_, unsigned int _Module_high, const char *Function_, unsigned int _Function_high, unsigned int LineNo);
3402 extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high);
3403 extern "C" void Assertion_Assert (bool Condition);
3404 extern "C" void StdIO_Read (char *ch);
3405 extern "C" void StdIO_Write (char ch);
3406 extern "C" void StdIO_PushOutput (StdIO_ProcWrite p);
3407 extern "C" void StdIO_PopOutput (void);
3408 extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void);
3409 extern "C" void StdIO_PushInput (StdIO_ProcRead p);
3410 extern "C" void StdIO_PopInput (void);
3411 extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void);
3412 extern "C" void mcPrintf_printf0 (const char *a_, unsigned int _a_high);
3413 extern "C" void mcPrintf_printf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
3414 extern "C" void mcPrintf_printf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
3415 extern "C" void mcPrintf_printf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
3416 extern "C" void mcPrintf_printf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
3417 extern "C" void mcPrintf_fprintf0 (FIO_File file, const char *a_, unsigned int _a_high);
3418 extern "C" void mcPrintf_fprintf1 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
3419 extern "C" void mcPrintf_fprintf2 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
3420 extern "C" void mcPrintf_fprintf3 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
3421 extern "C" void mcPrintf_fprintf4 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
3422
3423 /*
3424 newNode - create and return a new node of kind k.
3425 */
3426
3427 static decl_node newNode (decl_nodeT k);
3428
3429 /*
3430 disposeNode - dispose node, n.
3431 */
3432
3433 static void disposeNode (decl_node *n);
3434
3435 /*
3436 isLocal - returns TRUE if symbol, n, is locally declared in a procedure.
3437 */
3438
3439 static bool isLocal (decl_node n);
3440
3441 /*
3442 importEnumFields - if, n, is an enumeration type import the all fields into module, m.
3443 */
3444
3445 static void importEnumFields (decl_node m, decl_node n);
3446
3447 /*
3448 isComplex - returns TRUE if, n, is the complex type.
3449 */
3450
3451 static bool isComplex (decl_node n);
3452
3453 /*
3454 isLongComplex - returns TRUE if, n, is the longcomplex type.
3455 */
3456
3457 static bool isLongComplex (decl_node n);
3458
3459 /*
3460 isShortComplex - returns TRUE if, n, is the shortcomplex type.
3461 */
3462
3463 static bool isShortComplex (decl_node n);
3464
3465 /*
3466 isAProcType - returns TRUE if, n, is a proctype or proc node.
3467 */
3468
3469 static bool isAProcType (decl_node n);
3470
3471 /*
3472 initFixupInfo - initialize the fixupInfo record.
3473 */
3474
3475 static decl_fixupInfo initFixupInfo (void);
3476
3477 /*
3478 makeDef - returns a definition module node named, n.
3479 */
3480
3481 static decl_node makeDef (nameKey_Name n);
3482
3483 /*
3484 makeImp - returns an implementation module node named, n.
3485 */
3486
3487 static decl_node makeImp (nameKey_Name n);
3488
3489 /*
3490 makeModule - returns a module node named, n.
3491 */
3492
3493 static decl_node makeModule (nameKey_Name n);
3494
3495 /*
3496 isDefForC - returns TRUE if the definition module was defined FOR "C".
3497 */
3498
3499 static bool isDefForC (decl_node n);
3500
3501 /*
3502 initDecls - initialize the decls, scopeT.
3503 */
3504
3505 static void initDecls (decl_scopeT *decls);
3506
3507 /*
3508 addTo - adds node, d, to scope decls and returns, d.
3509 It stores, d, in the symbols tree associated with decls.
3510 */
3511
3512 static decl_node addTo (decl_scopeT *decls, decl_node d);
3513
3514 /*
3515 export - export node, n, from definition module, d.
3516 */
3517
3518 static void export_ (decl_node d, decl_node n);
3519
3520 /*
3521 addToScope - adds node, n, to the current scope and returns, n.
3522 */
3523
3524 static decl_node addToScope (decl_node n);
3525
3526 /*
3527 addModuleToScope - adds module, i, to module, m, scope.
3528 */
3529
3530 static void addModuleToScope (decl_node m, decl_node i);
3531
3532 /*
3533 completedEnum - assign boolean enumsComplete to TRUE if a definition,
3534 implementation or module symbol.
3535 */
3536
3537 static void completedEnum (decl_node n);
3538
3539 /*
3540 setUnary - sets a unary node to contain, arg, a, and type, t.
3541 */
3542
3543 static void setUnary (decl_node u, decl_nodeT k, decl_node a, decl_node t);
3544
3545 /*
3546 putVarBool - assigns the four booleans associated with a variable.
3547 */
3548
3549 static void putVarBool (decl_node v, bool init, bool param, bool isvar, bool isused);
3550
3551 /*
3552 checkPtr - in C++ we need to create a typedef for a pointer
3553 in case we need to use reinterpret_cast.
3554 */
3555
3556 static decl_node checkPtr (decl_node n);
3557
3558 /*
3559 isVarDecl - returns TRUE if, n, is a vardecl node.
3560 */
3561
3562 static bool isVarDecl (decl_node n);
3563
3564 /*
3565 makeVariablesFromParameters - creates variables which are really parameters.
3566 */
3567
3568 static void makeVariablesFromParameters (decl_node proc, decl_node id, decl_node type, bool isvar, bool isused);
3569
3570 /*
3571 addProcedureToScope - add a procedure name n and node d to the
3572 current scope.
3573 */
3574
3575 static decl_node addProcedureToScope (decl_node d, nameKey_Name n);
3576
3577 /*
3578 putProcTypeReturn - sets the return type of, proc, to, type.
3579 */
3580
3581 static void putProcTypeReturn (decl_node proc, decl_node type);
3582
3583 /*
3584 putProcTypeOptReturn - sets, proc, to have an optional return type.
3585 */
3586
3587 static void putProcTypeOptReturn (decl_node proc);
3588
3589 /*
3590 makeOptParameter - creates and returns an optarg.
3591 */
3592
3593 static decl_node makeOptParameter (decl_node l, decl_node type, decl_node init);
3594
3595 /*
3596 setwatch - assign the globalNode to n.
3597 */
3598
3599 static bool setwatch (decl_node n);
3600
3601 /*
3602 runwatch - set the globalNode to an identlist.
3603 */
3604
3605 static bool runwatch (void);
3606
3607 /*
3608 isIdentList - returns TRUE if, n, is an identlist.
3609 */
3610
3611 static bool isIdentList (decl_node n);
3612
3613 /*
3614 identListLen - returns the length of identlist.
3615 */
3616
3617 static unsigned int identListLen (decl_node n);
3618
3619 /*
3620 checkParameters - placeholder for future parameter checking.
3621 */
3622
3623 static void checkParameters (decl_node p, decl_node i, decl_node type, bool isvar, bool isused);
3624
3625 /*
3626 checkMakeVariables - create shadow local variables for parameters providing that
3627 procedure n has not already been built and we are compiling
3628 a module or an implementation module.
3629 */
3630
3631 static void checkMakeVariables (decl_node n, decl_node i, decl_node type, bool isvar, bool isused);
3632
3633 /*
3634 makeVarientField - create a varient field within varient, v,
3635 The new varient field is returned.
3636 */
3637
3638 static decl_node makeVarientField (decl_node v, decl_node p);
3639
3640 /*
3641 putFieldVarient - places the field varient, f, as a brother to, the
3642 varient symbol, v, and also tells, f, that its varient
3643 parent is, v.
3644 */
3645
3646 static void putFieldVarient (decl_node f, decl_node v);
3647
3648 /*
3649 putFieldRecord - create a new recordfield and place it into record r.
3650 The new field has a tagname and type and can have a
3651 variant field v.
3652 */
3653
3654 static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type, decl_node v);
3655
3656 /*
3657 ensureOrder - ensures that, a, and, b, exist in, i, and also
3658 ensure that, a, is before, b.
3659 */
3660
3661 static void ensureOrder (Indexing_Index i, decl_node a, decl_node b);
3662
3663 /*
3664 putVarientTag - places tag into variant v.
3665 */
3666
3667 static void putVarientTag (decl_node v, decl_node tag);
3668
3669 /*
3670 getParent - returns the parent field of recordfield or varientfield symbol, n.
3671 */
3672
3673 static decl_node getParent (decl_node n);
3674
3675 /*
3676 getRecord - returns the record associated with node, n.
3677 (Parental record).
3678 */
3679
3680 static decl_node getRecord (decl_node n);
3681
3682 /*
3683 isConstExp - return TRUE if the node kind is a constexp.
3684 */
3685
3686 static bool isConstExp (decl_node c);
3687
3688 /*
3689 addEnumToModule - adds enumeration type, e, into the list of enums
3690 in module, m.
3691 */
3692
3693 static void addEnumToModule (decl_node m, decl_node e);
3694
3695 /*
3696 getNextFixup - return the next fixup from from f.
3697 */
3698
3699 static decl_node getNextFixup (decl_fixupInfo *f);
3700
3701 /*
3702 doMakeEnum - create an enumeration type and add it to the current module.
3703 */
3704
3705 static decl_node doMakeEnum (void);
3706
3707 /*
3708 doMakeEnumField - create an enumeration field name and add it to enumeration e.
3709 Return the new field.
3710 */
3711
3712 static decl_node doMakeEnumField (decl_node e, nameKey_Name n);
3713
3714 /*
3715 getExpList - returns the, n, th argument in an explist.
3716 */
3717
3718 static decl_node getExpList (decl_node p, unsigned int n);
3719
3720 /*
3721 expListLen - returns the length of explist, p.
3722 */
3723
3724 static unsigned int expListLen (decl_node p);
3725
3726 /*
3727 getConstExpComplete - gets the field from the def or imp or module, n.
3728 */
3729
3730 static bool getConstExpComplete (decl_node n);
3731
3732 /*
3733 addConstToModule - adds const exp, e, into the list of constant
3734 expressions in module, m.
3735 */
3736
3737 static void addConstToModule (decl_node m, decl_node e);
3738
3739 /*
3740 doMakeConstExp - create a constexp node and add it to the current module.
3741 */
3742
3743 static decl_node doMakeConstExp (void);
3744
3745 /*
3746 isAnyType - return TRUE if node n is any type kind.
3747 */
3748
3749 static bool isAnyType (decl_node n);
3750
3751 /*
3752 makeVal - creates a VAL (type, expression) node.
3753 */
3754
3755 static decl_node makeVal (decl_node params);
3756
3757 /*
3758 makeCast - creates a cast node TYPENAME (expr).
3759 */
3760
3761 static decl_node makeCast (decl_node c, decl_node p);
3762 static decl_node makeIntrinsicProc (decl_nodeT k, unsigned int noArgs, decl_node p);
3763
3764 /*
3765 makeIntrinsicUnaryType - create an intrisic unary type.
3766 */
3767
3768 static decl_node makeIntrinsicUnaryType (decl_nodeT k, decl_node paramList, decl_node returnType);
3769
3770 /*
3771 makeIntrinsicBinaryType - create an intrisic binary type.
3772 */
3773
3774 static decl_node makeIntrinsicBinaryType (decl_nodeT k, decl_node paramList, decl_node returnType);
3775
3776 /*
3777 checkIntrinsic - checks to see if the function call to, c, with
3778 parameter list, n, is really an intrinic. If it
3779 is an intrinic then an intrinic node is created
3780 and returned. Otherwise NIL is returned.
3781 */
3782
3783 static decl_node checkIntrinsic (decl_node c, decl_node n);
3784
3785 /*
3786 checkCHeaders - check to see if the function is a C system function and
3787 requires a header file included.
3788 */
3789
3790 static void checkCHeaders (decl_node c);
3791
3792 /*
3793 isFuncCall - returns TRUE if, n, is a function/procedure call.
3794 */
3795
3796 static bool isFuncCall (decl_node n);
3797
3798 /*
3799 putTypeInternal - marks type, des, as being an internally generated type.
3800 */
3801
3802 static void putTypeInternal (decl_node des);
3803
3804 /*
3805 isTypeInternal - returns TRUE if type, n, is internal.
3806 */
3807
3808 static bool isTypeInternal (decl_node n);
3809
3810 /*
3811 lookupBase - return node named n from the base symbol scope.
3812 */
3813
3814 static decl_node lookupBase (nameKey_Name n);
3815
3816 /*
3817 dumpScopes - display the names of all the scopes stacked.
3818 */
3819
3820 static void dumpScopes (void);
3821
3822 /*
3823 out0 - write string a to StdOut.
3824 */
3825
3826 static void out0 (const char *a_, unsigned int _a_high);
3827
3828 /*
3829 out1 - write string a to StdOut using format specifier a.
3830 */
3831
3832 static void out1 (const char *a_, unsigned int _a_high, decl_node s);
3833
3834 /*
3835 out2 - write string a to StdOut using format specifier a.
3836 */
3837
3838 static void out2 (const char *a_, unsigned int _a_high, unsigned int c, decl_node s);
3839
3840 /*
3841 out3 - write string a to StdOut using format specifier a.
3842 */
3843
3844 static void out3 (const char *a_, unsigned int _a_high, unsigned int l, nameKey_Name n, decl_node s);
3845
3846 /*
3847 isUnary - returns TRUE if, n, is an unary node.
3848 */
3849
3850 static bool isUnary (decl_node n);
3851
3852 /*
3853 isBinary - returns TRUE if, n, is an binary node.
3854 */
3855
3856 static bool isBinary (decl_node n);
3857
3858 /*
3859 makeUnary - create a unary expression node with, e, as the argument
3860 and res as the return type.
3861 */
3862
3863 static decl_node makeUnary (decl_nodeT k, decl_node e, decl_node res);
3864
3865 /*
3866 isLeafString - returns TRUE if n is a leaf node which is a string constant.
3867 */
3868
3869 static bool isLeafString (decl_node n);
3870
3871 /*
3872 getLiteralStringContents - return the contents of a literal node as a string.
3873 */
3874
3875 static DynamicStrings_String getLiteralStringContents (decl_node n);
3876
3877 /*
3878 getStringContents - return the string contents of a constant, literal,
3879 string or a constexp node.
3880 */
3881
3882 static DynamicStrings_String getStringContents (decl_node n);
3883
3884 /*
3885 addNames -
3886 */
3887
3888 static nameKey_Name addNames (decl_node a, decl_node b);
3889
3890 /*
3891 resolveString -
3892 */
3893
3894 static decl_node resolveString (decl_node n);
3895
3896 /*
3897 foldBinary -
3898 */
3899
3900 static decl_node foldBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res);
3901
3902 /*
3903 makeBinary - create a binary node with left/right/result type: l, r and resultType.
3904 */
3905
3906 static decl_node makeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node resultType);
3907
3908 /*
3909 doMakeBinary - returns a binary node containing left/right/result values
3910 l, r, res, with a node operator, k.
3911 */
3912
3913 static decl_node doMakeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res);
3914
3915 /*
3916 doMakeComponentRef -
3917 */
3918
3919 static decl_node doMakeComponentRef (decl_node rec, decl_node field);
3920
3921 /*
3922 isComponentRef -
3923 */
3924
3925 static bool isComponentRef (decl_node n);
3926
3927 /*
3928 isArrayRef - returns TRUE if the node was an arrayref.
3929 */
3930
3931 static bool isArrayRef (decl_node n);
3932
3933 /*
3934 isDeref - returns TRUE if, n, is a deref node.
3935 */
3936
3937 static bool isDeref (decl_node n);
3938
3939 /*
3940 makeBase - create a base type or constant.
3941 It only supports the base types and constants
3942 enumerated below.
3943 */
3944
3945 static decl_node makeBase (decl_nodeT k);
3946
3947 /*
3948 isOrdinal - returns TRUE if, n, is an ordinal type.
3949 */
3950
3951 static bool isOrdinal (decl_node n);
3952
3953 /*
3954 mixTypes -
3955 */
3956
3957 static decl_node mixTypes (decl_node a, decl_node b);
3958
3959 /*
3960 doSetExprType -
3961 */
3962
3963 static decl_node doSetExprType (decl_node *t, decl_node n);
3964
3965 /*
3966 getMaxMinType -
3967 */
3968
3969 static decl_node getMaxMinType (decl_node n);
3970
3971 /*
3972 doGetFuncType -
3973 */
3974
3975 static decl_node doGetFuncType (decl_node n);
3976
3977 /*
3978 doGetExprType - works out the type which is associated with node, n.
3979 */
3980
3981 static decl_node doGetExprType (decl_node n);
3982
3983 /*
3984 getExprType - return the expression type.
3985 */
3986
3987 static decl_node getExprType (decl_node n);
3988
3989 /*
3990 openOutput -
3991 */
3992
3993 static void openOutput (void);
3994
3995 /*
3996 closeOutput -
3997 */
3998
3999 static void closeOutput (void);
4000
4001 /*
4002 write - outputs a single char, ch.
4003 */
4004
4005 static void write_ (char ch);
4006
4007 /*
4008 writeln -
4009 */
4010
4011 static void writeln (void);
4012
4013 /*
4014 doIncludeC - include header file for definition module, n.
4015 */
4016
4017 static void doIncludeC (decl_node n);
4018
4019 /*
4020 getSymScope - returns the scope where node, n, was declared.
4021 */
4022
4023 static decl_node getSymScope (decl_node n);
4024
4025 /*
4026 isQualifiedForced - should the node be written with a module prefix?
4027 */
4028
4029 static bool isQualifiedForced (decl_node n);
4030
4031 /*
4032 getFQstring -
4033 */
4034
4035 static DynamicStrings_String getFQstring (decl_node n);
4036
4037 /*
4038 getFQDstring -
4039 */
4040
4041 static DynamicStrings_String getFQDstring (decl_node n, bool scopes);
4042
4043 /*
4044 getString - returns the name as a string.
4045 */
4046
4047 static DynamicStrings_String getString (decl_node n);
4048
4049 /*
4050 doNone - call HALT.
4051 */
4052
4053 static void doNone (decl_node n);
4054
4055 /*
4056 doNothing - does nothing!
4057 */
4058
4059 static void doNothing (decl_node n);
4060
4061 /*
4062 doConstC -
4063 */
4064
4065 static void doConstC (decl_node n);
4066
4067 /*
4068 needsParen - returns TRUE if expression, n, needs to be enclosed in ().
4069 */
4070
4071 static bool needsParen (decl_node n);
4072
4073 /*
4074 doUnary -
4075 */
4076
4077 static void doUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr, decl_node type, bool l, bool r);
4078
4079 /*
4080 doSetSub - perform l & (~ r)
4081 */
4082
4083 static void doSetSub (mcPretty_pretty p, decl_node left, decl_node right);
4084
4085 /*
4086 doPolyBinary -
4087 */
4088
4089 static void doPolyBinary (mcPretty_pretty p, decl_nodeT op, decl_node left, decl_node right, bool l, bool r);
4090
4091 /*
4092 doBinary -
4093 */
4094
4095 static void doBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, bool l, bool r, bool unpackProc);
4096
4097 /*
4098 doPostUnary -
4099 */
4100
4101 static void doPostUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr);
4102
4103 /*
4104 doDeRefC -
4105 */
4106
4107 static void doDeRefC (mcPretty_pretty p, decl_node expr);
4108
4109 /*
4110 doGetLastOp - returns, a, if b is a terminal otherwise walk right.
4111 */
4112
4113 static decl_node doGetLastOp (decl_node a, decl_node b);
4114
4115 /*
4116 doComponentRefC -
4117 */
4118
4119 static void doComponentRefC (mcPretty_pretty p, decl_node l, decl_node r);
4120
4121 /*
4122 doPointerRefC -
4123 */
4124
4125 static void doPointerRefC (mcPretty_pretty p, decl_node l, decl_node r);
4126
4127 /*
4128 doPreBinary -
4129 */
4130
4131 static void doPreBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, bool l, bool r);
4132
4133 /*
4134 doConstExpr -
4135 */
4136
4137 static void doConstExpr (mcPretty_pretty p, decl_node n);
4138
4139 /*
4140 doEnumerationField -
4141 */
4142
4143 static void doEnumerationField (mcPretty_pretty p, decl_node n);
4144
4145 /*
4146 isZero - returns TRUE if node, n, is zero.
4147 */
4148
4149 static bool isZero (decl_node n);
4150
4151 /*
4152 doArrayRef -
4153 */
4154
4155 static void doArrayRef (mcPretty_pretty p, decl_node n);
4156
4157 /*
4158 doProcedure -
4159 */
4160
4161 static void doProcedure (mcPretty_pretty p, decl_node n);
4162
4163 /*
4164 doRecordfield -
4165 */
4166
4167 static void doRecordfield (mcPretty_pretty p, decl_node n);
4168
4169 /*
4170 doCastC -
4171 */
4172
4173 static void doCastC (mcPretty_pretty p, decl_node t, decl_node e);
4174
4175 /*
4176 doSetValueC -
4177 */
4178
4179 static void doSetValueC (mcPretty_pretty p, decl_node n);
4180
4181 /*
4182 getSetLow - returns the low value of the set type from
4183 expression, n.
4184 */
4185
4186 static decl_node getSetLow (decl_node n);
4187
4188 /*
4189 doInC - performs (((1 << (l)) & (r)) != 0)
4190 */
4191
4192 static void doInC (mcPretty_pretty p, decl_node l, decl_node r);
4193
4194 /*
4195 doThrowC -
4196 */
4197
4198 static void doThrowC (mcPretty_pretty p, decl_node n);
4199
4200 /*
4201 doUnreachableC -
4202 */
4203
4204 static void doUnreachableC (mcPretty_pretty p, decl_node n);
4205
4206 /*
4207 outNull -
4208 */
4209
4210 static void outNull (mcPretty_pretty p);
4211
4212 /*
4213 outTrue -
4214 */
4215
4216 static void outTrue (mcPretty_pretty p);
4217
4218 /*
4219 outFalse -
4220 */
4221
4222 static void outFalse (mcPretty_pretty p);
4223
4224 /*
4225 doExprC -
4226 */
4227
4228 static void doExprC (mcPretty_pretty p, decl_node n);
4229
4230 /*
4231 doExprCup -
4232 */
4233
4234 static void doExprCup (mcPretty_pretty p, decl_node n, bool unpackProc);
4235
4236 /*
4237 doExprM2 -
4238 */
4239
4240 static void doExprM2 (mcPretty_pretty p, decl_node n);
4241
4242 /*
4243 doVar -
4244 */
4245
4246 static void doVar (mcPretty_pretty p, decl_node n);
4247
4248 /*
4249 doLiteralC -
4250 */
4251
4252 static void doLiteralC (mcPretty_pretty p, decl_node n);
4253
4254 /*
4255 doLiteral -
4256 */
4257
4258 static void doLiteral (mcPretty_pretty p, decl_node n);
4259
4260 /*
4261 isString - returns TRUE if node, n, is a string.
4262 */
4263
4264 static bool isString (decl_node n);
4265
4266 /*
4267 doString -
4268 */
4269
4270 static void doString (mcPretty_pretty p, decl_node n);
4271
4272 /*
4273 replaceChar - replace every occurance of, ch, by, a and return modified string, s.
4274 */
4275
4276 static DynamicStrings_String replaceChar (DynamicStrings_String s, char ch, const char *a_, unsigned int _a_high);
4277
4278 /*
4279 toCstring - translates string, n, into a C string
4280 and returns the new String.
4281 */
4282
4283 static DynamicStrings_String toCstring (nameKey_Name n);
4284
4285 /*
4286 toCchar -
4287 */
4288
4289 static DynamicStrings_String toCchar (nameKey_Name n);
4290
4291 /*
4292 countChar -
4293 */
4294
4295 static unsigned int countChar (DynamicStrings_String s, char ch);
4296
4297 /*
4298 lenCstring -
4299 */
4300
4301 static unsigned int lenCstring (DynamicStrings_String s);
4302
4303 /*
4304 outCstring -
4305 */
4306
4307 static void outCstring (mcPretty_pretty p, decl_node s, bool aString);
4308
4309 /*
4310 doStringC -
4311 */
4312
4313 static void doStringC (mcPretty_pretty p, decl_node n);
4314
4315 /*
4316 isPunct -
4317 */
4318
4319 static bool isPunct (char ch);
4320
4321 /*
4322 isWhite -
4323 */
4324
4325 static bool isWhite (char ch);
4326
4327 /*
4328 outText -
4329 */
4330
4331 static void outText (mcPretty_pretty p, const char *a_, unsigned int _a_high);
4332
4333 /*
4334 outRawS -
4335 */
4336
4337 static void outRawS (mcPretty_pretty p, DynamicStrings_String s);
4338
4339 /*
4340 outKm2 -
4341 */
4342
4343 static mcPretty_pretty outKm2 (mcPretty_pretty p, const char *a_, unsigned int _a_high);
4344
4345 /*
4346 outKc -
4347 */
4348
4349 static mcPretty_pretty outKc (mcPretty_pretty p, const char *a_, unsigned int _a_high);
4350
4351 /*
4352 outTextS -
4353 */
4354
4355 static void outTextS (mcPretty_pretty p, DynamicStrings_String s);
4356
4357 /*
4358 outCard -
4359 */
4360
4361 static void outCard (mcPretty_pretty p, unsigned int c);
4362
4363 /*
4364 outTextN -
4365 */
4366
4367 static void outTextN (mcPretty_pretty p, nameKey_Name n);
4368
4369 /*
4370 doTypeAliasC -
4371 */
4372
4373 static void doTypeAliasC (mcPretty_pretty p, decl_node n, decl_node *m);
4374
4375 /*
4376 doEnumerationC -
4377 */
4378
4379 static void doEnumerationC (mcPretty_pretty p, decl_node n);
4380
4381 /*
4382 doNamesC -
4383 */
4384
4385 static void doNamesC (mcPretty_pretty p, nameKey_Name n);
4386
4387 /*
4388 doNameC -
4389 */
4390
4391 static void doNameC (mcPretty_pretty p, decl_node n);
4392
4393 /*
4394 initCname -
4395 */
4396
4397 static void initCname (decl_cnameT *c);
4398
4399 /*
4400 doCname -
4401 */
4402
4403 static nameKey_Name doCname (nameKey_Name n, decl_cnameT *c, bool scopes);
4404
4405 /*
4406 getDName -
4407 */
4408
4409 static nameKey_Name getDName (decl_node n, bool scopes);
4410
4411 /*
4412 doDNameC -
4413 */
4414
4415 static void doDNameC (mcPretty_pretty p, decl_node n, bool scopes);
4416
4417 /*
4418 doFQDNameC -
4419 */
4420
4421 static void doFQDNameC (mcPretty_pretty p, decl_node n, bool scopes);
4422
4423 /*
4424 doFQNameC -
4425 */
4426
4427 static void doFQNameC (mcPretty_pretty p, decl_node n);
4428
4429 /*
4430 doNameM2 -
4431 */
4432
4433 static void doNameM2 (mcPretty_pretty p, decl_node n);
4434
4435 /*
4436 doUsed -
4437 */
4438
4439 static void doUsed (mcPretty_pretty p, bool used);
4440
4441 /*
4442 doHighC -
4443 */
4444
4445 static void doHighC (mcPretty_pretty p, decl_node a, nameKey_Name n, bool isused);
4446
4447 /*
4448 doParamConstCast -
4449 */
4450
4451 static void doParamConstCast (mcPretty_pretty p, decl_node n);
4452
4453 /*
4454 getParameterVariable - returns the variable which shadows the parameter
4455 named, m, in parameter block, n.
4456 */
4457
4458 static decl_node getParameterVariable (decl_node n, nameKey_Name m);
4459
4460 /*
4461 doParamTypeEmit - emit parameter type for C/C++. It checks to see if the
4462 parameter type is a procedure type and if it were declared
4463 in a definition module for "C" and if so it uses the "C"
4464 definition for a procedure type, rather than the mc
4465 C++ version.
4466 */
4467
4468 static void doParamTypeEmit (mcPretty_pretty p, decl_node paramnode, decl_node paramtype);
4469
4470 /*
4471 doParamC - emit parameter for C/C++.
4472 */
4473
4474 static void doParamC (mcPretty_pretty p, decl_node n);
4475
4476 /*
4477 doVarParamC - emit a VAR parameter for C/C++.
4478 */
4479
4480 static void doVarParamC (mcPretty_pretty p, decl_node n);
4481
4482 /*
4483 doOptargC -
4484 */
4485
4486 static void doOptargC (mcPretty_pretty p, decl_node n);
4487
4488 /*
4489 doParameterC -
4490 */
4491
4492 static void doParameterC (mcPretty_pretty p, decl_node n);
4493
4494 /*
4495 doProcTypeC -
4496 */
4497
4498 static void doProcTypeC (mcPretty_pretty p, decl_node t, decl_node n);
4499
4500 /*
4501 doTypesC -
4502 */
4503
4504 static void doTypesC (decl_node n);
4505
4506 /*
4507 doCompletePartialC -
4508 */
4509
4510 static void doCompletePartialC (decl_node n);
4511
4512 /*
4513 doCompletePartialRecord -
4514 */
4515
4516 static void doCompletePartialRecord (mcPretty_pretty p, decl_node t, decl_node r);
4517
4518 /*
4519 doCompletePartialArray -
4520 */
4521
4522 static void doCompletePartialArray (mcPretty_pretty p, decl_node t, decl_node r);
4523
4524 /*
4525 lookupConst -
4526 */
4527
4528 static decl_node lookupConst (decl_node type, nameKey_Name n);
4529
4530 /*
4531 doMin -
4532 */
4533
4534 static decl_node doMin (decl_node n);
4535
4536 /*
4537 doMax -
4538 */
4539
4540 static decl_node doMax (decl_node n);
4541
4542 /*
4543 getMax -
4544 */
4545
4546 static decl_node getMax (decl_node n);
4547
4548 /*
4549 getMin -
4550 */
4551
4552 static decl_node getMin (decl_node n);
4553
4554 /*
4555 doSubtractC -
4556 */
4557
4558 static void doSubtractC (mcPretty_pretty p, decl_node s);
4559
4560 /*
4561 doSubrC -
4562 */
4563
4564 static void doSubrC (mcPretty_pretty p, decl_node s);
4565
4566 /*
4567 doCompletePartialProcType -
4568 */
4569
4570 static void doCompletePartialProcType (mcPretty_pretty p, decl_node t, decl_node n);
4571
4572 /*
4573 isBase -
4574 */
4575
4576 static bool isBase (decl_node n);
4577
4578 /*
4579 doBoolC -
4580 */
4581
4582 static void doBoolC (mcPretty_pretty p);
4583
4584 /*
4585 doBaseC -
4586 */
4587
4588 static void doBaseC (mcPretty_pretty p, decl_node n);
4589
4590 /*
4591 isSystem -
4592 */
4593
4594 static bool isSystem (decl_node n);
4595
4596 /*
4597 doSystemC -
4598 */
4599
4600 static void doSystemC (mcPretty_pretty p, decl_node n);
4601
4602 /*
4603 doArrayC -
4604 */
4605
4606 static void doArrayC (mcPretty_pretty p, decl_node n);
4607
4608 /*
4609 doPointerC -
4610 */
4611
4612 static void doPointerC (mcPretty_pretty p, decl_node n, decl_node *m);
4613
4614 /*
4615 doRecordFieldC -
4616 */
4617
4618 static void doRecordFieldC (mcPretty_pretty p, decl_node f);
4619
4620 /*
4621 doVarientFieldC -
4622 */
4623
4624 static void doVarientFieldC (mcPretty_pretty p, decl_node n);
4625
4626 /*
4627 doVarientC -
4628 */
4629
4630 static void doVarientC (mcPretty_pretty p, decl_node n);
4631
4632 /*
4633 doRecordC -
4634 */
4635
4636 static void doRecordC (mcPretty_pretty p, decl_node n, decl_node *m);
4637
4638 /*
4639 isBitset -
4640 */
4641
4642 static bool isBitset (decl_node n);
4643
4644 /*
4645 isNegative - returns TRUE if expression, n, is negative.
4646 */
4647
4648 static bool isNegative (decl_node n);
4649
4650 /*
4651 doSubrangeC -
4652 */
4653
4654 static void doSubrangeC (mcPretty_pretty p, decl_node n);
4655
4656 /*
4657 doSetC - generates a C type which holds the set.
4658 Currently we only support sets of size WORD.
4659 */
4660
4661 static void doSetC (mcPretty_pretty p, decl_node n);
4662
4663 /*
4664 doTypeC -
4665 */
4666
4667 static void doTypeC (mcPretty_pretty p, decl_node n, decl_node *m);
4668
4669 /*
4670 doArrayNameC - it displays the array declaration (it might be an unbounded).
4671 */
4672
4673 static void doArrayNameC (mcPretty_pretty p, decl_node n);
4674
4675 /*
4676 doRecordNameC - emit the C/C++ record name <name of n>"_r".
4677 */
4678
4679 static void doRecordNameC (mcPretty_pretty p, decl_node n);
4680
4681 /*
4682 doPointerNameC - emit the C/C++ pointer type <name of n>*.
4683 */
4684
4685 static void doPointerNameC (mcPretty_pretty p, decl_node n);
4686
4687 /*
4688 doTypeNameC -
4689 */
4690
4691 static void doTypeNameC (mcPretty_pretty p, decl_node n);
4692
4693 /*
4694 isExternal - returns TRUE if symbol, n, was declared in another module.
4695 */
4696
4697 static bool isExternal (decl_node n);
4698
4699 /*
4700 doVarC -
4701 */
4702
4703 static void doVarC (decl_node n);
4704
4705 /*
4706 doExternCP -
4707 */
4708
4709 static void doExternCP (mcPretty_pretty p);
4710
4711 /*
4712 doProcedureCommentText -
4713 */
4714
4715 static void doProcedureCommentText (mcPretty_pretty p, DynamicStrings_String s);
4716
4717 /*
4718 doProcedureComment -
4719 */
4720
4721 static void doProcedureComment (mcPretty_pretty p, DynamicStrings_String s);
4722
4723 /*
4724 doProcedureHeadingC -
4725 */
4726
4727 static void doProcedureHeadingC (decl_node n, bool prototype);
4728
4729 /*
4730 checkDeclareUnboundedParamCopyC -
4731 */
4732
4733 static bool checkDeclareUnboundedParamCopyC (mcPretty_pretty p, decl_node n);
4734
4735 /*
4736 checkUnboundedParamCopyC -
4737 */
4738
4739 static void checkUnboundedParamCopyC (mcPretty_pretty p, decl_node n);
4740
4741 /*
4742 doUnboundedParamCopyC -
4743 */
4744
4745 static void doUnboundedParamCopyC (mcPretty_pretty p, decl_node n);
4746
4747 /*
4748 doPrototypeC -
4749 */
4750
4751 static void doPrototypeC (decl_node n);
4752
4753 /*
4754 addTodo - adds, n, to the todo list.
4755 */
4756
4757 static void addTodo (decl_node n);
4758
4759 /*
4760 addVariablesTodo -
4761 */
4762
4763 static void addVariablesTodo (decl_node n);
4764
4765 /*
4766 addTypesTodo -
4767 */
4768
4769 static void addTypesTodo (decl_node n);
4770
4771 /*
4772 tempName -
4773 */
4774
4775 static DynamicStrings_String tempName (void);
4776
4777 /*
4778 makeIntermediateType -
4779 */
4780
4781 static decl_node makeIntermediateType (DynamicStrings_String s, decl_node p);
4782
4783 /*
4784 simplifyType -
4785 */
4786
4787 static void simplifyType (alists_alist l, decl_node *p);
4788
4789 /*
4790 simplifyVar -
4791 */
4792
4793 static void simplifyVar (alists_alist l, decl_node n);
4794
4795 /*
4796 simplifyRecord -
4797 */
4798
4799 static void simplifyRecord (alists_alist l, decl_node n);
4800
4801 /*
4802 simplifyVarient -
4803 */
4804
4805 static void simplifyVarient (alists_alist l, decl_node n);
4806
4807 /*
4808 simplifyVarientField -
4809 */
4810
4811 static void simplifyVarientField (alists_alist l, decl_node n);
4812
4813 /*
4814 doSimplifyNode -
4815 */
4816
4817 static void doSimplifyNode (alists_alist l, decl_node n);
4818
4819 /*
4820 simplifyNode -
4821 */
4822
4823 static void simplifyNode (alists_alist l, decl_node n);
4824
4825 /*
4826 doSimplify -
4827 */
4828
4829 static void doSimplify (decl_node n);
4830
4831 /*
4832 simplifyTypes -
4833 */
4834
4835 static void simplifyTypes (decl_scopeT s);
4836
4837 /*
4838 outDeclsDefC -
4839 */
4840
4841 static void outDeclsDefC (mcPretty_pretty p, decl_node n);
4842
4843 /*
4844 includeConstType -
4845 */
4846
4847 static void includeConstType (decl_scopeT s);
4848
4849 /*
4850 includeVarProcedure -
4851 */
4852
4853 static void includeVarProcedure (decl_scopeT s);
4854
4855 /*
4856 includeVar -
4857 */
4858
4859 static void includeVar (decl_scopeT s);
4860
4861 /*
4862 includeExternals -
4863 */
4864
4865 static void includeExternals (decl_node n);
4866
4867 /*
4868 checkSystemInclude -
4869 */
4870
4871 static void checkSystemInclude (decl_node n);
4872
4873 /*
4874 addExported -
4875 */
4876
4877 static void addExported (decl_node n);
4878
4879 /*
4880 addExternal - only adds, n, if this symbol is external to the
4881 implementation module and is not a hidden type.
4882 */
4883
4884 static void addExternal (decl_node n);
4885
4886 /*
4887 includeDefConstType -
4888 */
4889
4890 static void includeDefConstType (decl_node n);
4891
4892 /*
4893 runIncludeDefConstType -
4894 */
4895
4896 static void runIncludeDefConstType (decl_node n);
4897
4898 /*
4899 joinProcedures - copies procedures from definition module,
4900 d, into implementation module, i.
4901 */
4902
4903 static void joinProcedures (decl_node i, decl_node d);
4904
4905 /*
4906 includeDefVarProcedure -
4907 */
4908
4909 static void includeDefVarProcedure (decl_node n);
4910
4911 /*
4912 foreachModuleDo -
4913 */
4914
4915 static void foreachModuleDo (decl_node n, symbolKey_performOperation p);
4916
4917 /*
4918 outDeclsImpC -
4919 */
4920
4921 static void outDeclsImpC (mcPretty_pretty p, decl_scopeT s);
4922
4923 /*
4924 doStatementSequenceC -
4925 */
4926
4927 static void doStatementSequenceC (mcPretty_pretty p, decl_node s);
4928
4929 /*
4930 isStatementSequenceEmpty -
4931 */
4932
4933 static bool isStatementSequenceEmpty (decl_node s);
4934
4935 /*
4936 isSingleStatement - returns TRUE if the statement sequence, s, has
4937 only one statement.
4938 */
4939
4940 static bool isSingleStatement (decl_node s);
4941
4942 /*
4943 doCommentC -
4944 */
4945
4946 static void doCommentC (mcPretty_pretty p, decl_node s);
4947
4948 /*
4949 doAfterCommentC - emit an after comment, c, or a newline if, c, is empty.
4950 */
4951
4952 static void doAfterCommentC (mcPretty_pretty p, decl_node c);
4953
4954 /*
4955 doReturnC - issue a return statement and also place in an after comment if one exists.
4956 */
4957
4958 static void doReturnC (mcPretty_pretty p, decl_node s);
4959
4960 /*
4961 isZtypeEquivalent -
4962 */
4963
4964 static bool isZtypeEquivalent (decl_node type);
4965
4966 /*
4967 isEquivalentType - returns TRUE if type1 and type2 are equivalent.
4968 */
4969
4970 static bool isEquivalentType (decl_node type1, decl_node type2);
4971
4972 /*
4973 doExprCastC - build a cast if necessary.
4974 */
4975
4976 static void doExprCastC (mcPretty_pretty p, decl_node e, decl_node type);
4977
4978 /*
4979 requiresUnpackProc - returns TRUE if either the expr is a procedure or the proctypes differ.
4980 */
4981
4982 static bool requiresUnpackProc (decl_node s);
4983
4984 /*
4985 doAssignmentC -
4986 */
4987
4988 static void doAssignmentC (mcPretty_pretty p, decl_node s);
4989
4990 /*
4991 containsStatement -
4992 */
4993
4994 static bool containsStatement (decl_node s);
4995
4996 /*
4997 doCompoundStmt -
4998 */
4999
5000 static void doCompoundStmt (mcPretty_pretty p, decl_node s);
5001
5002 /*
5003 doElsifC -
5004 */
5005
5006 static void doElsifC (mcPretty_pretty p, decl_node s);
5007
5008 /*
5009 noIfElse -
5010 */
5011
5012 static bool noIfElse (decl_node n);
5013
5014 /*
5015 noIfElseChained - returns TRUE if, n, is an IF statement which
5016 has no associated ELSE statement. An IF with an
5017 ELSIF is also checked for no ELSE and will result
5018 in a return value of TRUE.
5019 */
5020
5021 static bool noIfElseChained (decl_node n);
5022
5023 /*
5024 hasIfElse -
5025 */
5026
5027 static bool hasIfElse (decl_node n);
5028
5029 /*
5030 isIfElse -
5031 */
5032
5033 static bool isIfElse (decl_node n);
5034
5035 /*
5036 hasIfAndNoElse - returns TRUE if statement, n, is a single statement
5037 which is an IF and it has no else statement.
5038 */
5039
5040 static bool hasIfAndNoElse (decl_node n);
5041
5042 /*
5043 doIfC - issue an if statement and also place in an after comment if one exists.
5044 The if statement might contain an else or elsif which are also handled.
5045 */
5046
5047 static void doIfC (mcPretty_pretty p, decl_node s);
5048
5049 /*
5050 doForIncCP -
5051 */
5052
5053 static void doForIncCP (mcPretty_pretty p, decl_node s);
5054
5055 /*
5056 doForIncC -
5057 */
5058
5059 static void doForIncC (mcPretty_pretty p, decl_node s);
5060
5061 /*
5062 doForInc -
5063 */
5064
5065 static void doForInc (mcPretty_pretty p, decl_node s);
5066
5067 /*
5068 doForC -
5069 */
5070
5071 static void doForC (mcPretty_pretty p, decl_node s);
5072
5073 /*
5074 doRepeatC -
5075 */
5076
5077 static void doRepeatC (mcPretty_pretty p, decl_node s);
5078
5079 /*
5080 doWhileC -
5081 */
5082
5083 static void doWhileC (mcPretty_pretty p, decl_node s);
5084
5085 /*
5086 doFuncHighC -
5087 */
5088
5089 static void doFuncHighC (mcPretty_pretty p, decl_node a);
5090
5091 /*
5092 doMultiplyBySize -
5093 */
5094
5095 static void doMultiplyBySize (mcPretty_pretty p, decl_node a);
5096
5097 /*
5098 doTotype -
5099 */
5100
5101 static void doTotype (mcPretty_pretty p, decl_node a, decl_node t);
5102
5103 /*
5104 doFuncUnbounded -
5105 */
5106
5107 static void doFuncUnbounded (mcPretty_pretty p, decl_node actual, decl_node formalParam, decl_node formal, decl_node func);
5108
5109 /*
5110 doProcedureParamC -
5111 */
5112
5113 static void doProcedureParamC (mcPretty_pretty p, decl_node actual, decl_node formal);
5114
5115 /*
5116 doAdrExprC -
5117 */
5118
5119 static void doAdrExprC (mcPretty_pretty p, decl_node n);
5120
5121 /*
5122 typePair -
5123 */
5124
5125 static bool typePair (decl_node a, decl_node b, decl_node x, decl_node y);
5126
5127 /*
5128 needsCast - return TRUE if the actual type parameter needs to be cast to
5129 the formal type.
5130 */
5131
5132 static bool needsCast (decl_node at, decl_node ft);
5133
5134 /*
5135 checkSystemCast - checks to see if we are passing to/from
5136 a system generic type (WORD, BYTE, ADDRESS)
5137 and if so emit a cast. It returns the number of
5138 open parenthesis.
5139 */
5140
5141 static unsigned int checkSystemCast (mcPretty_pretty p, decl_node actual, decl_node formal);
5142
5143 /*
5144 emitN -
5145 */
5146
5147 static void emitN (mcPretty_pretty p, const char *a_, unsigned int _a_high, unsigned int n);
5148
5149 /*
5150 isForC - return true if node n is a varparam, param or procedure
5151 which was declared inside a definition module for "C".
5152 */
5153
5154 static bool isForC (decl_node n);
5155
5156 /*
5157 isDefForCNode - return TRUE if node n was declared inside a definition module for "C".
5158 */
5159
5160 static bool isDefForCNode (decl_node n);
5161
5162 /*
5163 doFuncParamC -
5164 */
5165
5166 static void doFuncParamC (mcPretty_pretty p, decl_node actual, decl_node formal, decl_node func);
5167
5168 /*
5169 getNthParamType - return the type of parameter, i, in list, l.
5170 If the parameter is a vararg NIL is returned.
5171 */
5172
5173 static decl_node getNthParamType (Indexing_Index l, unsigned int i);
5174
5175 /*
5176 getNthParam - return the parameter, i, in list, l.
5177 If the parameter is a vararg NIL is returned.
5178 */
5179
5180 static decl_node getNthParam (Indexing_Index l, unsigned int i);
5181
5182 /*
5183 doFuncArgsC -
5184 */
5185
5186 static void doFuncArgsC (mcPretty_pretty p, decl_node s, Indexing_Index l, bool needParen);
5187
5188 /*
5189 doProcTypeArgsC -
5190 */
5191
5192 static void doProcTypeArgsC (mcPretty_pretty p, decl_node s, Indexing_Index args, bool needParen);
5193
5194 /*
5195 doAdrArgC -
5196 */
5197
5198 static void doAdrArgC (mcPretty_pretty p, decl_node n);
5199
5200 /*
5201 doAdrC -
5202 */
5203
5204 static void doAdrC (mcPretty_pretty p, decl_node n);
5205
5206 /*
5207 doInc -
5208 */
5209
5210 static void doInc (mcPretty_pretty p, decl_node n);
5211
5212 /*
5213 doDec -
5214 */
5215
5216 static void doDec (mcPretty_pretty p, decl_node n);
5217
5218 /*
5219 doIncDecC -
5220 */
5221
5222 static void doIncDecC (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high);
5223
5224 /*
5225 doIncDecCP -
5226 */
5227
5228 static void doIncDecCP (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high);
5229
5230 /*
5231 doInclC -
5232 */
5233
5234 static void doInclC (mcPretty_pretty p, decl_node n);
5235
5236 /*
5237 doExclC -
5238 */
5239
5240 static void doExclC (mcPretty_pretty p, decl_node n);
5241
5242 /*
5243 doNewC -
5244 */
5245
5246 static void doNewC (mcPretty_pretty p, decl_node n);
5247
5248 /*
5249 doDisposeC -
5250 */
5251
5252 static void doDisposeC (mcPretty_pretty p, decl_node n);
5253
5254 /*
5255 doCapC -
5256 */
5257
5258 static void doCapC (mcPretty_pretty p, decl_node n);
5259
5260 /*
5261 doLengthC -
5262 */
5263
5264 static void doLengthC (mcPretty_pretty p, decl_node n);
5265
5266 /*
5267 doAbsC -
5268 */
5269
5270 static void doAbsC (mcPretty_pretty p, decl_node n);
5271
5272 /*
5273 doValC -
5274 */
5275
5276 static void doValC (mcPretty_pretty p, decl_node n);
5277
5278 /*
5279 doMinC -
5280 */
5281
5282 static void doMinC (mcPretty_pretty p, decl_node n);
5283
5284 /*
5285 doMaxC -
5286 */
5287
5288 static void doMaxC (mcPretty_pretty p, decl_node n);
5289
5290 /*
5291 isIntrinsic - returns if, n, is an intrinsic procedure.
5292 The intrinsic functions are represented as unary and binary nodes.
5293 */
5294
5295 static bool isIntrinsic (decl_node n);
5296
5297 /*
5298 doHalt -
5299 */
5300
5301 static void doHalt (mcPretty_pretty p, decl_node n);
5302
5303 /*
5304 doCreal - emit the appropriate creal function.
5305 */
5306
5307 static void doCreal (mcPretty_pretty p, decl_node t);
5308
5309 /*
5310 doCimag - emit the appropriate cimag function.
5311 */
5312
5313 static void doCimag (mcPretty_pretty p, decl_node t);
5314
5315 /*
5316 doReC -
5317 */
5318
5319 static void doReC (mcPretty_pretty p, decl_node n);
5320
5321 /*
5322 doImC -
5323 */
5324
5325 static void doImC (mcPretty_pretty p, decl_node n);
5326
5327 /*
5328 doCmplx -
5329 */
5330
5331 static void doCmplx (mcPretty_pretty p, decl_node n);
5332
5333 /*
5334 doIntrinsicC -
5335 */
5336
5337 static void doIntrinsicC (mcPretty_pretty p, decl_node n);
5338
5339 /*
5340 isIntrinsicFunction - returns true if, n, is an instrinsic function.
5341 */
5342
5343 static bool isIntrinsicFunction (decl_node n);
5344
5345 /*
5346 doSizeC -
5347 */
5348
5349 static void doSizeC (mcPretty_pretty p, decl_node n);
5350
5351 /*
5352 doConvertC -
5353 */
5354
5355 static void doConvertC (mcPretty_pretty p, decl_node n, const char *conversion_, unsigned int _conversion_high);
5356
5357 /*
5358 doConvertSC -
5359 */
5360
5361 static void doConvertSC (mcPretty_pretty p, decl_node n, DynamicStrings_String conversion);
5362
5363 /*
5364 getFuncFromExpr -
5365 */
5366
5367 static decl_node getFuncFromExpr (decl_node n);
5368
5369 /*
5370 doFuncExprC -
5371 */
5372
5373 static void doFuncExprC (mcPretty_pretty p, decl_node n);
5374
5375 /*
5376 doFuncCallC -
5377 */
5378
5379 static void doFuncCallC (mcPretty_pretty p, decl_node n);
5380
5381 /*
5382 doCaseStatementC -
5383 */
5384
5385 static void doCaseStatementC (mcPretty_pretty p, decl_node n, bool needBreak);
5386
5387 /*
5388 doExceptionC -
5389 */
5390
5391 static void doExceptionC (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n);
5392
5393 /*
5394 doExceptionCP -
5395 */
5396
5397 static void doExceptionCP (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n);
5398
5399 /*
5400 doException -
5401 */
5402
5403 static void doException (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n);
5404
5405 /*
5406 doRangeListC -
5407 */
5408
5409 static void doRangeListC (mcPretty_pretty p, decl_node c);
5410
5411 /*
5412 doRangeIfListC -
5413 */
5414
5415 static void doRangeIfListC (mcPretty_pretty p, decl_node e, decl_node c);
5416
5417 /*
5418 doCaseLabels -
5419 */
5420
5421 static void doCaseLabels (mcPretty_pretty p, decl_node n, bool needBreak);
5422
5423 /*
5424 doCaseLabelListC -
5425 */
5426
5427 static void doCaseLabelListC (mcPretty_pretty p, decl_node n, bool haveElse);
5428
5429 /*
5430 doCaseIfLabels -
5431 */
5432
5433 static void doCaseIfLabels (mcPretty_pretty p, decl_node e, decl_node n, unsigned int i, unsigned int h);
5434
5435 /*
5436 doCaseIfLabelListC -
5437 */
5438
5439 static void doCaseIfLabelListC (mcPretty_pretty p, decl_node n);
5440
5441 /*
5442 doCaseElseC -
5443 */
5444
5445 static void doCaseElseC (mcPretty_pretty p, decl_node n);
5446
5447 /*
5448 doCaseIfElseC -
5449 */
5450
5451 static void doCaseIfElseC (mcPretty_pretty p, decl_node n);
5452
5453 /*
5454 canUseSwitchCaseLabels - returns TRUE if all the case labels are
5455 single values and not ranges.
5456 */
5457
5458 static bool canUseSwitchCaseLabels (decl_node n);
5459
5460 /*
5461 canUseSwitch - returns TRUE if the case statement can be implement
5462 by a switch statement. This will be TRUE if all case
5463 selectors are single values rather than ranges.
5464 */
5465
5466 static bool canUseSwitch (decl_node n);
5467
5468 /*
5469 doCaseC -
5470 */
5471
5472 static void doCaseC (mcPretty_pretty p, decl_node n);
5473
5474 /*
5475 doLoopC -
5476 */
5477
5478 static void doLoopC (mcPretty_pretty p, decl_node s);
5479
5480 /*
5481 doExitC -
5482 */
5483
5484 static void doExitC (mcPretty_pretty p, decl_node s);
5485
5486 /*
5487 doStatementsC -
5488 */
5489
5490 static void doStatementsC (mcPretty_pretty p, decl_node s);
5491 static void stop (void);
5492
5493 /*
5494 doLocalVarC -
5495 */
5496
5497 static void doLocalVarC (mcPretty_pretty p, decl_scopeT s);
5498
5499 /*
5500 doLocalConstTypesC -
5501 */
5502
5503 static void doLocalConstTypesC (mcPretty_pretty p, decl_scopeT s);
5504
5505 /*
5506 addParamDone -
5507 */
5508
5509 static void addParamDone (decl_node n);
5510
5511 /*
5512 includeParameters -
5513 */
5514
5515 static void includeParameters (decl_node n);
5516
5517 /*
5518 isHalt -
5519 */
5520
5521 static bool isHalt (decl_node n);
5522
5523 /*
5524 isReturnOrHalt -
5525 */
5526
5527 static bool isReturnOrHalt (decl_node n);
5528
5529 /*
5530 isLastStatementReturn -
5531 */
5532
5533 static bool isLastStatementReturn (decl_node n);
5534
5535 /*
5536 isLastStatementSequence -
5537 */
5538
5539 static bool isLastStatementSequence (decl_node n, decl_isNodeF q);
5540
5541 /*
5542 isLastStatementIf -
5543 */
5544
5545 static bool isLastStatementIf (decl_node n, decl_isNodeF q);
5546
5547 /*
5548 isLastStatementElsif -
5549 */
5550
5551 static bool isLastStatementElsif (decl_node n, decl_isNodeF q);
5552
5553 /*
5554 isLastStatementCase -
5555 */
5556
5557 static bool isLastStatementCase (decl_node n, decl_isNodeF q);
5558
5559 /*
5560 isLastStatement - returns TRUE if the last statement in, n, is, q.
5561 */
5562
5563 static bool isLastStatement (decl_node n, decl_isNodeF q);
5564
5565 /*
5566 doProcedureC -
5567 */
5568
5569 static void doProcedureC (decl_node n);
5570
5571 /*
5572 outProceduresC -
5573 */
5574
5575 static void outProceduresC (mcPretty_pretty p, decl_scopeT s);
5576
5577 /*
5578 output -
5579 */
5580
5581 static void output (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v);
5582
5583 /*
5584 allDependants -
5585 */
5586
5587 static decl_dependentState allDependants (decl_node n);
5588
5589 /*
5590 walkDependants -
5591 */
5592
5593 static decl_dependentState walkDependants (alists_alist l, decl_node n);
5594
5595 /*
5596 walkType -
5597 */
5598
5599 static decl_dependentState walkType (alists_alist l, decl_node n);
5600
5601 /*
5602 db -
5603 */
5604
5605 static void db (const char *a_, unsigned int _a_high, decl_node n);
5606
5607 /*
5608 dbt -
5609 */
5610
5611 static void dbt (const char *a_, unsigned int _a_high);
5612
5613 /*
5614 dbs -
5615 */
5616
5617 static void dbs (decl_dependentState s, decl_node n);
5618
5619 /*
5620 dbq -
5621 */
5622
5623 static void dbq (decl_node n);
5624
5625 /*
5626 walkRecord -
5627 */
5628
5629 static decl_dependentState walkRecord (alists_alist l, decl_node n);
5630
5631 /*
5632 walkVarient -
5633 */
5634
5635 static decl_dependentState walkVarient (alists_alist l, decl_node n);
5636
5637 /*
5638 queueBlocked -
5639 */
5640
5641 static void queueBlocked (decl_node n);
5642
5643 /*
5644 walkVar -
5645 */
5646
5647 static decl_dependentState walkVar (alists_alist l, decl_node n);
5648
5649 /*
5650 walkEnumeration -
5651 */
5652
5653 static decl_dependentState walkEnumeration (alists_alist l, decl_node n);
5654
5655 /*
5656 walkSubrange -
5657 */
5658
5659 static decl_dependentState walkSubrange (alists_alist l, decl_node n);
5660
5661 /*
5662 walkSubscript -
5663 */
5664
5665 static decl_dependentState walkSubscript (alists_alist l, decl_node n);
5666
5667 /*
5668 walkPointer -
5669 */
5670
5671 static decl_dependentState walkPointer (alists_alist l, decl_node n);
5672
5673 /*
5674 walkArray -
5675 */
5676
5677 static decl_dependentState walkArray (alists_alist l, decl_node n);
5678
5679 /*
5680 walkConst -
5681 */
5682
5683 static decl_dependentState walkConst (alists_alist l, decl_node n);
5684
5685 /*
5686 walkVarParam -
5687 */
5688
5689 static decl_dependentState walkVarParam (alists_alist l, decl_node n);
5690
5691 /*
5692 walkParam -
5693 */
5694
5695 static decl_dependentState walkParam (alists_alist l, decl_node n);
5696
5697 /*
5698 walkOptarg -
5699 */
5700
5701 static decl_dependentState walkOptarg (alists_alist l, decl_node n);
5702
5703 /*
5704 walkRecordField -
5705 */
5706
5707 static decl_dependentState walkRecordField (alists_alist l, decl_node n);
5708
5709 /*
5710 walkVarientField -
5711 */
5712
5713 static decl_dependentState walkVarientField (alists_alist l, decl_node n);
5714
5715 /*
5716 walkEnumerationField -
5717 */
5718
5719 static decl_dependentState walkEnumerationField (alists_alist l, decl_node n);
5720
5721 /*
5722 walkSet -
5723 */
5724
5725 static decl_dependentState walkSet (alists_alist l, decl_node n);
5726
5727 /*
5728 walkProcType -
5729 */
5730
5731 static decl_dependentState walkProcType (alists_alist l, decl_node n);
5732
5733 /*
5734 walkProcedure -
5735 */
5736
5737 static decl_dependentState walkProcedure (alists_alist l, decl_node n);
5738
5739 /*
5740 walkParameters -
5741 */
5742
5743 static decl_dependentState walkParameters (alists_alist l, Indexing_Index p);
5744
5745 /*
5746 walkFuncCall -
5747 */
5748
5749 static decl_dependentState walkFuncCall (alists_alist l, decl_node n);
5750
5751 /*
5752 walkUnary -
5753 */
5754
5755 static decl_dependentState walkUnary (alists_alist l, decl_node n);
5756
5757 /*
5758 walkBinary -
5759 */
5760
5761 static decl_dependentState walkBinary (alists_alist l, decl_node n);
5762
5763 /*
5764 walkComponentRef -
5765 */
5766
5767 static decl_dependentState walkComponentRef (alists_alist l, decl_node n);
5768
5769 /*
5770 walkPointerRef -
5771 */
5772
5773 static decl_dependentState walkPointerRef (alists_alist l, decl_node n);
5774
5775 /*
5776 walkSetValue -
5777 */
5778
5779 static decl_dependentState walkSetValue (alists_alist l, decl_node n);
5780
5781 /*
5782 doDependants - return the dependentState depending upon whether
5783 all dependants have been declared.
5784 */
5785
5786 static decl_dependentState doDependants (alists_alist l, decl_node n);
5787
5788 /*
5789 tryComplete - returns TRUE if node, n, can be and was completed.
5790 */
5791
5792 static bool tryComplete (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v);
5793
5794 /*
5795 tryCompleteFromPartial -
5796 */
5797
5798 static bool tryCompleteFromPartial (decl_node n, decl_nodeProcedure t);
5799
5800 /*
5801 visitIntrinsicFunction -
5802 */
5803
5804 static void visitIntrinsicFunction (alists_alist v, decl_node n, decl_nodeProcedure p);
5805
5806 /*
5807 visitUnary -
5808 */
5809
5810 static void visitUnary (alists_alist v, decl_node n, decl_nodeProcedure p);
5811
5812 /*
5813 visitBinary -
5814 */
5815
5816 static void visitBinary (alists_alist v, decl_node n, decl_nodeProcedure p);
5817
5818 /*
5819 visitBoolean -
5820 */
5821
5822 static void visitBoolean (alists_alist v, decl_node n, decl_nodeProcedure p);
5823
5824 /*
5825 visitScope -
5826 */
5827
5828 static void visitScope (alists_alist v, decl_node n, decl_nodeProcedure p);
5829
5830 /*
5831 visitType -
5832 */
5833
5834 static void visitType (alists_alist v, decl_node n, decl_nodeProcedure p);
5835
5836 /*
5837 visitIndex -
5838 */
5839
5840 static void visitIndex (alists_alist v, Indexing_Index i, decl_nodeProcedure p);
5841
5842 /*
5843 visitRecord -
5844 */
5845
5846 static void visitRecord (alists_alist v, decl_node n, decl_nodeProcedure p);
5847
5848 /*
5849 visitVarient -
5850 */
5851
5852 static void visitVarient (alists_alist v, decl_node n, decl_nodeProcedure p);
5853
5854 /*
5855 visitVar -
5856 */
5857
5858 static void visitVar (alists_alist v, decl_node n, decl_nodeProcedure p);
5859
5860 /*
5861 visitEnumeration -
5862 */
5863
5864 static void visitEnumeration (alists_alist v, decl_node n, decl_nodeProcedure p);
5865
5866 /*
5867 visitSubrange -
5868 */
5869
5870 static void visitSubrange (alists_alist v, decl_node n, decl_nodeProcedure p);
5871
5872 /*
5873 visitPointer -
5874 */
5875
5876 static void visitPointer (alists_alist v, decl_node n, decl_nodeProcedure p);
5877
5878 /*
5879 visitArray -
5880 */
5881
5882 static void visitArray (alists_alist v, decl_node n, decl_nodeProcedure p);
5883
5884 /*
5885 visitConst -
5886 */
5887
5888 static void visitConst (alists_alist v, decl_node n, decl_nodeProcedure p);
5889
5890 /*
5891 visitVarParam -
5892 */
5893
5894 static void visitVarParam (alists_alist v, decl_node n, decl_nodeProcedure p);
5895
5896 /*
5897 visitParam -
5898 */
5899
5900 static void visitParam (alists_alist v, decl_node n, decl_nodeProcedure p);
5901
5902 /*
5903 visitOptarg -
5904 */
5905
5906 static void visitOptarg (alists_alist v, decl_node n, decl_nodeProcedure p);
5907
5908 /*
5909 visitRecordField -
5910 */
5911
5912 static void visitRecordField (alists_alist v, decl_node n, decl_nodeProcedure p);
5913
5914 /*
5915 visitVarientField -
5916 */
5917
5918 static void visitVarientField (alists_alist v, decl_node n, decl_nodeProcedure p);
5919
5920 /*
5921 visitEnumerationField -
5922 */
5923
5924 static void visitEnumerationField (alists_alist v, decl_node n, decl_nodeProcedure p);
5925
5926 /*
5927 visitSet -
5928 */
5929
5930 static void visitSet (alists_alist v, decl_node n, decl_nodeProcedure p);
5931
5932 /*
5933 visitProcType -
5934 */
5935
5936 static void visitProcType (alists_alist v, decl_node n, decl_nodeProcedure p);
5937
5938 /*
5939 visitSubscript -
5940 */
5941
5942 static void visitSubscript (alists_alist v, decl_node n, decl_nodeProcedure p);
5943
5944 /*
5945 visitDecls -
5946 */
5947
5948 static void visitDecls (alists_alist v, decl_scopeT s, decl_nodeProcedure p);
5949
5950 /*
5951 visitProcedure -
5952 */
5953
5954 static void visitProcedure (alists_alist v, decl_node n, decl_nodeProcedure p);
5955
5956 /*
5957 visitDef -
5958 */
5959
5960 static void visitDef (alists_alist v, decl_node n, decl_nodeProcedure p);
5961
5962 /*
5963 visitImp -
5964 */
5965
5966 static void visitImp (alists_alist v, decl_node n, decl_nodeProcedure p);
5967
5968 /*
5969 visitModule -
5970 */
5971
5972 static void visitModule (alists_alist v, decl_node n, decl_nodeProcedure p);
5973
5974 /*
5975 visitLoop -
5976 */
5977
5978 static void visitLoop (alists_alist v, decl_node n, decl_nodeProcedure p);
5979
5980 /*
5981 visitWhile -
5982 */
5983
5984 static void visitWhile (alists_alist v, decl_node n, decl_nodeProcedure p);
5985
5986 /*
5987 visitRepeat -
5988 */
5989
5990 static void visitRepeat (alists_alist v, decl_node n, decl_nodeProcedure p);
5991
5992 /*
5993 visitCase -
5994 */
5995
5996 static void visitCase (alists_alist v, decl_node n, decl_nodeProcedure p);
5997
5998 /*
5999 visitCaseLabelList -
6000 */
6001
6002 static void visitCaseLabelList (alists_alist v, decl_node n, decl_nodeProcedure p);
6003
6004 /*
6005 visitCaseList -
6006 */
6007
6008 static void visitCaseList (alists_alist v, decl_node n, decl_nodeProcedure p);
6009
6010 /*
6011 visitRange -
6012 */
6013
6014 static void visitRange (alists_alist v, decl_node n, decl_nodeProcedure p);
6015
6016 /*
6017 visitIf -
6018 */
6019
6020 static void visitIf (alists_alist v, decl_node n, decl_nodeProcedure p);
6021
6022 /*
6023 visitElsif -
6024 */
6025
6026 static void visitElsif (alists_alist v, decl_node n, decl_nodeProcedure p);
6027
6028 /*
6029 visitFor -
6030 */
6031
6032 static void visitFor (alists_alist v, decl_node n, decl_nodeProcedure p);
6033
6034 /*
6035 visitAssignment -
6036 */
6037
6038 static void visitAssignment (alists_alist v, decl_node n, decl_nodeProcedure p);
6039
6040 /*
6041 visitComponentRef -
6042 */
6043
6044 static void visitComponentRef (alists_alist v, decl_node n, decl_nodeProcedure p);
6045
6046 /*
6047 visitPointerRef -
6048 */
6049
6050 static void visitPointerRef (alists_alist v, decl_node n, decl_nodeProcedure p);
6051
6052 /*
6053 visitArrayRef -
6054 */
6055
6056 static void visitArrayRef (alists_alist v, decl_node n, decl_nodeProcedure p);
6057
6058 /*
6059 visitFunccall -
6060 */
6061
6062 static void visitFunccall (alists_alist v, decl_node n, decl_nodeProcedure p);
6063
6064 /*
6065 visitVarDecl -
6066 */
6067
6068 static void visitVarDecl (alists_alist v, decl_node n, decl_nodeProcedure p);
6069
6070 /*
6071 visitExplist -
6072 */
6073
6074 static void visitExplist (alists_alist v, decl_node n, decl_nodeProcedure p);
6075
6076 /*
6077 visitExit -
6078 */
6079
6080 static void visitExit (alists_alist v, decl_node n, decl_nodeProcedure p);
6081
6082 /*
6083 visitReturn -
6084 */
6085
6086 static void visitReturn (alists_alist v, decl_node n, decl_nodeProcedure p);
6087
6088 /*
6089 visitStmtSeq -
6090 */
6091
6092 static void visitStmtSeq (alists_alist v, decl_node n, decl_nodeProcedure p);
6093
6094 /*
6095 visitVarargs -
6096 */
6097
6098 static void visitVarargs (alists_alist v, decl_node n, decl_nodeProcedure p);
6099
6100 /*
6101 visitSetValue -
6102 */
6103
6104 static void visitSetValue (alists_alist v, decl_node n, decl_nodeProcedure p);
6105
6106 /*
6107 visitIntrinsic -
6108 */
6109
6110 static void visitIntrinsic (alists_alist v, decl_node n, decl_nodeProcedure p);
6111
6112 /*
6113 visitDependants - helper procedure function called from visitNode.
6114 node n has just been visited, this procedure will
6115 visit node, n, dependants.
6116 */
6117
6118 static void visitDependants (alists_alist v, decl_node n, decl_nodeProcedure p);
6119
6120 /*
6121 visitNode - visits node, n, if it is not already in the alist, v.
6122 It calls p(n) if the node is unvisited.
6123 */
6124
6125 static void visitNode (alists_alist v, decl_node n, decl_nodeProcedure p);
6126
6127 /*
6128 genKind - returns a string depending upon the kind of node, n.
6129 */
6130
6131 static DynamicStrings_String genKind (decl_node n);
6132
6133 /*
6134 gen - generate a small string describing node, n.
6135 */
6136
6137 static DynamicStrings_String gen (decl_node n);
6138
6139 /*
6140 dumpQ -
6141 */
6142
6143 static void dumpQ (const char *q_, unsigned int _q_high, alists_alist l);
6144
6145 /*
6146 dumpLists -
6147 */
6148
6149 static void dumpLists (void);
6150
6151 /*
6152 outputHidden -
6153 */
6154
6155 static void outputHidden (decl_node n);
6156
6157 /*
6158 outputHiddenComplete -
6159 */
6160
6161 static void outputHiddenComplete (decl_node n);
6162
6163 /*
6164 tryPartial -
6165 */
6166
6167 static bool tryPartial (decl_node n, decl_nodeProcedure pt);
6168
6169 /*
6170 outputPartialRecordArrayProcType -
6171 */
6172
6173 static void outputPartialRecordArrayProcType (decl_node n, decl_node q, unsigned int indirection);
6174
6175 /*
6176 outputPartial -
6177 */
6178
6179 static void outputPartial (decl_node n);
6180
6181 /*
6182 tryOutputTodo -
6183 */
6184
6185 static void tryOutputTodo (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure pt);
6186
6187 /*
6188 tryOutputPartial -
6189 */
6190
6191 static void tryOutputPartial (decl_nodeProcedure t);
6192
6193 /*
6194 debugList -
6195 */
6196
6197 static void debugList (const char *a_, unsigned int _a_high, alists_alist l);
6198
6199 /*
6200 debugLists -
6201 */
6202
6203 static void debugLists (void);
6204
6205 /*
6206 addEnumConst -
6207 */
6208
6209 static void addEnumConst (decl_node n);
6210
6211 /*
6212 populateTodo -
6213 */
6214
6215 static void populateTodo (decl_nodeProcedure p);
6216
6217 /*
6218 topologicallyOut -
6219 */
6220
6221 static void topologicallyOut (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure tp, decl_nodeProcedure pc, decl_nodeProcedure pt, decl_nodeProcedure pv);
6222
6223 /*
6224 scaffoldStatic -
6225 */
6226
6227 static void scaffoldStatic (mcPretty_pretty p, decl_node n);
6228
6229 /*
6230 emitCtor -
6231 */
6232
6233 static void emitCtor (mcPretty_pretty p, decl_node n);
6234
6235 /*
6236 scaffoldDynamic -
6237 */
6238
6239 static void scaffoldDynamic (mcPretty_pretty p, decl_node n);
6240
6241 /*
6242 scaffoldMain -
6243 */
6244
6245 static void scaffoldMain (mcPretty_pretty p, decl_node n);
6246
6247 /*
6248 outImpInitC - emit the init/fini functions and main function if required.
6249 */
6250
6251 static void outImpInitC (mcPretty_pretty p, decl_node n);
6252
6253 /*
6254 runSimplifyTypes -
6255 */
6256
6257 static void runSimplifyTypes (decl_node n);
6258
6259 /*
6260 outDefC -
6261 */
6262
6263 static void outDefC (mcPretty_pretty p, decl_node n);
6264
6265 /*
6266 runPrototypeExported -
6267 */
6268
6269 static void runPrototypeExported (decl_node n);
6270
6271 /*
6272 runPrototypeDefC -
6273 */
6274
6275 static void runPrototypeDefC (decl_node n);
6276
6277 /*
6278 outImpC -
6279 */
6280
6281 static void outImpC (mcPretty_pretty p, decl_node n);
6282
6283 /*
6284 outDeclsModuleC -
6285 */
6286
6287 static void outDeclsModuleC (mcPretty_pretty p, decl_scopeT s);
6288
6289 /*
6290 outModuleInitC -
6291 */
6292
6293 static void outModuleInitC (mcPretty_pretty p, decl_node n);
6294
6295 /*
6296 outModuleC -
6297 */
6298
6299 static void outModuleC (mcPretty_pretty p, decl_node n);
6300
6301 /*
6302 outC -
6303 */
6304
6305 static void outC (mcPretty_pretty p, decl_node n);
6306
6307 /*
6308 doIncludeM2 - include modules in module, n.
6309 */
6310
6311 static void doIncludeM2 (decl_node n);
6312
6313 /*
6314 doConstM2 -
6315 */
6316
6317 static void doConstM2 (decl_node n);
6318
6319 /*
6320 doProcTypeM2 -
6321 */
6322
6323 static void doProcTypeM2 (mcPretty_pretty p, decl_node n);
6324
6325 /*
6326 doRecordFieldM2 -
6327 */
6328
6329 static void doRecordFieldM2 (mcPretty_pretty p, decl_node f);
6330
6331 /*
6332 doVarientFieldM2 -
6333 */
6334
6335 static void doVarientFieldM2 (mcPretty_pretty p, decl_node n);
6336
6337 /*
6338 doVarientM2 -
6339 */
6340
6341 static void doVarientM2 (mcPretty_pretty p, decl_node n);
6342
6343 /*
6344 doRecordM2 -
6345 */
6346
6347 static void doRecordM2 (mcPretty_pretty p, decl_node n);
6348
6349 /*
6350 doPointerM2 -
6351 */
6352
6353 static void doPointerM2 (mcPretty_pretty p, decl_node n);
6354
6355 /*
6356 doTypeAliasM2 -
6357 */
6358
6359 static void doTypeAliasM2 (mcPretty_pretty p, decl_node n);
6360
6361 /*
6362 doEnumerationM2 -
6363 */
6364
6365 static void doEnumerationM2 (mcPretty_pretty p, decl_node n);
6366
6367 /*
6368 doBaseM2 -
6369 */
6370
6371 static void doBaseM2 (mcPretty_pretty p, decl_node n);
6372
6373 /*
6374 doSystemM2 -
6375 */
6376
6377 static void doSystemM2 (mcPretty_pretty p, decl_node n);
6378
6379 /*
6380 doTypeM2 -
6381 */
6382
6383 static void doTypeM2 (mcPretty_pretty p, decl_node n);
6384
6385 /*
6386 doTypesM2 -
6387 */
6388
6389 static void doTypesM2 (decl_node n);
6390
6391 /*
6392 doVarM2 -
6393 */
6394
6395 static void doVarM2 (decl_node n);
6396
6397 /*
6398 doVarsM2 -
6399 */
6400
6401 static void doVarsM2 (decl_node n);
6402
6403 /*
6404 doTypeNameM2 -
6405 */
6406
6407 static void doTypeNameM2 (mcPretty_pretty p, decl_node n);
6408
6409 /*
6410 doParamM2 -
6411 */
6412
6413 static void doParamM2 (mcPretty_pretty p, decl_node n);
6414
6415 /*
6416 doVarParamM2 -
6417 */
6418
6419 static void doVarParamM2 (mcPretty_pretty p, decl_node n);
6420
6421 /*
6422 doParameterM2 -
6423 */
6424
6425 static void doParameterM2 (mcPretty_pretty p, decl_node n);
6426
6427 /*
6428 doPrototypeM2 -
6429 */
6430
6431 static void doPrototypeM2 (decl_node n);
6432
6433 /*
6434 outputPartialM2 - just writes out record, array, and proctypes.
6435 No need for forward declarations in Modula-2
6436 but we need to keep topological sort happy.
6437 So when asked to output partial we emit the
6438 full type for these types and then do nothing
6439 when trying to complete partial to full.
6440 */
6441
6442 static void outputPartialM2 (decl_node n);
6443
6444 /*
6445 outDeclsDefM2 -
6446 */
6447
6448 static void outDeclsDefM2 (mcPretty_pretty p, decl_scopeT s);
6449
6450 /*
6451 outDefM2 -
6452 */
6453
6454 static void outDefM2 (mcPretty_pretty p, decl_node n);
6455
6456 /*
6457 outDeclsImpM2 -
6458 */
6459
6460 static void outDeclsImpM2 (mcPretty_pretty p, decl_scopeT s);
6461
6462 /*
6463 outImpM2 -
6464 */
6465
6466 static void outImpM2 (mcPretty_pretty p, decl_node n);
6467
6468 /*
6469 outModuleM2 -
6470 */
6471
6472 static void outModuleM2 (mcPretty_pretty p, decl_node n);
6473
6474 /*
6475 outM2 -
6476 */
6477
6478 static void outM2 (mcPretty_pretty p, decl_node n);
6479
6480 /*
6481 addDone - adds node, n, to the doneQ.
6482 */
6483
6484 static void addDone (decl_node n);
6485
6486 /*
6487 addDoneDef - adds node, n, to the doneQ providing
6488 it is not an opaque of the main module we are compiling.
6489 */
6490
6491 static void addDoneDef (decl_node n);
6492
6493 /*
6494 dbgAdd -
6495 */
6496
6497 static decl_node dbgAdd (alists_alist l, decl_node n);
6498
6499 /*
6500 dbgType -
6501 */
6502
6503 static void dbgType (alists_alist l, decl_node n);
6504
6505 /*
6506 dbgPointer -
6507 */
6508
6509 static void dbgPointer (alists_alist l, decl_node n);
6510
6511 /*
6512 dbgRecord -
6513 */
6514
6515 static void dbgRecord (alists_alist l, decl_node n);
6516
6517 /*
6518 dbgVarient -
6519 */
6520
6521 static void dbgVarient (alists_alist l, decl_node n);
6522
6523 /*
6524 dbgEnumeration -
6525 */
6526
6527 static void dbgEnumeration (alists_alist l, decl_node n);
6528
6529 /*
6530 dbgVar -
6531 */
6532
6533 static void dbgVar (alists_alist l, decl_node n);
6534
6535 /*
6536 dbgSubrange -
6537 */
6538
6539 static void dbgSubrange (alists_alist l, decl_node n);
6540
6541 /*
6542 dbgArray -
6543 */
6544
6545 static void dbgArray (alists_alist l, decl_node n);
6546
6547 /*
6548 doDbg -
6549 */
6550
6551 static void doDbg (alists_alist l, decl_node n);
6552
6553 /*
6554 dbg -
6555 */
6556
6557 static void dbg (decl_node n);
6558
6559 /*
6560 addGenericBody - adds comment node to funccall, return, assignment
6561 nodes.
6562 */
6563
6564 static void addGenericBody (decl_node n, decl_node c);
6565
6566 /*
6567 addGenericAfter - adds comment node to funccall, return, assignment
6568 nodes.
6569 */
6570
6571 static void addGenericAfter (decl_node n, decl_node c);
6572
6573 /*
6574 isAssignment -
6575 */
6576
6577 static bool isAssignment (decl_node n);
6578
6579 /*
6580 isComment - returns TRUE if node, n, is a comment.
6581 */
6582
6583 static bool isComment (decl_node n);
6584
6585 /*
6586 initPair - initialise the commentPair, c.
6587 */
6588
6589 static void initPair (decl_commentPair *c);
6590
6591 /*
6592 dupExplist -
6593 */
6594
6595 static decl_node dupExplist (decl_node n);
6596
6597 /*
6598 dupArrayref -
6599 */
6600
6601 static decl_node dupArrayref (decl_node n);
6602
6603 /*
6604 dupPointerref -
6605 */
6606
6607 static decl_node dupPointerref (decl_node n);
6608
6609 /*
6610 dupComponentref -
6611 */
6612
6613 static decl_node dupComponentref (decl_node n);
6614
6615 /*
6616 dupBinary -
6617 */
6618
6619 static decl_node dupBinary (decl_node n);
6620
6621 /*
6622 dupUnary -
6623 */
6624
6625 static decl_node dupUnary (decl_node n);
6626
6627 /*
6628 dupFunccall -
6629 */
6630
6631 static decl_node dupFunccall (decl_node n);
6632
6633 /*
6634 dupSetValue -
6635 */
6636
6637 static decl_node dupSetValue (decl_node n);
6638
6639 /*
6640 doDupExpr -
6641 */
6642
6643 static decl_node doDupExpr (decl_node n);
6644
6645 /*
6646 makeSystem -
6647 */
6648
6649 static void makeSystem (void);
6650
6651 /*
6652 makeM2rts -
6653 */
6654
6655 static void makeM2rts (void);
6656
6657 /*
6658 makeBitnum -
6659 */
6660
6661 static decl_node makeBitnum (void);
6662
6663 /*
6664 makeBaseSymbols -
6665 */
6666
6667 static void makeBaseSymbols (void);
6668
6669 /*
6670 makeBuiltins -
6671 */
6672
6673 static void makeBuiltins (void);
6674
6675 /*
6676 init -
6677 */
6678
6679 static void init (void);
6680
6681
6682 /*
6683 newNode - create and return a new node of kind k.
6684 */
6685
6686 static decl_node newNode (decl_nodeT k)
6687 {
6688 decl_node d;
6689
6690 Storage_ALLOCATE ((void **) &d, sizeof (decl_nodeRec));
6691 if (enableMemsetOnAllocation)
6692 {
6693 d = static_cast<decl_node> (libc_memset (reinterpret_cast<void *> (d), 0, static_cast<size_t> (sizeof ((*d)))));
6694 }
6695 if (d == NULL)
6696 {
6697 M2RTS_HALT (-1);
6698 __builtin_unreachable ();
6699 }
6700 else
6701 {
6702 d->kind = k;
6703 d->at.defDeclared = 0;
6704 d->at.modDeclared = 0;
6705 d->at.firstUsed = 0;
6706 return d;
6707 }
6708 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
6709 __builtin_unreachable ();
6710 }
6711
6712
6713 /*
6714 disposeNode - dispose node, n.
6715 */
6716
6717 static void disposeNode (decl_node *n)
6718 {
6719 Storage_DEALLOCATE ((void **) &(*n), sizeof (decl_nodeRec));
6720 (*n) = NULL;
6721 }
6722
6723
6724 /*
6725 isLocal - returns TRUE if symbol, n, is locally declared in a procedure.
6726 */
6727
6728 static bool isLocal (decl_node n)
6729 {
6730 decl_node s;
6731
6732 s = decl_getScope (n);
6733 if (s != NULL)
6734 {
6735 return decl_isProcedure (s);
6736 }
6737 return false;
6738 /* static analysis guarentees a RETURN statement will be used before here. */
6739 __builtin_unreachable ();
6740 }
6741
6742
6743 /*
6744 importEnumFields - if, n, is an enumeration type import the all fields into module, m.
6745 */
6746
6747 static void importEnumFields (decl_node m, decl_node n)
6748 {
6749 decl_node r;
6750 decl_node e;
6751 unsigned int i;
6752 unsigned int h;
6753
6754 mcDebug_assert (((decl_isDef (m)) || (decl_isModule (m))) || (decl_isImp (m)));
6755 n = decl_skipType (n);
6756 if ((n != NULL) && (decl_isEnumeration (n)))
6757 {
6758 i = Indexing_LowIndice (n->enumerationF.listOfSons);
6759 h = Indexing_HighIndice (n->enumerationF.listOfSons);
6760 while (i <= h)
6761 {
6762 e = static_cast<decl_node> (Indexing_GetIndice (n->enumerationF.listOfSons, i));
6763 r = decl_import (m, e);
6764 if (e != r)
6765 {
6766 mcMetaError_metaError2 ((const char *) "enumeration field {%1ad} cannot be imported implicitly into {%2d} due to a name clash", 85, (const unsigned char *) &e, (sizeof (e)-1), (const unsigned char *) &m, (sizeof (m)-1));
6767 }
6768 i += 1;
6769 }
6770 }
6771 }
6772
6773
6774 /*
6775 isComplex - returns TRUE if, n, is the complex type.
6776 */
6777
6778 static bool isComplex (decl_node n)
6779 {
6780 return n == complexN;
6781 /* static analysis guarentees a RETURN statement will be used before here. */
6782 __builtin_unreachable ();
6783 }
6784
6785
6786 /*
6787 isLongComplex - returns TRUE if, n, is the longcomplex type.
6788 */
6789
6790 static bool isLongComplex (decl_node n)
6791 {
6792 return n == longcomplexN;
6793 /* static analysis guarentees a RETURN statement will be used before here. */
6794 __builtin_unreachable ();
6795 }
6796
6797
6798 /*
6799 isShortComplex - returns TRUE if, n, is the shortcomplex type.
6800 */
6801
6802 static bool isShortComplex (decl_node n)
6803 {
6804 return n == shortcomplexN;
6805 /* static analysis guarentees a RETURN statement will be used before here. */
6806 __builtin_unreachable ();
6807 }
6808
6809
6810 /*
6811 isAProcType - returns TRUE if, n, is a proctype or proc node.
6812 */
6813
6814 static bool isAProcType (decl_node n)
6815 {
6816 mcDebug_assert (n != NULL);
6817 return (decl_isProcType (n)) || (n == procN);
6818 /* static analysis guarentees a RETURN statement will be used before here. */
6819 __builtin_unreachable ();
6820 }
6821
6822
6823 /*
6824 initFixupInfo - initialize the fixupInfo record.
6825 */
6826
6827 static decl_fixupInfo initFixupInfo (void)
6828 {
6829 decl_fixupInfo f;
6830
6831 f.count = 0;
6832 f.info = Indexing_InitIndex (1);
6833 return f;
6834 /* static analysis guarentees a RETURN statement will be used before here. */
6835 __builtin_unreachable ();
6836 }
6837
6838
6839 /*
6840 makeDef - returns a definition module node named, n.
6841 */
6842
6843 static decl_node makeDef (nameKey_Name n)
6844 {
6845 decl_node d;
6846
6847 d = newNode (decl_def);
6848 d->defF.name = n;
6849 d->defF.source = nameKey_NulName;
6850 d->defF.hasHidden = false;
6851 d->defF.forC = false;
6852 d->defF.exported = Indexing_InitIndex (1);
6853 d->defF.importedModules = Indexing_InitIndex (1);
6854 d->defF.constFixup = initFixupInfo ();
6855 d->defF.enumFixup = initFixupInfo ();
6856 initDecls (&d->defF.decls);
6857 d->defF.enumsComplete = false;
6858 d->defF.constsComplete = false;
6859 d->defF.visited = false;
6860 initPair (&d->defF.com);
6861 return d;
6862 /* static analysis guarentees a RETURN statement will be used before here. */
6863 __builtin_unreachable ();
6864 }
6865
6866
6867 /*
6868 makeImp - returns an implementation module node named, n.
6869 */
6870
6871 static decl_node makeImp (nameKey_Name n)
6872 {
6873 decl_node d;
6874
6875 d = newNode (decl_imp);
6876 d->impF.name = n;
6877 d->impF.source = nameKey_NulName;
6878 d->impF.importedModules = Indexing_InitIndex (1);
6879 d->impF.constFixup = initFixupInfo ();
6880 d->impF.enumFixup = initFixupInfo ();
6881 initDecls (&d->impF.decls);
6882 d->impF.beginStatements = NULL;
6883 d->impF.finallyStatements = NULL;
6884 d->impF.definitionModule = NULL;
6885 d->impF.enumsComplete = false;
6886 d->impF.constsComplete = false;
6887 d->impF.visited = false;
6888 initPair (&d->impF.com);
6889 return d;
6890 /* static analysis guarentees a RETURN statement will be used before here. */
6891 __builtin_unreachable ();
6892 }
6893
6894
6895 /*
6896 makeModule - returns a module node named, n.
6897 */
6898
6899 static decl_node makeModule (nameKey_Name n)
6900 {
6901 decl_node d;
6902
6903 d = newNode (decl_module);
6904 d->moduleF.name = n;
6905 d->moduleF.source = nameKey_NulName;
6906 d->moduleF.importedModules = Indexing_InitIndex (1);
6907 d->moduleF.constFixup = initFixupInfo ();
6908 d->moduleF.enumFixup = initFixupInfo ();
6909 initDecls (&d->moduleF.decls);
6910 d->moduleF.beginStatements = NULL;
6911 d->moduleF.finallyStatements = NULL;
6912 d->moduleF.enumsComplete = false;
6913 d->moduleF.constsComplete = false;
6914 d->moduleF.visited = false;
6915 initPair (&d->moduleF.com);
6916 return d;
6917 /* static analysis guarentees a RETURN statement will be used before here. */
6918 __builtin_unreachable ();
6919 }
6920
6921
6922 /*
6923 isDefForC - returns TRUE if the definition module was defined FOR "C".
6924 */
6925
6926 static bool isDefForC (decl_node n)
6927 {
6928 return (decl_isDef (n)) && n->defF.forC;
6929 /* static analysis guarentees a RETURN statement will be used before here. */
6930 __builtin_unreachable ();
6931 }
6932
6933
6934 /*
6935 initDecls - initialize the decls, scopeT.
6936 */
6937
6938 static void initDecls (decl_scopeT *decls)
6939 {
6940 (*decls).symbols = symbolKey_initTree ();
6941 (*decls).constants = Indexing_InitIndex (1);
6942 (*decls).types = Indexing_InitIndex (1);
6943 (*decls).procedures = Indexing_InitIndex (1);
6944 (*decls).variables = Indexing_InitIndex (1);
6945 }
6946
6947
6948 /*
6949 addTo - adds node, d, to scope decls and returns, d.
6950 It stores, d, in the symbols tree associated with decls.
6951 */
6952
6953 static decl_node addTo (decl_scopeT *decls, decl_node d)
6954 {
6955 nameKey_Name n;
6956
6957 n = decl_getSymName (d);
6958 if (n != nameKey_NulName)
6959 {
6960 /* avoid gcc warning by using compound statement even if not strictly necessary. */
6961 if ((symbolKey_getSymKey ((*decls).symbols, n)) == NULL)
6962 {
6963 symbolKey_putSymKey ((*decls).symbols, n, reinterpret_cast<void *> (d));
6964 }
6965 else
6966 {
6967 mcMetaError_metaError1 ((const char *) "{%1DMad} was declared", 21, (const unsigned char *) &d, (sizeof (d)-1));
6968 mcMetaError_metaError1 ((const char *) "{%1k} and is being declared again", 33, (const unsigned char *) &n, (sizeof (n)-1));
6969 }
6970 }
6971 if (decl_isConst (d))
6972 {
6973 Indexing_IncludeIndiceIntoIndex ((*decls).constants, reinterpret_cast<void *> (d));
6974 }
6975 else if (decl_isVar (d))
6976 {
6977 /* avoid dangling else. */
6978 Indexing_IncludeIndiceIntoIndex ((*decls).variables, reinterpret_cast<void *> (d));
6979 }
6980 else if (decl_isType (d))
6981 {
6982 /* avoid dangling else. */
6983 Indexing_IncludeIndiceIntoIndex ((*decls).types, reinterpret_cast<void *> (d));
6984 }
6985 else if (decl_isProcedure (d))
6986 {
6987 /* avoid dangling else. */
6988 Indexing_IncludeIndiceIntoIndex ((*decls).procedures, reinterpret_cast<void *> (d));
6989 if (debugDecl)
6990 {
6991 libc_printf ((const char *) "%d procedures on the dynamic array\\n", 36, Indexing_HighIndice ((*decls).procedures));
6992 }
6993 }
6994 return d;
6995 /* static analysis guarentees a RETURN statement will be used before here. */
6996 __builtin_unreachable ();
6997 }
6998
6999
7000 /*
7001 export - export node, n, from definition module, d.
7002 */
7003
7004 static void export_ (decl_node d, decl_node n)
7005 {
7006 mcDebug_assert (decl_isDef (d));
7007 Indexing_IncludeIndiceIntoIndex (d->defF.exported, reinterpret_cast<void *> (n));
7008 }
7009
7010
7011 /*
7012 addToScope - adds node, n, to the current scope and returns, n.
7013 */
7014
7015 static decl_node addToScope (decl_node n)
7016 {
7017 decl_node s;
7018 unsigned int i;
7019
7020 i = Indexing_HighIndice (scopeStack);
7021 s = static_cast<decl_node> (Indexing_GetIndice (scopeStack, i));
7022 if (decl_isProcedure (s))
7023 {
7024 if (debugDecl)
7025 {
7026 outText (doP, (const char *) "adding ", 7);
7027 doNameC (doP, n);
7028 outText (doP, (const char *) " to procedure\\n", 15);
7029 }
7030 return addTo (&s->procedureF.decls, n);
7031 }
7032 else if (decl_isModule (s))
7033 {
7034 /* avoid dangling else. */
7035 if (debugDecl)
7036 {
7037 outText (doP, (const char *) "adding ", 7);
7038 doNameC (doP, n);
7039 outText (doP, (const char *) " to module\\n", 12);
7040 }
7041 return addTo (&s->moduleF.decls, n);
7042 }
7043 else if (decl_isDef (s))
7044 {
7045 /* avoid dangling else. */
7046 if (debugDecl)
7047 {
7048 outText (doP, (const char *) "adding ", 7);
7049 doNameC (doP, n);
7050 outText (doP, (const char *) " to definition module\\n", 23);
7051 }
7052 export_ (s, n);
7053 return addTo (&s->defF.decls, n);
7054 }
7055 else if (decl_isImp (s))
7056 {
7057 /* avoid dangling else. */
7058 if (debugDecl)
7059 {
7060 outText (doP, (const char *) "adding ", 7);
7061 doNameC (doP, n);
7062 outText (doP, (const char *) " to implementation module\\n", 27);
7063 }
7064 return addTo (&s->impF.decls, n);
7065 }
7066 M2RTS_HALT (-1);
7067 __builtin_unreachable ();
7068 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7069 __builtin_unreachable ();
7070 }
7071
7072
7073 /*
7074 addModuleToScope - adds module, i, to module, m, scope.
7075 */
7076
7077 static void addModuleToScope (decl_node m, decl_node i)
7078 {
7079 mcDebug_assert ((decl_getDeclScope ()) == m);
7080 if ((decl_lookupSym (decl_getSymName (i))) == NULL)
7081 {
7082 i = addToScope (i);
7083 }
7084 }
7085
7086
7087 /*
7088 completedEnum - assign boolean enumsComplete to TRUE if a definition,
7089 implementation or module symbol.
7090 */
7091
7092 static void completedEnum (decl_node n)
7093 {
7094 mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n)));
7095 if (decl_isDef (n))
7096 {
7097 n->defF.enumsComplete = true;
7098 }
7099 else if (decl_isImp (n))
7100 {
7101 /* avoid dangling else. */
7102 n->impF.enumsComplete = true;
7103 }
7104 else if (decl_isModule (n))
7105 {
7106 /* avoid dangling else. */
7107 n->moduleF.enumsComplete = true;
7108 }
7109 }
7110
7111
7112 /*
7113 setUnary - sets a unary node to contain, arg, a, and type, t.
7114 */
7115
7116 static void setUnary (decl_node u, decl_nodeT k, decl_node a, decl_node t)
7117 {
7118 switch (k)
7119 {
7120 case decl_constexp:
7121 case decl_deref:
7122 case decl_chr:
7123 case decl_cap:
7124 case decl_abs:
7125 case decl_float:
7126 case decl_trunc:
7127 case decl_ord:
7128 case decl_high:
7129 case decl_throw:
7130 case decl_re:
7131 case decl_im:
7132 case decl_not:
7133 case decl_neg:
7134 case decl_adr:
7135 case decl_size:
7136 case decl_tsize:
7137 case decl_min:
7138 case decl_max:
7139 u->kind = k;
7140 u->unaryF.arg = a;
7141 u->unaryF.resultType = t;
7142 break;
7143
7144
7145 default:
7146 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7147 __builtin_unreachable ();
7148 }
7149 }
7150
7151
7152 /*
7153 putVarBool - assigns the four booleans associated with a variable.
7154 */
7155
7156 static void putVarBool (decl_node v, bool init, bool param, bool isvar, bool isused)
7157 {
7158 mcDebug_assert (decl_isVar (v));
7159 v->varF.isInitialised = init;
7160 v->varF.isParameter = param;
7161 v->varF.isVarParameter = isvar;
7162 v->varF.isUsed = isused;
7163 }
7164
7165
7166 /*
7167 checkPtr - in C++ we need to create a typedef for a pointer
7168 in case we need to use reinterpret_cast.
7169 */
7170
7171 static decl_node checkPtr (decl_node n)
7172 {
7173 DynamicStrings_String s;
7174 decl_node p;
7175
7176 if (lang == decl_ansiCP)
7177 {
7178 if (decl_isPointer (n))
7179 {
7180 s = tempName ();
7181 p = decl_makeType (nameKey_makekey (DynamicStrings_string (s)));
7182 decl_putType (p, n);
7183 s = DynamicStrings_KillString (s);
7184 return p;
7185 }
7186 }
7187 return n;
7188 /* static analysis guarentees a RETURN statement will be used before here. */
7189 __builtin_unreachable ();
7190 }
7191
7192
7193 /*
7194 isVarDecl - returns TRUE if, n, is a vardecl node.
7195 */
7196
7197 static bool isVarDecl (decl_node n)
7198 {
7199 return n->kind == decl_vardecl;
7200 /* static analysis guarentees a RETURN statement will be used before here. */
7201 __builtin_unreachable ();
7202 }
7203
7204
7205 /*
7206 makeVariablesFromParameters - creates variables which are really parameters.
7207 */
7208
7209 static void makeVariablesFromParameters (decl_node proc, decl_node id, decl_node type, bool isvar, bool isused)
7210 {
7211 decl_node v;
7212 unsigned int i;
7213 unsigned int n;
7214 nameKey_Name m;
7215 DynamicStrings_String s;
7216
7217 mcDebug_assert (decl_isProcedure (proc));
7218 mcDebug_assert (isIdentList (id));
7219 i = 1;
7220 n = wlists_noOfItemsInList (id->identlistF.names);
7221 while (i <= n)
7222 {
7223 m = static_cast<nameKey_Name> (wlists_getItemFromList (id->identlistF.names, i));
7224 v = decl_makeVar (m);
7225 decl_putVar (v, type, NULL);
7226 putVarBool (v, true, true, isvar, isused);
7227 if (debugScopes)
7228 {
7229 libc_printf ((const char *) "adding parameter variable into top scope\\n", 42);
7230 dumpScopes ();
7231 libc_printf ((const char *) " variable name is: ", 19);
7232 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (m));
7233 if ((DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, s))) == NULL)
7234 {} /* empty. */
7235 libc_printf ((const char *) "\\n", 2);
7236 }
7237 i += 1;
7238 }
7239 }
7240
7241
7242 /*
7243 addProcedureToScope - add a procedure name n and node d to the
7244 current scope.
7245 */
7246
7247 static decl_node addProcedureToScope (decl_node d, nameKey_Name n)
7248 {
7249 decl_node m;
7250 unsigned int i;
7251
7252 i = Indexing_HighIndice (scopeStack);
7253 m = static_cast<decl_node> (Indexing_GetIndice (scopeStack, i));
7254 if (((decl_isDef (m)) && ((decl_getSymName (m)) == (nameKey_makeKey ((const char *) "M2RTS", 5)))) && ((decl_getSymName (d)) == (nameKey_makeKey ((const char *) "HALT", 4))))
7255 {
7256 haltN = d;
7257 symbolKey_putSymKey (baseSymbols, n, reinterpret_cast<void *> (haltN));
7258 }
7259 return addToScope (d);
7260 /* static analysis guarentees a RETURN statement will be used before here. */
7261 __builtin_unreachable ();
7262 }
7263
7264
7265 /*
7266 putProcTypeReturn - sets the return type of, proc, to, type.
7267 */
7268
7269 static void putProcTypeReturn (decl_node proc, decl_node type)
7270 {
7271 mcDebug_assert (decl_isProcType (proc));
7272 proc->proctypeF.returnType = type;
7273 }
7274
7275
7276 /*
7277 putProcTypeOptReturn - sets, proc, to have an optional return type.
7278 */
7279
7280 static void putProcTypeOptReturn (decl_node proc)
7281 {
7282 mcDebug_assert (decl_isProcType (proc));
7283 proc->proctypeF.returnopt = true;
7284 }
7285
7286
7287 /*
7288 makeOptParameter - creates and returns an optarg.
7289 */
7290
7291 static decl_node makeOptParameter (decl_node l, decl_node type, decl_node init)
7292 {
7293 decl_node n;
7294
7295 n = newNode (decl_optarg);
7296 n->optargF.namelist = l;
7297 n->optargF.type = type;
7298 n->optargF.init = init;
7299 n->optargF.scope = NULL;
7300 return n;
7301 /* static analysis guarentees a RETURN statement will be used before here. */
7302 __builtin_unreachable ();
7303 }
7304
7305
7306 /*
7307 setwatch - assign the globalNode to n.
7308 */
7309
7310 static bool setwatch (decl_node n)
7311 {
7312 globalNode = n;
7313 return true;
7314 /* static analysis guarentees a RETURN statement will be used before here. */
7315 __builtin_unreachable ();
7316 }
7317
7318
7319 /*
7320 runwatch - set the globalNode to an identlist.
7321 */
7322
7323 static bool runwatch (void)
7324 {
7325 return globalNode->kind == decl_identlist;
7326 /* static analysis guarentees a RETURN statement will be used before here. */
7327 __builtin_unreachable ();
7328 }
7329
7330
7331 /*
7332 isIdentList - returns TRUE if, n, is an identlist.
7333 */
7334
7335 static bool isIdentList (decl_node n)
7336 {
7337 return n->kind == decl_identlist;
7338 /* static analysis guarentees a RETURN statement will be used before here. */
7339 __builtin_unreachable ();
7340 }
7341
7342
7343 /*
7344 identListLen - returns the length of identlist.
7345 */
7346
7347 static unsigned int identListLen (decl_node n)
7348 {
7349 if (n == NULL)
7350 {
7351 return 0;
7352 }
7353 else
7354 {
7355 mcDebug_assert (isIdentList (n));
7356 return wlists_noOfItemsInList (n->identlistF.names);
7357 }
7358 /* static analysis guarentees a RETURN statement will be used before here. */
7359 __builtin_unreachable ();
7360 }
7361
7362
7363 /*
7364 checkParameters - placeholder for future parameter checking.
7365 */
7366
7367 static void checkParameters (decl_node p, decl_node i, decl_node type, bool isvar, bool isused)
7368 {
7369 /* do check. */
7370 disposeNode (&i);
7371 }
7372
7373
7374 /*
7375 checkMakeVariables - create shadow local variables for parameters providing that
7376 procedure n has not already been built and we are compiling
7377 a module or an implementation module.
7378 */
7379
7380 static void checkMakeVariables (decl_node n, decl_node i, decl_node type, bool isvar, bool isused)
7381 {
7382 if (((decl_isImp (currentModule)) || (decl_isModule (currentModule))) && ! n->procedureF.built)
7383 {
7384 makeVariablesFromParameters (n, i, type, isvar, isused);
7385 }
7386 }
7387
7388
7389 /*
7390 makeVarientField - create a varient field within varient, v,
7391 The new varient field is returned.
7392 */
7393
7394 static decl_node makeVarientField (decl_node v, decl_node p)
7395 {
7396 decl_node n;
7397
7398 n = newNode (decl_varientfield);
7399 n->varientfieldF.name = nameKey_NulName;
7400 n->varientfieldF.parent = p;
7401 n->varientfieldF.varient = v;
7402 n->varientfieldF.simple = false;
7403 n->varientfieldF.listOfSons = Indexing_InitIndex (1);
7404 n->varientfieldF.scope = decl_getDeclScope ();
7405 return n;
7406 /* static analysis guarentees a RETURN statement will be used before here. */
7407 __builtin_unreachable ();
7408 }
7409
7410
7411 /*
7412 putFieldVarient - places the field varient, f, as a brother to, the
7413 varient symbol, v, and also tells, f, that its varient
7414 parent is, v.
7415 */
7416
7417 static void putFieldVarient (decl_node f, decl_node v)
7418 {
7419 mcDebug_assert (decl_isVarient (v));
7420 mcDebug_assert (decl_isVarientField (f));
7421 switch (v->kind)
7422 {
7423 case decl_varient:
7424 Indexing_IncludeIndiceIntoIndex (v->varientF.listOfSons, reinterpret_cast<void *> (f));
7425 break;
7426
7427
7428 default:
7429 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7430 __builtin_unreachable ();
7431 }
7432 switch (f->kind)
7433 {
7434 case decl_varientfield:
7435 f->varientfieldF.varient = v;
7436 break;
7437
7438
7439 default:
7440 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7441 __builtin_unreachable ();
7442 }
7443 }
7444
7445
7446 /*
7447 putFieldRecord - create a new recordfield and place it into record r.
7448 The new field has a tagname and type and can have a
7449 variant field v.
7450 */
7451
7452 static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type, decl_node v)
7453 {
7454 decl_node f;
7455 decl_node n;
7456 decl_node p;
7457
7458 n = newNode (decl_recordfield);
7459 switch (r->kind)
7460 {
7461 case decl_record:
7462 Indexing_IncludeIndiceIntoIndex (r->recordF.listOfSons, reinterpret_cast<void *> (n));
7463 /* ensure that field, n, is in the parents Local Symbols. */
7464 if (tag != nameKey_NulName)
7465 {
7466 /* avoid gcc warning by using compound statement even if not strictly necessary. */
7467 if ((symbolKey_getSymKey (r->recordF.localSymbols, tag)) == symbolKey_NulKey)
7468 {
7469 symbolKey_putSymKey (r->recordF.localSymbols, tag, reinterpret_cast<void *> (n));
7470 }
7471 else
7472 {
7473 f = static_cast<decl_node> (symbolKey_getSymKey (r->recordF.localSymbols, tag));
7474 mcMetaError_metaErrors1 ((const char *) "field record {%1Dad} has already been declared", 46, (const char *) "field record duplicate", 22, (const unsigned char *) &f, (sizeof (f)-1));
7475 }
7476 }
7477 break;
7478
7479 case decl_varientfield:
7480 Indexing_IncludeIndiceIntoIndex (r->varientfieldF.listOfSons, reinterpret_cast<void *> (n));
7481 p = getParent (r);
7482 mcDebug_assert (p->kind == decl_record);
7483 if (tag != nameKey_NulName)
7484 {
7485 symbolKey_putSymKey (p->recordF.localSymbols, tag, reinterpret_cast<void *> (n));
7486 }
7487 break;
7488
7489
7490 default:
7491 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7492 __builtin_unreachable ();
7493 }
7494 /* fill in, n. */
7495 n->recordfieldF.type = type;
7496 n->recordfieldF.name = tag;
7497 n->recordfieldF.parent = r;
7498 n->recordfieldF.varient = v;
7499 n->recordfieldF.tag = false;
7500 n->recordfieldF.scope = NULL;
7501 initCname (&n->recordfieldF.cname);
7502 /*
7503 IF r^.kind=record
7504 THEN
7505 doRecordM2 (doP, r)
7506 END ;
7507 */
7508 return n;
7509 /* static analysis guarentees a RETURN statement will be used before here. */
7510 __builtin_unreachable ();
7511 }
7512
7513
7514 /*
7515 ensureOrder - ensures that, a, and, b, exist in, i, and also
7516 ensure that, a, is before, b.
7517 */
7518
7519 static void ensureOrder (Indexing_Index i, decl_node a, decl_node b)
7520 {
7521 mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (a)));
7522 mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (b)));
7523 Indexing_RemoveIndiceFromIndex (i, reinterpret_cast<void *> (a));
7524 Indexing_RemoveIndiceFromIndex (i, reinterpret_cast<void *> (b));
7525 Indexing_IncludeIndiceIntoIndex (i, reinterpret_cast<void *> (a));
7526 Indexing_IncludeIndiceIntoIndex (i, reinterpret_cast<void *> (b));
7527 mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (a)));
7528 mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (b)));
7529 }
7530
7531
7532 /*
7533 putVarientTag - places tag into variant v.
7534 */
7535
7536 static void putVarientTag (decl_node v, decl_node tag)
7537 {
7538 decl_node p;
7539
7540 mcDebug_assert (decl_isVarient (v));
7541 switch (v->kind)
7542 {
7543 case decl_varient:
7544 v->varientF.tag = tag;
7545 break;
7546
7547
7548 default:
7549 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7550 __builtin_unreachable ();
7551 }
7552 }
7553
7554
7555 /*
7556 getParent - returns the parent field of recordfield or varientfield symbol, n.
7557 */
7558
7559 static decl_node getParent (decl_node n)
7560 {
7561 switch (n->kind)
7562 {
7563 case decl_recordfield:
7564 return n->recordfieldF.parent;
7565 break;
7566
7567 case decl_varientfield:
7568 return n->varientfieldF.parent;
7569 break;
7570
7571
7572 default:
7573 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7574 __builtin_unreachable ();
7575 }
7576 /* static analysis guarentees a RETURN statement will be used before here. */
7577 __builtin_unreachable ();
7578 }
7579
7580
7581 /*
7582 getRecord - returns the record associated with node, n.
7583 (Parental record).
7584 */
7585
7586 static decl_node getRecord (decl_node n)
7587 {
7588 mcDebug_assert (n->kind != decl_varient); /* if this fails then we need to add parent field to varient. */
7589 switch (n->kind)
7590 {
7591 case decl_record:
7592 return n; /* if this fails then we need to add parent field to varient. */
7593 break;
7594
7595 case decl_varientfield:
7596 return getRecord (getParent (n));
7597 break;
7598
7599
7600 default:
7601 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7602 __builtin_unreachable ();
7603 }
7604 /* static analysis guarentees a RETURN statement will be used before here. */
7605 __builtin_unreachable ();
7606 }
7607
7608
7609 /*
7610 isConstExp - return TRUE if the node kind is a constexp.
7611 */
7612
7613 static bool isConstExp (decl_node c)
7614 {
7615 mcDebug_assert (c != NULL);
7616 return c->kind == decl_constexp;
7617 /* static analysis guarentees a RETURN statement will be used before here. */
7618 __builtin_unreachable ();
7619 }
7620
7621
7622 /*
7623 addEnumToModule - adds enumeration type, e, into the list of enums
7624 in module, m.
7625 */
7626
7627 static void addEnumToModule (decl_node m, decl_node e)
7628 {
7629 mcDebug_assert ((decl_isEnumeration (e)) || (decl_isEnumerationField (e)));
7630 mcDebug_assert (((decl_isModule (m)) || (decl_isDef (m))) || (decl_isImp (m)));
7631 if (decl_isModule (m))
7632 {
7633 Indexing_IncludeIndiceIntoIndex (m->moduleF.enumFixup.info, reinterpret_cast<void *> (e));
7634 }
7635 else if (decl_isDef (m))
7636 {
7637 /* avoid dangling else. */
7638 Indexing_IncludeIndiceIntoIndex (m->defF.enumFixup.info, reinterpret_cast<void *> (e));
7639 }
7640 else if (decl_isImp (m))
7641 {
7642 /* avoid dangling else. */
7643 Indexing_IncludeIndiceIntoIndex (m->impF.enumFixup.info, reinterpret_cast<void *> (e));
7644 }
7645 }
7646
7647
7648 /*
7649 getNextFixup - return the next fixup from from f.
7650 */
7651
7652 static decl_node getNextFixup (decl_fixupInfo *f)
7653 {
7654 (*f).count += 1;
7655 return static_cast<decl_node> (Indexing_GetIndice ((*f).info, (*f).count));
7656 /* static analysis guarentees a RETURN statement will be used before here. */
7657 __builtin_unreachable ();
7658 }
7659
7660
7661 /*
7662 doMakeEnum - create an enumeration type and add it to the current module.
7663 */
7664
7665 static decl_node doMakeEnum (void)
7666 {
7667 decl_node e;
7668
7669 e = newNode (decl_enumeration);
7670 e->enumerationF.noOfElements = 0;
7671 e->enumerationF.localSymbols = symbolKey_initTree ();
7672 e->enumerationF.scope = decl_getDeclScope ();
7673 e->enumerationF.listOfSons = Indexing_InitIndex (1);
7674 e->enumerationF.low = NULL;
7675 e->enumerationF.high = NULL;
7676 addEnumToModule (currentModule, e);
7677 return e;
7678 /* static analysis guarentees a RETURN statement will be used before here. */
7679 __builtin_unreachable ();
7680 }
7681
7682
7683 /*
7684 doMakeEnumField - create an enumeration field name and add it to enumeration e.
7685 Return the new field.
7686 */
7687
7688 static decl_node doMakeEnumField (decl_node e, nameKey_Name n)
7689 {
7690 decl_node f;
7691
7692 mcDebug_assert (decl_isEnumeration (e));
7693 f = decl_lookupSym (n);
7694 if (f == NULL)
7695 {
7696 f = newNode (decl_enumerationfield);
7697 symbolKey_putSymKey (e->enumerationF.localSymbols, n, reinterpret_cast<void *> (f));
7698 Indexing_IncludeIndiceIntoIndex (e->enumerationF.listOfSons, reinterpret_cast<void *> (f));
7699 f->enumerationfieldF.name = n;
7700 f->enumerationfieldF.type = e;
7701 f->enumerationfieldF.scope = decl_getDeclScope ();
7702 f->enumerationfieldF.value = e->enumerationF.noOfElements;
7703 initCname (&f->enumerationfieldF.cname);
7704 e->enumerationF.noOfElements += 1;
7705 mcDebug_assert ((Indexing_GetIndice (e->enumerationF.listOfSons, e->enumerationF.noOfElements)) == f);
7706 addEnumToModule (currentModule, f);
7707 if (e->enumerationF.low == NULL)
7708 {
7709 e->enumerationF.low = f;
7710 }
7711 e->enumerationF.high = f;
7712 return addToScope (f);
7713 }
7714 else
7715 {
7716 mcMetaError_metaErrors2 ((const char *) "cannot create enumeration field {%1k} as the name is already in use", 67, (const char *) "{%2DMad} was declared elsewhere", 31, (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &f, (sizeof (f)-1));
7717 }
7718 return f;
7719 /* static analysis guarentees a RETURN statement will be used before here. */
7720 __builtin_unreachable ();
7721 }
7722
7723
7724 /*
7725 getExpList - returns the, n, th argument in an explist.
7726 */
7727
7728 static decl_node getExpList (decl_node p, unsigned int n)
7729 {
7730 mcDebug_assert (p != NULL);
7731 mcDebug_assert (decl_isExpList (p));
7732 mcDebug_assert (n <= (Indexing_HighIndice (p->explistF.exp)));
7733 return static_cast<decl_node> (Indexing_GetIndice (p->explistF.exp, n));
7734 /* static analysis guarentees a RETURN statement will be used before here. */
7735 __builtin_unreachable ();
7736 }
7737
7738
7739 /*
7740 expListLen - returns the length of explist, p.
7741 */
7742
7743 static unsigned int expListLen (decl_node p)
7744 {
7745 if (p == NULL)
7746 {
7747 return 0;
7748 }
7749 else
7750 {
7751 mcDebug_assert (decl_isExpList (p));
7752 return Indexing_HighIndice (p->explistF.exp);
7753 }
7754 /* static analysis guarentees a RETURN statement will be used before here. */
7755 __builtin_unreachable ();
7756 }
7757
7758
7759 /*
7760 getConstExpComplete - gets the field from the def or imp or module, n.
7761 */
7762
7763 static bool getConstExpComplete (decl_node n)
7764 {
7765 switch (n->kind)
7766 {
7767 case decl_def:
7768 return n->defF.constsComplete;
7769 break;
7770
7771 case decl_imp:
7772 return n->impF.constsComplete;
7773 break;
7774
7775 case decl_module:
7776 return n->moduleF.constsComplete;
7777 break;
7778
7779
7780 default:
7781 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7782 __builtin_unreachable ();
7783 }
7784 /* static analysis guarentees a RETURN statement will be used before here. */
7785 __builtin_unreachable ();
7786 }
7787
7788
7789 /*
7790 addConstToModule - adds const exp, e, into the list of constant
7791 expressions in module, m.
7792 */
7793
7794 static void addConstToModule (decl_node m, decl_node e)
7795 {
7796 mcDebug_assert (((decl_isModule (m)) || (decl_isDef (m))) || (decl_isImp (m)));
7797 if (decl_isModule (m))
7798 {
7799 Indexing_IncludeIndiceIntoIndex (m->moduleF.constFixup.info, reinterpret_cast<void *> (e));
7800 }
7801 else if (decl_isDef (m))
7802 {
7803 /* avoid dangling else. */
7804 Indexing_IncludeIndiceIntoIndex (m->defF.constFixup.info, reinterpret_cast<void *> (e));
7805 }
7806 else if (decl_isImp (m))
7807 {
7808 /* avoid dangling else. */
7809 Indexing_IncludeIndiceIntoIndex (m->impF.constFixup.info, reinterpret_cast<void *> (e));
7810 }
7811 }
7812
7813
7814 /*
7815 doMakeConstExp - create a constexp node and add it to the current module.
7816 */
7817
7818 static decl_node doMakeConstExp (void)
7819 {
7820 decl_node c;
7821
7822 c = makeUnary (decl_constexp, NULL, NULL);
7823 addConstToModule (currentModule, c);
7824 return c;
7825 /* static analysis guarentees a RETURN statement will be used before here. */
7826 __builtin_unreachable ();
7827 }
7828
7829
7830 /*
7831 isAnyType - return TRUE if node n is any type kind.
7832 */
7833
7834 static bool isAnyType (decl_node n)
7835 {
7836 mcDebug_assert (n != NULL);
7837 switch (n->kind)
7838 {
7839 case decl_address:
7840 case decl_loc:
7841 case decl_byte:
7842 case decl_word:
7843 case decl_char:
7844 case decl_cardinal:
7845 case decl_longcard:
7846 case decl_shortcard:
7847 case decl_integer:
7848 case decl_longint:
7849 case decl_shortint:
7850 case decl_complex:
7851 case decl_longcomplex:
7852 case decl_shortcomplex:
7853 case decl_bitset:
7854 case decl_boolean:
7855 case decl_proc:
7856 case decl_type:
7857 return true;
7858 break;
7859
7860
7861 default:
7862 return false;
7863 break;
7864 }
7865 /* static analysis guarentees a RETURN statement will be used before here. */
7866 __builtin_unreachable ();
7867 }
7868
7869
7870 /*
7871 makeVal - creates a VAL (type, expression) node.
7872 */
7873
7874 static decl_node makeVal (decl_node params)
7875 {
7876 mcDebug_assert (decl_isExpList (params));
7877 if ((expListLen (params)) == 2)
7878 {
7879 return makeBinary (decl_val, getExpList (params, 1), getExpList (params, 2), getExpList (params, 1));
7880 }
7881 else
7882 {
7883 M2RTS_HALT (-1);
7884 __builtin_unreachable ();
7885 }
7886 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7887 __builtin_unreachable ();
7888 }
7889
7890
7891 /*
7892 makeCast - creates a cast node TYPENAME (expr).
7893 */
7894
7895 static decl_node makeCast (decl_node c, decl_node p)
7896 {
7897 mcDebug_assert (decl_isExpList (p));
7898 if ((expListLen (p)) == 1)
7899 {
7900 return makeBinary (decl_cast, c, getExpList (p, 1), c);
7901 }
7902 else
7903 {
7904 M2RTS_HALT (-1);
7905 __builtin_unreachable ();
7906 }
7907 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
7908 __builtin_unreachable ();
7909 }
7910
7911 static decl_node makeIntrinsicProc (decl_nodeT k, unsigned int noArgs, decl_node p)
7912 {
7913 decl_node f;
7914
7915 /*
7916 makeIntrisicProc - create an intrinsic node.
7917 */
7918 f = newNode (k);
7919 f->intrinsicF.args = p;
7920 f->intrinsicF.noArgs = noArgs;
7921 f->intrinsicF.type = NULL;
7922 f->intrinsicF.postUnreachable = k == decl_halt;
7923 initPair (&f->intrinsicF.intrinsicComment);
7924 return f;
7925 /* static analysis guarentees a RETURN statement will be used before here. */
7926 __builtin_unreachable ();
7927 }
7928
7929
7930 /*
7931 makeIntrinsicUnaryType - create an intrisic unary type.
7932 */
7933
7934 static decl_node makeIntrinsicUnaryType (decl_nodeT k, decl_node paramList, decl_node returnType)
7935 {
7936 return makeUnary (k, getExpList (paramList, 1), returnType);
7937 /* static analysis guarentees a RETURN statement will be used before here. */
7938 __builtin_unreachable ();
7939 }
7940
7941
7942 /*
7943 makeIntrinsicBinaryType - create an intrisic binary type.
7944 */
7945
7946 static decl_node makeIntrinsicBinaryType (decl_nodeT k, decl_node paramList, decl_node returnType)
7947 {
7948 return makeBinary (k, getExpList (paramList, 1), getExpList (paramList, 2), returnType);
7949 /* static analysis guarentees a RETURN statement will be used before here. */
7950 __builtin_unreachable ();
7951 }
7952
7953
7954 /*
7955 checkIntrinsic - checks to see if the function call to, c, with
7956 parameter list, n, is really an intrinic. If it
7957 is an intrinic then an intrinic node is created
7958 and returned. Otherwise NIL is returned.
7959 */
7960
7961 static decl_node checkIntrinsic (decl_node c, decl_node n)
7962 {
7963 if (isAnyType (c))
7964 {
7965 return makeCast (c, n);
7966 }
7967 else if (c == maxN)
7968 {
7969 /* avoid dangling else. */
7970 return makeIntrinsicUnaryType (decl_max, n, NULL);
7971 }
7972 else if (c == minN)
7973 {
7974 /* avoid dangling else. */
7975 return makeIntrinsicUnaryType (decl_min, n, NULL);
7976 }
7977 else if (c == haltN)
7978 {
7979 /* avoid dangling else. */
7980 return makeIntrinsicProc (decl_halt, expListLen (n), n);
7981 }
7982 else if (c == valN)
7983 {
7984 /* avoid dangling else. */
7985 return makeVal (n);
7986 }
7987 else if (c == adrN)
7988 {
7989 /* avoid dangling else. */
7990 return makeIntrinsicUnaryType (decl_adr, n, addressN);
7991 }
7992 else if (c == sizeN)
7993 {
7994 /* avoid dangling else. */
7995 return makeIntrinsicUnaryType (decl_size, n, cardinalN);
7996 }
7997 else if (c == tsizeN)
7998 {
7999 /* avoid dangling else. */
8000 return makeIntrinsicUnaryType (decl_tsize, n, cardinalN);
8001 }
8002 else if (c == floatN)
8003 {
8004 /* avoid dangling else. */
8005 return makeIntrinsicUnaryType (decl_float, n, realN);
8006 }
8007 else if (c == truncN)
8008 {
8009 /* avoid dangling else. */
8010 return makeIntrinsicUnaryType (decl_trunc, n, integerN);
8011 }
8012 else if (c == ordN)
8013 {
8014 /* avoid dangling else. */
8015 return makeIntrinsicUnaryType (decl_ord, n, cardinalN);
8016 }
8017 else if (c == chrN)
8018 {
8019 /* avoid dangling else. */
8020 return makeIntrinsicUnaryType (decl_chr, n, charN);
8021 }
8022 else if (c == capN)
8023 {
8024 /* avoid dangling else. */
8025 return makeIntrinsicUnaryType (decl_cap, n, charN);
8026 }
8027 else if (c == absN)
8028 {
8029 /* avoid dangling else. */
8030 return makeIntrinsicUnaryType (decl_abs, n, NULL);
8031 }
8032 else if (c == imN)
8033 {
8034 /* avoid dangling else. */
8035 return makeIntrinsicUnaryType (decl_im, n, NULL);
8036 }
8037 else if (c == reN)
8038 {
8039 /* avoid dangling else. */
8040 return makeIntrinsicUnaryType (decl_re, n, NULL);
8041 }
8042 else if (c == cmplxN)
8043 {
8044 /* avoid dangling else. */
8045 return makeIntrinsicBinaryType (decl_cmplx, n, NULL);
8046 }
8047 else if (c == highN)
8048 {
8049 /* avoid dangling else. */
8050 return makeIntrinsicUnaryType (decl_high, n, cardinalN);
8051 }
8052 else if (c == incN)
8053 {
8054 /* avoid dangling else. */
8055 return makeIntrinsicProc (decl_inc, expListLen (n), n);
8056 }
8057 else if (c == decN)
8058 {
8059 /* avoid dangling else. */
8060 return makeIntrinsicProc (decl_dec, expListLen (n), n);
8061 }
8062 else if (c == inclN)
8063 {
8064 /* avoid dangling else. */
8065 return makeIntrinsicProc (decl_incl, expListLen (n), n);
8066 }
8067 else if (c == exclN)
8068 {
8069 /* avoid dangling else. */
8070 return makeIntrinsicProc (decl_excl, expListLen (n), n);
8071 }
8072 else if (c == newN)
8073 {
8074 /* avoid dangling else. */
8075 return makeIntrinsicProc (decl_new, 1, n);
8076 }
8077 else if (c == disposeN)
8078 {
8079 /* avoid dangling else. */
8080 return makeIntrinsicProc (decl_dispose, 1, n);
8081 }
8082 else if (c == lengthN)
8083 {
8084 /* avoid dangling else. */
8085 return makeIntrinsicUnaryType (decl_length, n, cardinalN);
8086 }
8087 else if (c == throwN)
8088 {
8089 /* avoid dangling else. */
8090 keyc_useThrow ();
8091 return makeIntrinsicProc (decl_throw, 1, n);
8092 }
8093 return NULL;
8094 /* static analysis guarentees a RETURN statement will be used before here. */
8095 __builtin_unreachable ();
8096 }
8097
8098
8099 /*
8100 checkCHeaders - check to see if the function is a C system function and
8101 requires a header file included.
8102 */
8103
8104 static void checkCHeaders (decl_node c)
8105 {
8106 nameKey_Name name;
8107 decl_node s;
8108
8109 if (decl_isProcedure (c))
8110 {
8111 s = decl_getScope (c);
8112 if ((decl_getSymName (s)) == (nameKey_makeKey ((const char *) "libc", 4)))
8113 {
8114 name = decl_getSymName (c);
8115 if ((((name == (nameKey_makeKey ((const char *) "read", 4))) || (name == (nameKey_makeKey ((const char *) "write", 5)))) || (name == (nameKey_makeKey ((const char *) "open", 4)))) || (name == (nameKey_makeKey ((const char *) "close", 5))))
8116 {
8117 keyc_useUnistd ();
8118 }
8119 }
8120 }
8121 }
8122
8123
8124 /*
8125 isFuncCall - returns TRUE if, n, is a function/procedure call.
8126 */
8127
8128 static bool isFuncCall (decl_node n)
8129 {
8130 mcDebug_assert (n != NULL);
8131 return n->kind == decl_funccall;
8132 /* static analysis guarentees a RETURN statement will be used before here. */
8133 __builtin_unreachable ();
8134 }
8135
8136
8137 /*
8138 putTypeInternal - marks type, des, as being an internally generated type.
8139 */
8140
8141 static void putTypeInternal (decl_node des)
8142 {
8143 mcDebug_assert (des != NULL);
8144 mcDebug_assert (decl_isType (des));
8145 des->typeF.isInternal = true;
8146 }
8147
8148
8149 /*
8150 isTypeInternal - returns TRUE if type, n, is internal.
8151 */
8152
8153 static bool isTypeInternal (decl_node n)
8154 {
8155 mcDebug_assert (n != NULL);
8156 mcDebug_assert (decl_isType (n));
8157 return n->typeF.isInternal;
8158 /* static analysis guarentees a RETURN statement will be used before here. */
8159 __builtin_unreachable ();
8160 }
8161
8162
8163 /*
8164 lookupBase - return node named n from the base symbol scope.
8165 */
8166
8167 static decl_node lookupBase (nameKey_Name n)
8168 {
8169 decl_node m;
8170
8171 m = static_cast<decl_node> (symbolKey_getSymKey (baseSymbols, n));
8172 if (m == procN)
8173 {
8174 keyc_useProc ();
8175 }
8176 else if (((m == complexN) || (m == longcomplexN)) || (m == shortcomplexN))
8177 {
8178 /* avoid dangling else. */
8179 keyc_useComplex ();
8180 }
8181 return m;
8182 /* static analysis guarentees a RETURN statement will be used before here. */
8183 __builtin_unreachable ();
8184 }
8185
8186
8187 /*
8188 dumpScopes - display the names of all the scopes stacked.
8189 */
8190
8191 static void dumpScopes (void)
8192 {
8193 unsigned int h;
8194 decl_node s;
8195
8196 h = Indexing_HighIndice (scopeStack);
8197 libc_printf ((const char *) "total scopes stacked %d\\n", 25, h);
8198 while (h >= 1)
8199 {
8200 s = static_cast<decl_node> (Indexing_GetIndice (scopeStack, h));
8201 out2 ((const char *) " scope [%d] is %s\\n", 19, h, s);
8202 h -= 1;
8203 }
8204 }
8205
8206
8207 /*
8208 out0 - write string a to StdOut.
8209 */
8210
8211 static void out0 (const char *a_, unsigned int _a_high)
8212 {
8213 DynamicStrings_String m;
8214 char a[_a_high+1];
8215
8216 /* make a local copy of each unbounded array. */
8217 memcpy (a, a_, _a_high+1);
8218
8219 m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) a, _a_high));
8220 m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
8221 }
8222
8223
8224 /*
8225 out1 - write string a to StdOut using format specifier a.
8226 */
8227
8228 static void out1 (const char *a_, unsigned int _a_high, decl_node s)
8229 {
8230 DynamicStrings_String m;
8231 unsigned int d;
8232 char a[_a_high+1];
8233
8234 /* make a local copy of each unbounded array. */
8235 memcpy (a, a_, _a_high+1);
8236
8237 m = getFQstring (s);
8238 if (DynamicStrings_EqualArray (m, (const char *) "", 0))
8239 {
8240 d = (unsigned int ) ((long unsigned int ) (s));
8241 m = DynamicStrings_KillString (m);
8242 m = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "[%d]", 4), (const unsigned char *) &d, (sizeof (d)-1));
8243 }
8244 m = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &m, (sizeof (m)-1));
8245 m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
8246 }
8247
8248
8249 /*
8250 out2 - write string a to StdOut using format specifier a.
8251 */
8252
8253 static void out2 (const char *a_, unsigned int _a_high, unsigned int c, decl_node s)
8254 {
8255 DynamicStrings_String m;
8256 DynamicStrings_String m1;
8257 char a[_a_high+1];
8258
8259 /* make a local copy of each unbounded array. */
8260 memcpy (a, a_, _a_high+1);
8261
8262 m1 = getString (s);
8263 m = FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) &m1, (sizeof (m1)-1));
8264 m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
8265 m1 = DynamicStrings_KillString (m1);
8266 }
8267
8268
8269 /*
8270 out3 - write string a to StdOut using format specifier a.
8271 */
8272
8273 static void out3 (const char *a_, unsigned int _a_high, unsigned int l, nameKey_Name n, decl_node s)
8274 {
8275 DynamicStrings_String m;
8276 DynamicStrings_String m1;
8277 DynamicStrings_String m2;
8278 char a[_a_high+1];
8279
8280 /* make a local copy of each unbounded array. */
8281 memcpy (a, a_, _a_high+1);
8282
8283 m1 = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
8284 m2 = getString (s);
8285 m = FormatStrings_Sprintf3 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &l, (sizeof (l)-1), (const unsigned char *) &m1, (sizeof (m1)-1), (const unsigned char *) &m2, (sizeof (m2)-1));
8286 m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
8287 m1 = DynamicStrings_KillString (m1);
8288 m2 = DynamicStrings_KillString (m2);
8289 }
8290
8291
8292 /*
8293 isUnary - returns TRUE if, n, is an unary node.
8294 */
8295
8296 static bool isUnary (decl_node n)
8297 {
8298 mcDebug_assert (n != NULL);
8299 switch (n->kind)
8300 {
8301 case decl_length:
8302 case decl_re:
8303 case decl_im:
8304 case decl_deref:
8305 case decl_high:
8306 case decl_chr:
8307 case decl_cap:
8308 case decl_abs:
8309 case decl_ord:
8310 case decl_float:
8311 case decl_trunc:
8312 case decl_constexp:
8313 case decl_not:
8314 case decl_neg:
8315 case decl_adr:
8316 case decl_size:
8317 case decl_tsize:
8318 case decl_min:
8319 case decl_max:
8320 return true;
8321 break;
8322
8323
8324 default:
8325 return false;
8326 break;
8327 }
8328 /* static analysis guarentees a RETURN statement will be used before here. */
8329 __builtin_unreachable ();
8330 }
8331
8332
8333 /*
8334 isBinary - returns TRUE if, n, is an binary node.
8335 */
8336
8337 static bool isBinary (decl_node n)
8338 {
8339 mcDebug_assert (n != NULL);
8340 switch (n->kind)
8341 {
8342 case decl_cmplx:
8343 case decl_and:
8344 case decl_or:
8345 case decl_equal:
8346 case decl_notequal:
8347 case decl_less:
8348 case decl_greater:
8349 case decl_greequal:
8350 case decl_lessequal:
8351 case decl_val:
8352 case decl_cast:
8353 case decl_plus:
8354 case decl_sub:
8355 case decl_div:
8356 case decl_mod:
8357 case decl_mult:
8358 case decl_divide:
8359 case decl_in:
8360 return true;
8361 break;
8362
8363
8364 default:
8365 return false;
8366 break;
8367 }
8368 /* static analysis guarentees a RETURN statement will be used before here. */
8369 __builtin_unreachable ();
8370 }
8371
8372
8373 /*
8374 makeUnary - create a unary expression node with, e, as the argument
8375 and res as the return type.
8376 */
8377
8378 static decl_node makeUnary (decl_nodeT k, decl_node e, decl_node res)
8379 {
8380 decl_node n;
8381
8382 if (k == decl_plus)
8383 {
8384 return e;
8385 }
8386 else
8387 {
8388 n = newNode (k);
8389 switch (n->kind)
8390 {
8391 case decl_min:
8392 case decl_max:
8393 case decl_throw:
8394 case decl_re:
8395 case decl_im:
8396 case decl_deref:
8397 case decl_high:
8398 case decl_chr:
8399 case decl_cap:
8400 case decl_abs:
8401 case decl_ord:
8402 case decl_float:
8403 case decl_trunc:
8404 case decl_length:
8405 case decl_constexp:
8406 case decl_not:
8407 case decl_neg:
8408 case decl_adr:
8409 case decl_size:
8410 case decl_tsize:
8411 n->unaryF.arg = e;
8412 n->unaryF.resultType = res;
8413 break;
8414
8415
8416 default:
8417 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
8418 __builtin_unreachable ();
8419 }
8420 }
8421 return n;
8422 /* static analysis guarentees a RETURN statement will be used before here. */
8423 __builtin_unreachable ();
8424 }
8425
8426
8427 /*
8428 isLeafString - returns TRUE if n is a leaf node which is a string constant.
8429 */
8430
8431 static bool isLeafString (decl_node n)
8432 {
8433 return ((isString (n)) || ((decl_isLiteral (n)) && ((decl_getType (n)) == charN))) || ((decl_isConst (n)) && ((getExprType (n)) == charN));
8434 /* static analysis guarentees a RETURN statement will be used before here. */
8435 __builtin_unreachable ();
8436 }
8437
8438
8439 /*
8440 getLiteralStringContents - return the contents of a literal node as a string.
8441 */
8442
8443 static DynamicStrings_String getLiteralStringContents (decl_node n)
8444 {
8445 DynamicStrings_String number;
8446 DynamicStrings_String content;
8447 DynamicStrings_String s;
8448
8449 mcDebug_assert (n->kind == decl_literal);
8450 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n->literalF.name));
8451 content = NULL;
8452 if (n->literalF.type == charN)
8453 {
8454 if ((DynamicStrings_char (s, -1)) == 'C')
8455 {
8456 if ((DynamicStrings_Length (s)) > 1)
8457 {
8458 number = DynamicStrings_Slice (s, 0, -1);
8459 content = DynamicStrings_InitStringChar ((char ) (StringConvert_ostoc (number)));
8460 number = DynamicStrings_KillString (number);
8461 }
8462 else
8463 {
8464 content = DynamicStrings_InitStringChar ('C');
8465 }
8466 }
8467 else
8468 {
8469 content = DynamicStrings_Dup (s);
8470 }
8471 }
8472 else
8473 {
8474 mcMetaError_metaError1 ((const char *) "cannot obtain string contents from {%1k}", 40, (const unsigned char *) &n->literalF.name, (sizeof (n->literalF.name)-1));
8475 }
8476 s = DynamicStrings_KillString (s);
8477 return content;
8478 /* static analysis guarentees a RETURN statement will be used before here. */
8479 __builtin_unreachable ();
8480 }
8481
8482
8483 /*
8484 getStringContents - return the string contents of a constant, literal,
8485 string or a constexp node.
8486 */
8487
8488 static DynamicStrings_String getStringContents (decl_node n)
8489 {
8490 if (decl_isConst (n))
8491 {
8492 return getStringContents (n->constF.value);
8493 }
8494 else if (decl_isLiteral (n))
8495 {
8496 /* avoid dangling else. */
8497 return getLiteralStringContents (n);
8498 }
8499 else if (isString (n))
8500 {
8501 /* avoid dangling else. */
8502 return getString (n);
8503 }
8504 else if (isConstExp (n))
8505 {
8506 /* avoid dangling else. */
8507 return getStringContents (n->unaryF.arg);
8508 }
8509 M2RTS_HALT (-1);
8510 __builtin_unreachable ();
8511 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
8512 __builtin_unreachable ();
8513 }
8514
8515
8516 /*
8517 addNames -
8518 */
8519
8520 static nameKey_Name addNames (decl_node a, decl_node b)
8521 {
8522 DynamicStrings_String sa;
8523 DynamicStrings_String sb;
8524 nameKey_Name n;
8525
8526 sa = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (a)));
8527 sb = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (b)));
8528 sa = DynamicStrings_ConCat (sa, sb);
8529 n = nameKey_makekey (DynamicStrings_string (sa));
8530 sa = DynamicStrings_KillString (sa);
8531 sb = DynamicStrings_KillString (sb);
8532 return n;
8533 /* static analysis guarentees a RETURN statement will be used before here. */
8534 __builtin_unreachable ();
8535 }
8536
8537
8538 /*
8539 resolveString -
8540 */
8541
8542 static decl_node resolveString (decl_node n)
8543 {
8544 while ((decl_isConst (n)) || (isConstExp (n)))
8545 {
8546 if (decl_isConst (n))
8547 {
8548 n = n->constF.value;
8549 }
8550 else
8551 {
8552 n = n->unaryF.arg;
8553 }
8554 }
8555 if (n->kind == decl_plus)
8556 {
8557 n = decl_makeString (addNames (resolveString (n->binaryF.left), resolveString (n->binaryF.right)));
8558 }
8559 return n;
8560 /* static analysis guarentees a RETURN statement will be used before here. */
8561 __builtin_unreachable ();
8562 }
8563
8564
8565 /*
8566 foldBinary -
8567 */
8568
8569 static decl_node foldBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res)
8570 {
8571 decl_node n;
8572 DynamicStrings_String ls;
8573 DynamicStrings_String rs;
8574
8575 n = NULL;
8576 if (((k == decl_plus) && (isLeafString (l))) && (isLeafString (r)))
8577 {
8578 ls = getStringContents (l);
8579 rs = getStringContents (r);
8580 ls = DynamicStrings_Add (ls, rs);
8581 n = decl_makeString (nameKey_makekey (DynamicStrings_string (ls)));
8582 ls = DynamicStrings_KillString (ls);
8583 rs = DynamicStrings_KillString (rs);
8584 }
8585 return n;
8586 /* static analysis guarentees a RETURN statement will be used before here. */
8587 __builtin_unreachable ();
8588 }
8589
8590
8591 /*
8592 makeBinary - create a binary node with left/right/result type: l, r and resultType.
8593 */
8594
8595 static decl_node makeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node resultType)
8596 {
8597 decl_node n;
8598
8599 n = foldBinary (k, l, r, resultType);
8600 if (n == NULL)
8601 {
8602 n = doMakeBinary (k, l, r, resultType);
8603 }
8604 return n;
8605 /* static analysis guarentees a RETURN statement will be used before here. */
8606 __builtin_unreachable ();
8607 }
8608
8609
8610 /*
8611 doMakeBinary - returns a binary node containing left/right/result values
8612 l, r, res, with a node operator, k.
8613 */
8614
8615 static decl_node doMakeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res)
8616 {
8617 decl_node n;
8618
8619 n = newNode (k);
8620 switch (n->kind)
8621 {
8622 case decl_cmplx:
8623 case decl_equal:
8624 case decl_notequal:
8625 case decl_less:
8626 case decl_greater:
8627 case decl_greequal:
8628 case decl_lessequal:
8629 case decl_and:
8630 case decl_or:
8631 case decl_cast:
8632 case decl_val:
8633 case decl_plus:
8634 case decl_sub:
8635 case decl_div:
8636 case decl_mod:
8637 case decl_mult:
8638 case decl_divide:
8639 case decl_in:
8640 n->binaryF.left = l;
8641 n->binaryF.right = r;
8642 n->binaryF.resultType = res;
8643 break;
8644
8645
8646 default:
8647 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
8648 __builtin_unreachable ();
8649 }
8650 return n;
8651 /* static analysis guarentees a RETURN statement will be used before here. */
8652 __builtin_unreachable ();
8653 }
8654
8655
8656 /*
8657 doMakeComponentRef -
8658 */
8659
8660 static decl_node doMakeComponentRef (decl_node rec, decl_node field)
8661 {
8662 decl_node n;
8663
8664 n = newNode (decl_componentref);
8665 n->componentrefF.rec = rec;
8666 n->componentrefF.field = field;
8667 n->componentrefF.resultType = decl_getType (field);
8668 return n;
8669 /* static analysis guarentees a RETURN statement will be used before here. */
8670 __builtin_unreachable ();
8671 }
8672
8673
8674 /*
8675 isComponentRef -
8676 */
8677
8678 static bool isComponentRef (decl_node n)
8679 {
8680 mcDebug_assert (n != NULL);
8681 return n->kind == decl_componentref;
8682 /* static analysis guarentees a RETURN statement will be used before here. */
8683 __builtin_unreachable ();
8684 }
8685
8686
8687 /*
8688 isArrayRef - returns TRUE if the node was an arrayref.
8689 */
8690
8691 static bool isArrayRef (decl_node n)
8692 {
8693 mcDebug_assert (n != NULL);
8694 return n->kind == decl_arrayref;
8695 /* static analysis guarentees a RETURN statement will be used before here. */
8696 __builtin_unreachable ();
8697 }
8698
8699
8700 /*
8701 isDeref - returns TRUE if, n, is a deref node.
8702 */
8703
8704 static bool isDeref (decl_node n)
8705 {
8706 mcDebug_assert (n != NULL);
8707 return n->kind == decl_deref;
8708 /* static analysis guarentees a RETURN statement will be used before here. */
8709 __builtin_unreachable ();
8710 }
8711
8712
8713 /*
8714 makeBase - create a base type or constant.
8715 It only supports the base types and constants
8716 enumerated below.
8717 */
8718
8719 static decl_node makeBase (decl_nodeT k)
8720 {
8721 decl_node n;
8722
8723 n = newNode (k);
8724 switch (k)
8725 {
8726 case decl_new:
8727 case decl_dispose:
8728 case decl_length:
8729 case decl_inc:
8730 case decl_dec:
8731 case decl_incl:
8732 case decl_excl:
8733 case decl_nil:
8734 case decl_true:
8735 case decl_false:
8736 case decl_address:
8737 case decl_loc:
8738 case decl_byte:
8739 case decl_word:
8740 case decl_csizet:
8741 case decl_cssizet:
8742 case decl_char:
8743 case decl_cardinal:
8744 case decl_longcard:
8745 case decl_shortcard:
8746 case decl_integer:
8747 case decl_longint:
8748 case decl_shortint:
8749 case decl_real:
8750 case decl_longreal:
8751 case decl_shortreal:
8752 case decl_bitset:
8753 case decl_boolean:
8754 case decl_proc:
8755 case decl_ztype:
8756 case decl_rtype:
8757 case decl_complex:
8758 case decl_longcomplex:
8759 case decl_shortcomplex:
8760 case decl_adr:
8761 case decl_chr:
8762 case decl_cap:
8763 case decl_abs:
8764 case decl_float:
8765 case decl_trunc:
8766 case decl_ord:
8767 case decl_high:
8768 case decl_throw:
8769 case decl_re:
8770 case decl_im:
8771 case decl_cmplx:
8772 case decl_size:
8773 case decl_tsize:
8774 case decl_val:
8775 case decl_min:
8776 case decl_max:
8777 break;
8778
8779
8780 default:
8781 M2RTS_HALT (-1); /* legal kind. */
8782 __builtin_unreachable ();
8783 break;
8784 }
8785 return n;
8786 /* static analysis guarentees a RETURN statement will be used before here. */
8787 __builtin_unreachable ();
8788 }
8789
8790
8791 /*
8792 isOrdinal - returns TRUE if, n, is an ordinal type.
8793 */
8794
8795 static bool isOrdinal (decl_node n)
8796 {
8797 switch (n->kind)
8798 {
8799 case decl_address:
8800 case decl_loc:
8801 case decl_byte:
8802 case decl_word:
8803 case decl_csizet:
8804 case decl_cssizet:
8805 case decl_char:
8806 case decl_integer:
8807 case decl_longint:
8808 case decl_shortint:
8809 case decl_cardinal:
8810 case decl_longcard:
8811 case decl_shortcard:
8812 case decl_bitset:
8813 return true;
8814 break;
8815
8816
8817 default:
8818 return false;
8819 break;
8820 }
8821 /* static analysis guarentees a RETURN statement will be used before here. */
8822 __builtin_unreachable ();
8823 }
8824
8825
8826 /*
8827 mixTypes -
8828 */
8829
8830 static decl_node mixTypes (decl_node a, decl_node b)
8831 {
8832 if ((a == addressN) || (b == addressN))
8833 {
8834 return addressN;
8835 }
8836 return a;
8837 /* static analysis guarentees a RETURN statement will be used before here. */
8838 __builtin_unreachable ();
8839 }
8840
8841
8842 /*
8843 doSetExprType -
8844 */
8845
8846 static decl_node doSetExprType (decl_node *t, decl_node n)
8847 {
8848 if ((*t) == NULL)
8849 {
8850 (*t) = n;
8851 }
8852 return (*t);
8853 /* static analysis guarentees a RETURN statement will be used before here. */
8854 __builtin_unreachable ();
8855 }
8856
8857
8858 /*
8859 getMaxMinType -
8860 */
8861
8862 static decl_node getMaxMinType (decl_node n)
8863 {
8864 if ((decl_isVar (n)) || (decl_isConst (n)))
8865 {
8866 return decl_getType (n);
8867 }
8868 else if (isConstExp (n))
8869 {
8870 /* avoid dangling else. */
8871 n = getExprType (n->unaryF.arg);
8872 if (n == bitsetN)
8873 {
8874 return ztypeN;
8875 }
8876 else
8877 {
8878 return n;
8879 }
8880 }
8881 else
8882 {
8883 /* avoid dangling else. */
8884 return n;
8885 }
8886 /* static analysis guarentees a RETURN statement will be used before here. */
8887 __builtin_unreachable ();
8888 }
8889
8890
8891 /*
8892 doGetFuncType -
8893 */
8894
8895 static decl_node doGetFuncType (decl_node n)
8896 {
8897 mcDebug_assert (isFuncCall (n));
8898 return doSetExprType (&n->funccallF.type, decl_getType (n->funccallF.function));
8899 /* static analysis guarentees a RETURN statement will be used before here. */
8900 __builtin_unreachable ();
8901 }
8902
8903
8904 /*
8905 doGetExprType - works out the type which is associated with node, n.
8906 */
8907
8908 static decl_node doGetExprType (decl_node n)
8909 {
8910 switch (n->kind)
8911 {
8912 case decl_max:
8913 case decl_min:
8914 return getMaxMinType (n->unaryF.arg);
8915 break;
8916
8917 case decl_cast:
8918 case decl_val:
8919 return doSetExprType (&n->binaryF.resultType, n->binaryF.left);
8920 break;
8921
8922 case decl_halt:
8923 case decl_new:
8924 case decl_dispose:
8925 return NULL;
8926 break;
8927
8928 case decl_inc:
8929 case decl_dec:
8930 case decl_incl:
8931 case decl_excl:
8932 return NULL;
8933 break;
8934
8935 case decl_nil:
8936 return addressN;
8937 break;
8938
8939 case decl_true:
8940 case decl_false:
8941 return booleanN;
8942 break;
8943
8944 case decl_address:
8945 return n;
8946 break;
8947
8948 case decl_loc:
8949 return n;
8950 break;
8951
8952 case decl_byte:
8953 return n;
8954 break;
8955
8956 case decl_word:
8957 return n;
8958 break;
8959
8960 case decl_csizet:
8961 return n;
8962 break;
8963
8964 case decl_cssizet:
8965 return n;
8966 break;
8967
8968 case decl_boolean:
8969 /* base types. */
8970 return n;
8971 break;
8972
8973 case decl_proc:
8974 return n;
8975 break;
8976
8977 case decl_char:
8978 return n;
8979 break;
8980
8981 case decl_cardinal:
8982 return n;
8983 break;
8984
8985 case decl_longcard:
8986 return n;
8987 break;
8988
8989 case decl_shortcard:
8990 return n;
8991 break;
8992
8993 case decl_integer:
8994 return n;
8995 break;
8996
8997 case decl_longint:
8998 return n;
8999 break;
9000
9001 case decl_shortint:
9002 return n;
9003 break;
9004
9005 case decl_real:
9006 return n;
9007 break;
9008
9009 case decl_longreal:
9010 return n;
9011 break;
9012
9013 case decl_shortreal:
9014 return n;
9015 break;
9016
9017 case decl_bitset:
9018 return n;
9019 break;
9020
9021 case decl_ztype:
9022 return n;
9023 break;
9024
9025 case decl_rtype:
9026 return n;
9027 break;
9028
9029 case decl_complex:
9030 return n;
9031 break;
9032
9033 case decl_longcomplex:
9034 return n;
9035 break;
9036
9037 case decl_shortcomplex:
9038 return n;
9039 break;
9040
9041 case decl_type:
9042 /* language features and compound type attributes. */
9043 return n->typeF.type;
9044 break;
9045
9046 case decl_record:
9047 return n;
9048 break;
9049
9050 case decl_varient:
9051 return n;
9052 break;
9053
9054 case decl_var:
9055 return n->varF.type;
9056 break;
9057
9058 case decl_enumeration:
9059 return n;
9060 break;
9061
9062 case decl_subrange:
9063 return n->subrangeF.type;
9064 break;
9065
9066 case decl_array:
9067 return n->arrayF.type;
9068 break;
9069
9070 case decl_string:
9071 return charN;
9072 break;
9073
9074 case decl_const:
9075 return doSetExprType (&n->constF.type, getExprType (n->constF.value));
9076 break;
9077
9078 case decl_literal:
9079 return n->literalF.type;
9080 break;
9081
9082 case decl_varparam:
9083 return n->varparamF.type;
9084 break;
9085
9086 case decl_param:
9087 return n->paramF.type;
9088 break;
9089
9090 case decl_optarg:
9091 return n->optargF.type;
9092 break;
9093
9094 case decl_pointer:
9095 return n->pointerF.type;
9096 break;
9097
9098 case decl_recordfield:
9099 return n->recordfieldF.type;
9100 break;
9101
9102 case decl_varientfield:
9103 return n;
9104 break;
9105
9106 case decl_enumerationfield:
9107 return n->enumerationfieldF.type;
9108 break;
9109
9110 case decl_set:
9111 return n->setF.type;
9112 break;
9113
9114 case decl_proctype:
9115 return n->proctypeF.returnType;
9116 break;
9117
9118 case decl_subscript:
9119 return n->subscriptF.type;
9120 break;
9121
9122 case decl_procedure:
9123 /* blocks. */
9124 return n->procedureF.returnType;
9125 break;
9126
9127 case decl_throw:
9128 return NULL;
9129 break;
9130
9131 case decl_unreachable:
9132 return NULL;
9133 break;
9134
9135 case decl_def:
9136 case decl_imp:
9137 case decl_module:
9138 case decl_loop:
9139 case decl_while:
9140 case decl_for:
9141 case decl_repeat:
9142 case decl_if:
9143 case decl_elsif:
9144 case decl_assignment:
9145 /* statements. */
9146 M2RTS_HALT (-1);
9147 __builtin_unreachable ();
9148 break;
9149
9150 case decl_plus:
9151 case decl_sub:
9152 case decl_div:
9153 case decl_mod:
9154 case decl_mult:
9155 case decl_divide:
9156 /* expressions. */
9157 return doSetExprType (&n->binaryF.resultType, mixTypes (getExprType (n->binaryF.left), getExprType (n->binaryF.right)));
9158 break;
9159
9160 case decl_in:
9161 case decl_and:
9162 case decl_or:
9163 case decl_equal:
9164 case decl_notequal:
9165 case decl_less:
9166 case decl_greater:
9167 case decl_greequal:
9168 case decl_lessequal:
9169 return doSetExprType (&n->binaryF.resultType, booleanN);
9170 break;
9171
9172 case decl_cmplx:
9173 return doSetExprType (&n->binaryF.resultType, complexN);
9174 break;
9175
9176 case decl_abs:
9177 case decl_constexp:
9178 case decl_deref:
9179 case decl_neg:
9180 return doSetExprType (&n->unaryF.resultType, getExprType (n->unaryF.arg));
9181 break;
9182
9183 case decl_adr:
9184 return doSetExprType (&n->unaryF.resultType, addressN);
9185 break;
9186
9187 case decl_size:
9188 case decl_tsize:
9189 return doSetExprType (&n->unaryF.resultType, cardinalN);
9190 break;
9191
9192 case decl_high:
9193 case decl_ord:
9194 return doSetExprType (&n->unaryF.resultType, cardinalN);
9195 break;
9196
9197 case decl_float:
9198 return doSetExprType (&n->unaryF.resultType, realN);
9199 break;
9200
9201 case decl_trunc:
9202 return doSetExprType (&n->unaryF.resultType, integerN);
9203 break;
9204
9205 case decl_chr:
9206 return doSetExprType (&n->unaryF.resultType, charN);
9207 break;
9208
9209 case decl_cap:
9210 return doSetExprType (&n->unaryF.resultType, charN);
9211 break;
9212
9213 case decl_not:
9214 return doSetExprType (&n->unaryF.resultType, booleanN);
9215 break;
9216
9217 case decl_re:
9218 return doSetExprType (&n->unaryF.resultType, realN);
9219 break;
9220
9221 case decl_im:
9222 return doSetExprType (&n->unaryF.resultType, realN);
9223 break;
9224
9225 case decl_arrayref:
9226 return n->arrayrefF.resultType;
9227 break;
9228
9229 case decl_componentref:
9230 return n->componentrefF.resultType;
9231 break;
9232
9233 case decl_pointerref:
9234 return n->pointerrefF.resultType;
9235 break;
9236
9237 case decl_funccall:
9238 return doSetExprType (&n->funccallF.type, doGetFuncType (n));
9239 break;
9240
9241 case decl_setvalue:
9242 return n->setvalueF.type;
9243 break;
9244
9245
9246 default:
9247 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
9248 __builtin_unreachable ();
9249 }
9250 M2RTS_HALT (-1);
9251 __builtin_unreachable ();
9252 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
9253 __builtin_unreachable ();
9254 }
9255
9256
9257 /*
9258 getExprType - return the expression type.
9259 */
9260
9261 static decl_node getExprType (decl_node n)
9262 {
9263 decl_node t;
9264
9265 if (((isFuncCall (n)) && ((decl_getType (n)) != NULL)) && (decl_isProcType (decl_skipType (decl_getType (n)))))
9266 {
9267 return decl_getType (decl_skipType (decl_getType (n)));
9268 }
9269 t = decl_getType (n);
9270 if (t == NULL)
9271 {
9272 t = doGetExprType (n);
9273 }
9274 return t;
9275 /* static analysis guarentees a RETURN statement will be used before here. */
9276 __builtin_unreachable ();
9277 }
9278
9279
9280 /*
9281 openOutput -
9282 */
9283
9284 static void openOutput (void)
9285 {
9286 DynamicStrings_String s;
9287
9288 s = mcOptions_getOutputFile ();
9289 if (DynamicStrings_EqualArray (s, (const char *) "-", 1))
9290 {
9291 outputFile = FIO_StdOut;
9292 }
9293 else
9294 {
9295 outputFile = SFIO_OpenToWrite (s);
9296 }
9297 mcStream_setDest (outputFile);
9298 }
9299
9300
9301 /*
9302 closeOutput -
9303 */
9304
9305 static void closeOutput (void)
9306 {
9307 DynamicStrings_String s;
9308
9309 s = mcOptions_getOutputFile ();
9310 outputFile = mcStream_combine ();
9311 if (! (DynamicStrings_EqualArray (s, (const char *) "-", 1)))
9312 {
9313 FIO_Close (outputFile);
9314 }
9315 }
9316
9317
9318 /*
9319 write - outputs a single char, ch.
9320 */
9321
9322 static void write_ (char ch)
9323 {
9324 FIO_WriteChar (outputFile, ch);
9325 FIO_FlushBuffer (outputFile);
9326 }
9327
9328
9329 /*
9330 writeln -
9331 */
9332
9333 static void writeln (void)
9334 {
9335 FIO_WriteLine (outputFile);
9336 FIO_FlushBuffer (outputFile);
9337 }
9338
9339
9340 /*
9341 doIncludeC - include header file for definition module, n.
9342 */
9343
9344 static void doIncludeC (decl_node n)
9345 {
9346 DynamicStrings_String s;
9347
9348 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
9349 if (mcOptions_getExtendedOpaque ())
9350 {} /* empty. */
9351 /* no include in this case. */
9352 else if (decl_isDef (n))
9353 {
9354 /* avoid dangling else. */
9355 mcPretty_print (doP, (const char *) "# include \"", 13);
9356 mcPretty_prints (doP, mcOptions_getHPrefix ());
9357 mcPretty_prints (doP, s);
9358 mcPretty_print (doP, (const char *) ".h\"\\n", 5);
9359 symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDoneDef});
9360 }
9361 s = DynamicStrings_KillString (s);
9362 }
9363
9364
9365 /*
9366 getSymScope - returns the scope where node, n, was declared.
9367 */
9368
9369 static decl_node getSymScope (decl_node n)
9370 {
9371 switch (n->kind)
9372 {
9373 case decl_const:
9374 return n->constF.scope;
9375 break;
9376
9377 case decl_type:
9378 return n->typeF.scope;
9379 break;
9380
9381 case decl_var:
9382 return n->varF.scope;
9383 break;
9384
9385 case decl_procedure:
9386 return n->procedureF.scope;
9387 break;
9388
9389
9390 default:
9391 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
9392 __builtin_unreachable ();
9393 }
9394 M2RTS_HALT (-1);
9395 __builtin_unreachable ();
9396 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
9397 __builtin_unreachable ();
9398 }
9399
9400
9401 /*
9402 isQualifiedForced - should the node be written with a module prefix?
9403 */
9404
9405 static bool isQualifiedForced (decl_node n)
9406 {
9407 return forceQualified && (((((decl_isType (n)) || (decl_isRecord (n))) || (decl_isArray (n))) || (decl_isEnumeration (n))) || (decl_isEnumerationField (n)));
9408 /* static analysis guarentees a RETURN statement will be used before here. */
9409 __builtin_unreachable ();
9410 }
9411
9412
9413 /*
9414 getFQstring -
9415 */
9416
9417 static DynamicStrings_String getFQstring (decl_node n)
9418 {
9419 DynamicStrings_String i;
9420 DynamicStrings_String s;
9421
9422 if ((decl_getScope (n)) == NULL)
9423 {
9424 return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
9425 }
9426 else if (isQualifiedForced (n))
9427 {
9428 /* avoid dangling else. */
9429 i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
9430 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n))));
9431 return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1));
9432 }
9433 else if ((! (decl_isExported (n))) || (mcOptions_getIgnoreFQ ()))
9434 {
9435 /* avoid dangling else. */
9436 return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
9437 }
9438 else
9439 {
9440 /* avoid dangling else. */
9441 i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
9442 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n))));
9443 return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1));
9444 }
9445 /* static analysis guarentees a RETURN statement will be used before here. */
9446 __builtin_unreachable ();
9447 }
9448
9449
9450 /*
9451 getFQDstring -
9452 */
9453
9454 static DynamicStrings_String getFQDstring (decl_node n, bool scopes)
9455 {
9456 DynamicStrings_String i;
9457 DynamicStrings_String s;
9458
9459 if ((decl_getScope (n)) == NULL)
9460 {
9461 return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (getDName (n, scopes)));
9462 }
9463 else if (isQualifiedForced (n))
9464 {
9465 /* avoid dangling else. */
9466 /* we assume a qualified name will never conflict. */
9467 i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
9468 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n))));
9469 return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1));
9470 }
9471 else if ((! (decl_isExported (n))) || (mcOptions_getIgnoreFQ ()))
9472 {
9473 /* avoid dangling else. */
9474 return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (getDName (n, scopes)));
9475 }
9476 else
9477 {
9478 /* avoid dangling else. */
9479 /* we assume a qualified name will never conflict. */
9480 i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
9481 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n))));
9482 return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1));
9483 }
9484 /* static analysis guarentees a RETURN statement will be used before here. */
9485 __builtin_unreachable ();
9486 }
9487
9488
9489 /*
9490 getString - returns the name as a string.
9491 */
9492
9493 static DynamicStrings_String getString (decl_node n)
9494 {
9495 if ((decl_getSymName (n)) == nameKey_NulName)
9496 {
9497 return DynamicStrings_InitString ((const char *) "", 0);
9498 }
9499 else
9500 {
9501 return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
9502 }
9503 /* static analysis guarentees a RETURN statement will be used before here. */
9504 __builtin_unreachable ();
9505 }
9506
9507
9508 /*
9509 doNone - call HALT.
9510 */
9511
9512 static void doNone (decl_node n)
9513 {
9514 M2RTS_HALT (-1);
9515 __builtin_unreachable ();
9516 }
9517
9518
9519 /*
9520 doNothing - does nothing!
9521 */
9522
9523 static void doNothing (decl_node n)
9524 {
9525 }
9526
9527
9528 /*
9529 doConstC -
9530 */
9531
9532 static void doConstC (decl_node n)
9533 {
9534 if (! (alists_isItemInList (doneQ, reinterpret_cast<void *> (n))))
9535 {
9536 mcPretty_print (doP, (const char *) "# define ", 11);
9537 doFQNameC (doP, n);
9538 mcPretty_setNeedSpace (doP);
9539 doExprC (doP, n->constF.value);
9540 mcPretty_print (doP, (const char *) "\\n", 2);
9541 alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (n));
9542 }
9543 }
9544
9545
9546 /*
9547 needsParen - returns TRUE if expression, n, needs to be enclosed in ().
9548 */
9549
9550 static bool needsParen (decl_node n)
9551 {
9552 mcDebug_assert (n != NULL);
9553 switch (n->kind)
9554 {
9555 case decl_nil:
9556 case decl_true:
9557 case decl_false:
9558 return false;
9559 break;
9560
9561 case decl_constexp:
9562 return needsParen (n->unaryF.arg);
9563 break;
9564
9565 case decl_neg:
9566 return needsParen (n->unaryF.arg);
9567 break;
9568
9569 case decl_not:
9570 return needsParen (n->unaryF.arg);
9571 break;
9572
9573 case decl_adr:
9574 case decl_size:
9575 case decl_tsize:
9576 case decl_ord:
9577 case decl_float:
9578 case decl_trunc:
9579 case decl_chr:
9580 case decl_cap:
9581 case decl_high:
9582 return false;
9583 break;
9584
9585 case decl_deref:
9586 return false;
9587 break;
9588
9589 case decl_equal:
9590 case decl_notequal:
9591 case decl_less:
9592 case decl_greater:
9593 case decl_greequal:
9594 case decl_lessequal:
9595 return true;
9596 break;
9597
9598 case decl_componentref:
9599 return false;
9600 break;
9601
9602 case decl_pointerref:
9603 return false;
9604 break;
9605
9606 case decl_cast:
9607 return true;
9608 break;
9609
9610 case decl_val:
9611 return true;
9612 break;
9613
9614 case decl_abs:
9615 return false;
9616 break;
9617
9618 case decl_plus:
9619 case decl_sub:
9620 case decl_div:
9621 case decl_mod:
9622 case decl_mult:
9623 case decl_divide:
9624 case decl_in:
9625 return true;
9626 break;
9627
9628 case decl_literal:
9629 case decl_const:
9630 case decl_enumerationfield:
9631 case decl_string:
9632 return false;
9633 break;
9634
9635 case decl_max:
9636 return true;
9637 break;
9638
9639 case decl_min:
9640 return true;
9641 break;
9642
9643 case decl_var:
9644 return false;
9645 break;
9646
9647 case decl_arrayref:
9648 return false;
9649 break;
9650
9651 case decl_and:
9652 case decl_or:
9653 return true;
9654 break;
9655
9656 case decl_funccall:
9657 return true;
9658 break;
9659
9660 case decl_recordfield:
9661 return false;
9662 break;
9663
9664 case decl_loc:
9665 case decl_byte:
9666 case decl_word:
9667 case decl_type:
9668 case decl_char:
9669 case decl_cardinal:
9670 case decl_longcard:
9671 case decl_shortcard:
9672 case decl_integer:
9673 case decl_longint:
9674 case decl_shortint:
9675 case decl_real:
9676 case decl_longreal:
9677 case decl_shortreal:
9678 case decl_complex:
9679 case decl_longcomplex:
9680 case decl_shortcomplex:
9681 case decl_bitset:
9682 case decl_boolean:
9683 case decl_proc:
9684 return false;
9685 break;
9686
9687 case decl_setvalue:
9688 return false;
9689 break;
9690
9691 case decl_address:
9692 return true;
9693 break;
9694
9695 case decl_procedure:
9696 return false;
9697 break;
9698
9699 case decl_length:
9700 case decl_cmplx:
9701 case decl_re:
9702 case decl_im:
9703 return true;
9704 break;
9705
9706
9707 default:
9708 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
9709 __builtin_unreachable ();
9710 }
9711 return true;
9712 /* static analysis guarentees a RETURN statement will be used before here. */
9713 __builtin_unreachable ();
9714 }
9715
9716
9717 /*
9718 doUnary -
9719 */
9720
9721 static void doUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr, decl_node type, bool l, bool r)
9722 {
9723 char op[_op_high+1];
9724
9725 /* make a local copy of each unbounded array. */
9726 memcpy (op, op_, _op_high+1);
9727
9728 if (l)
9729 {
9730 mcPretty_setNeedSpace (p);
9731 }
9732 mcPretty_print (p, (const char *) op, _op_high);
9733 if (r)
9734 {
9735 mcPretty_setNeedSpace (p);
9736 }
9737 if (needsParen (expr))
9738 {
9739 outText (p, (const char *) "(", 1);
9740 doExprC (p, expr);
9741 outText (p, (const char *) ")", 1);
9742 }
9743 else
9744 {
9745 doExprC (p, expr);
9746 }
9747 }
9748
9749
9750 /*
9751 doSetSub - perform l & (~ r)
9752 */
9753
9754 static void doSetSub (mcPretty_pretty p, decl_node left, decl_node right)
9755 {
9756 if (needsParen (left))
9757 {
9758 outText (p, (const char *) "(", 1);
9759 doExprC (p, left);
9760 outText (p, (const char *) ")", 1);
9761 }
9762 else
9763 {
9764 doExprC (p, left);
9765 }
9766 mcPretty_setNeedSpace (p);
9767 outText (p, (const char *) "&", 1);
9768 mcPretty_setNeedSpace (p);
9769 if (needsParen (right))
9770 {
9771 outText (p, (const char *) "(~(", 3);
9772 doExprC (p, right);
9773 outText (p, (const char *) "))", 2);
9774 }
9775 else
9776 {
9777 outText (p, (const char *) "(~", 2);
9778 doExprC (p, right);
9779 outText (p, (const char *) ")", 1);
9780 }
9781 }
9782
9783
9784 /*
9785 doPolyBinary -
9786 */
9787
9788 static void doPolyBinary (mcPretty_pretty p, decl_nodeT op, decl_node left, decl_node right, bool l, bool r)
9789 {
9790 decl_node lt;
9791 decl_node rt;
9792
9793 lt = decl_skipType (getExprType (left));
9794 rt = decl_skipType (getExprType (right));
9795 if (((lt != NULL) && ((decl_isSet (lt)) || (isBitset (lt)))) || ((rt != NULL) && ((decl_isSet (rt)) || (isBitset (rt)))))
9796 {
9797 switch (op)
9798 {
9799 case decl_plus:
9800 doBinary (p, (const char *) "|", 1, left, right, l, r, false);
9801 break;
9802
9803 case decl_sub:
9804 doSetSub (p, left, right);
9805 break;
9806
9807 case decl_mult:
9808 doBinary (p, (const char *) "&", 1, left, right, l, r, false);
9809 break;
9810
9811 case decl_divide:
9812 doBinary (p, (const char *) "^", 1, left, right, l, r, false);
9813 break;
9814
9815
9816 default:
9817 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
9818 __builtin_unreachable ();
9819 }
9820 }
9821 else
9822 {
9823 switch (op)
9824 {
9825 case decl_plus:
9826 doBinary (p, (const char *) "+", 1, left, right, l, r, false);
9827 break;
9828
9829 case decl_sub:
9830 doBinary (p, (const char *) "-", 1, left, right, l, r, false);
9831 break;
9832
9833 case decl_mult:
9834 doBinary (p, (const char *) "*", 1, left, right, l, r, false);
9835 break;
9836
9837 case decl_divide:
9838 doBinary (p, (const char *) "/", 1, left, right, l, r, false);
9839 break;
9840
9841
9842 default:
9843 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
9844 __builtin_unreachable ();
9845 }
9846 }
9847 }
9848
9849
9850 /*
9851 doBinary -
9852 */
9853
9854 static void doBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, bool l, bool r, bool unpackProc)
9855 {
9856 char op[_op_high+1];
9857
9858 /* make a local copy of each unbounded array. */
9859 memcpy (op, op_, _op_high+1);
9860
9861 if (needsParen (left))
9862 {
9863 outText (p, (const char *) "(", 1);
9864 doExprCup (p, left, unpackProc);
9865 outText (p, (const char *) ")", 1);
9866 }
9867 else
9868 {
9869 doExprCup (p, left, unpackProc);
9870 }
9871 if (l)
9872 {
9873 mcPretty_setNeedSpace (p);
9874 }
9875 outText (p, (const char *) op, _op_high);
9876 if (r)
9877 {
9878 mcPretty_setNeedSpace (p);
9879 }
9880 if (needsParen (right))
9881 {
9882 outText (p, (const char *) "(", 1);
9883 doExprCup (p, right, unpackProc);
9884 outText (p, (const char *) ")", 1);
9885 }
9886 else
9887 {
9888 doExprCup (p, right, unpackProc);
9889 }
9890 }
9891
9892
9893 /*
9894 doPostUnary -
9895 */
9896
9897 static void doPostUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr)
9898 {
9899 char op[_op_high+1];
9900
9901 /* make a local copy of each unbounded array. */
9902 memcpy (op, op_, _op_high+1);
9903
9904 doExprC (p, expr);
9905 outText (p, (const char *) op, _op_high);
9906 }
9907
9908
9909 /*
9910 doDeRefC -
9911 */
9912
9913 static void doDeRefC (mcPretty_pretty p, decl_node expr)
9914 {
9915 outText (p, (const char *) "(*", 2);
9916 doExprC (p, expr);
9917 outText (p, (const char *) ")", 1);
9918 }
9919
9920
9921 /*
9922 doGetLastOp - returns, a, if b is a terminal otherwise walk right.
9923 */
9924
9925 static decl_node doGetLastOp (decl_node a, decl_node b)
9926 {
9927 switch (b->kind)
9928 {
9929 case decl_nil:
9930 return a;
9931 break;
9932
9933 case decl_true:
9934 return a;
9935 break;
9936
9937 case decl_false:
9938 return a;
9939 break;
9940
9941 case decl_constexp:
9942 return doGetLastOp (b, b->unaryF.arg);
9943 break;
9944
9945 case decl_neg:
9946 return doGetLastOp (b, b->unaryF.arg);
9947 break;
9948
9949 case decl_not:
9950 return doGetLastOp (b, b->unaryF.arg);
9951 break;
9952
9953 case decl_adr:
9954 return doGetLastOp (b, b->unaryF.arg);
9955 break;
9956
9957 case decl_size:
9958 return doGetLastOp (b, b->unaryF.arg);
9959 break;
9960
9961 case decl_tsize:
9962 return doGetLastOp (b, b->unaryF.arg);
9963 break;
9964
9965 case decl_ord:
9966 return doGetLastOp (b, b->unaryF.arg);
9967 break;
9968
9969 case decl_float:
9970 case decl_trunc:
9971 return doGetLastOp (b, b->unaryF.arg);
9972 break;
9973
9974 case decl_chr:
9975 return doGetLastOp (b, b->unaryF.arg);
9976 break;
9977
9978 case decl_cap:
9979 return doGetLastOp (b, b->unaryF.arg);
9980 break;
9981
9982 case decl_high:
9983 return doGetLastOp (b, b->unaryF.arg);
9984 break;
9985
9986 case decl_deref:
9987 return doGetLastOp (b, b->unaryF.arg);
9988 break;
9989
9990 case decl_re:
9991 case decl_im:
9992 return doGetLastOp (b, b->unaryF.arg);
9993 break;
9994
9995 case decl_equal:
9996 return doGetLastOp (b, b->binaryF.right);
9997 break;
9998
9999 case decl_notequal:
10000 return doGetLastOp (b, b->binaryF.right);
10001 break;
10002
10003 case decl_less:
10004 return doGetLastOp (b, b->binaryF.right);
10005 break;
10006
10007 case decl_greater:
10008 return doGetLastOp (b, b->binaryF.right);
10009 break;
10010
10011 case decl_greequal:
10012 return doGetLastOp (b, b->binaryF.right);
10013 break;
10014
10015 case decl_lessequal:
10016 return doGetLastOp (b, b->binaryF.right);
10017 break;
10018
10019 case decl_componentref:
10020 return doGetLastOp (b, b->componentrefF.field);
10021 break;
10022
10023 case decl_pointerref:
10024 return doGetLastOp (b, b->pointerrefF.field);
10025 break;
10026
10027 case decl_cast:
10028 return doGetLastOp (b, b->binaryF.right);
10029 break;
10030
10031 case decl_val:
10032 return doGetLastOp (b, b->binaryF.right);
10033 break;
10034
10035 case decl_plus:
10036 return doGetLastOp (b, b->binaryF.right);
10037 break;
10038
10039 case decl_sub:
10040 return doGetLastOp (b, b->binaryF.right);
10041 break;
10042
10043 case decl_div:
10044 return doGetLastOp (b, b->binaryF.right);
10045 break;
10046
10047 case decl_mod:
10048 return doGetLastOp (b, b->binaryF.right);
10049 break;
10050
10051 case decl_mult:
10052 return doGetLastOp (b, b->binaryF.right);
10053 break;
10054
10055 case decl_divide:
10056 return doGetLastOp (b, b->binaryF.right);
10057 break;
10058
10059 case decl_in:
10060 return doGetLastOp (b, b->binaryF.right);
10061 break;
10062
10063 case decl_and:
10064 return doGetLastOp (b, b->binaryF.right);
10065 break;
10066
10067 case decl_or:
10068 return doGetLastOp (b, b->binaryF.right);
10069 break;
10070
10071 case decl_cmplx:
10072 return doGetLastOp (b, b->binaryF.right);
10073 break;
10074
10075 case decl_literal:
10076 return a;
10077 break;
10078
10079 case decl_const:
10080 return a;
10081 break;
10082
10083 case decl_enumerationfield:
10084 return a;
10085 break;
10086
10087 case decl_string:
10088 return a;
10089 break;
10090
10091 case decl_max:
10092 return doGetLastOp (b, b->unaryF.arg);
10093 break;
10094
10095 case decl_min:
10096 return doGetLastOp (b, b->unaryF.arg);
10097 break;
10098
10099 case decl_var:
10100 return a;
10101 break;
10102
10103 case decl_arrayref:
10104 return a;
10105 break;
10106
10107 case decl_funccall:
10108 return a;
10109 break;
10110
10111 case decl_procedure:
10112 return a;
10113 break;
10114
10115 case decl_recordfield:
10116 return a;
10117 break;
10118
10119
10120 default:
10121 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
10122 __builtin_unreachable ();
10123 }
10124 /* static analysis guarentees a RETURN statement will be used before here. */
10125 __builtin_unreachable ();
10126 }
10127
10128
10129 /*
10130 doComponentRefC -
10131 */
10132
10133 static void doComponentRefC (mcPretty_pretty p, decl_node l, decl_node r)
10134 {
10135 doExprC (p, l);
10136 outText (p, (const char *) ".", 1);
10137 doExprC (p, r);
10138 }
10139
10140
10141 /*
10142 doPointerRefC -
10143 */
10144
10145 static void doPointerRefC (mcPretty_pretty p, decl_node l, decl_node r)
10146 {
10147 doExprC (p, l);
10148 outText (p, (const char *) "->", 2);
10149 doExprC (p, r);
10150 }
10151
10152
10153 /*
10154 doPreBinary -
10155 */
10156
10157 static void doPreBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, bool l, bool r)
10158 {
10159 char op[_op_high+1];
10160
10161 /* make a local copy of each unbounded array. */
10162 memcpy (op, op_, _op_high+1);
10163
10164 if (l)
10165 {
10166 mcPretty_setNeedSpace (p);
10167 }
10168 outText (p, (const char *) op, _op_high);
10169 if (r)
10170 {
10171 mcPretty_setNeedSpace (p);
10172 }
10173 outText (p, (const char *) "(", 1);
10174 doExprC (p, left);
10175 outText (p, (const char *) ",", 1);
10176 mcPretty_setNeedSpace (p);
10177 doExprC (p, right);
10178 outText (p, (const char *) ")", 1);
10179 }
10180
10181
10182 /*
10183 doConstExpr -
10184 */
10185
10186 static void doConstExpr (mcPretty_pretty p, decl_node n)
10187 {
10188 doFQNameC (p, n);
10189 }
10190
10191
10192 /*
10193 doEnumerationField -
10194 */
10195
10196 static void doEnumerationField (mcPretty_pretty p, decl_node n)
10197 {
10198 doFQDNameC (p, n, false);
10199 }
10200
10201
10202 /*
10203 isZero - returns TRUE if node, n, is zero.
10204 */
10205
10206 static bool isZero (decl_node n)
10207 {
10208 if (isConstExp (n))
10209 {
10210 return isZero (n->unaryF.arg);
10211 }
10212 return (decl_getSymName (n)) == (nameKey_makeKey ((const char *) "0", 1));
10213 /* static analysis guarentees a RETURN statement will be used before here. */
10214 __builtin_unreachable ();
10215 }
10216
10217
10218 /*
10219 doArrayRef -
10220 */
10221
10222 static void doArrayRef (mcPretty_pretty p, decl_node n)
10223 {
10224 decl_node t;
10225 unsigned int i;
10226 unsigned int c;
10227
10228 mcDebug_assert (n != NULL);
10229 mcDebug_assert (isArrayRef (n));
10230 t = decl_skipType (decl_getType (n->arrayrefF.array));
10231 if (decl_isUnbounded (t))
10232 {
10233 outTextN (p, decl_getSymName (n->arrayrefF.array));
10234 }
10235 else
10236 {
10237 doExprC (p, n->arrayrefF.array);
10238 mcDebug_assert (decl_isArray (t));
10239 outText (p, (const char *) ".array", 6);
10240 }
10241 outText (p, (const char *) "[", 1);
10242 i = 1;
10243 c = expListLen (n->arrayrefF.index);
10244 while (i <= c)
10245 {
10246 doExprC (p, getExpList (n->arrayrefF.index, i));
10247 if (decl_isUnbounded (t))
10248 {
10249 mcDebug_assert (c == 1);
10250 }
10251 else
10252 {
10253 doSubtractC (p, getMin (t->arrayF.subr));
10254 if (i < c)
10255 {
10256 mcDebug_assert (decl_isArray (t));
10257 outText (p, (const char *) "].array[", 8);
10258 t = decl_skipType (decl_getType (t));
10259 }
10260 }
10261 i += 1;
10262 }
10263 outText (p, (const char *) "]", 1);
10264 }
10265
10266
10267 /*
10268 doProcedure -
10269 */
10270
10271 static void doProcedure (mcPretty_pretty p, decl_node n)
10272 {
10273 mcDebug_assert (decl_isProcedure (n));
10274 doFQDNameC (p, n, true);
10275 }
10276
10277
10278 /*
10279 doRecordfield -
10280 */
10281
10282 static void doRecordfield (mcPretty_pretty p, decl_node n)
10283 {
10284 doDNameC (p, n, false);
10285 }
10286
10287
10288 /*
10289 doCastC -
10290 */
10291
10292 static void doCastC (mcPretty_pretty p, decl_node t, decl_node e)
10293 {
10294 decl_node et;
10295
10296 outText (p, (const char *) "(", 1);
10297 doTypeNameC (p, t);
10298 outText (p, (const char *) ")", 1);
10299 mcPretty_setNeedSpace (p);
10300 et = decl_skipType (decl_getType (e));
10301 if (((et != NULL) && (isAProcType (et))) && (isAProcType (decl_skipType (t))))
10302 {
10303 outText (p, (const char *) "{(", 2);
10304 doFQNameC (p, t);
10305 outText (p, (const char *) "_t)", 3);
10306 mcPretty_setNeedSpace (p);
10307 doExprC (p, e);
10308 outText (p, (const char *) ".proc}", 6);
10309 }
10310 else
10311 {
10312 outText (p, (const char *) "(", 1);
10313 doExprC (p, e);
10314 outText (p, (const char *) ")", 1);
10315 }
10316 }
10317
10318
10319 /*
10320 doSetValueC -
10321 */
10322
10323 static void doSetValueC (mcPretty_pretty p, decl_node n)
10324 {
10325 decl_node lo;
10326 unsigned int i;
10327 unsigned int h;
10328
10329 mcDebug_assert (decl_isSetValue (n));
10330 lo = getSetLow (n);
10331 if (n->setvalueF.type != NULL)
10332 {
10333 outText (p, (const char *) "(", 1);
10334 doTypeNameC (p, n->setvalueF.type);
10335 mcPretty_noSpace (p);
10336 outText (p, (const char *) ")", 1);
10337 mcPretty_setNeedSpace (p);
10338 }
10339 if ((Indexing_HighIndice (n->setvalueF.values)) == 0)
10340 {
10341 outText (p, (const char *) "0", 1);
10342 }
10343 else
10344 {
10345 i = Indexing_LowIndice (n->setvalueF.values);
10346 h = Indexing_HighIndice (n->setvalueF.values);
10347 outText (p, (const char *) "(", 1);
10348 while (i <= h)
10349 {
10350 outText (p, (const char *) "(1", 2);
10351 mcPretty_setNeedSpace (p);
10352 outText (p, (const char *) "<<", 2);
10353 mcPretty_setNeedSpace (p);
10354 outText (p, (const char *) "(", 1);
10355 doExprC (p, reinterpret_cast<decl_node> (Indexing_GetIndice (n->setvalueF.values, i)));
10356 doSubtractC (p, lo);
10357 outText (p, (const char *) ")", 1);
10358 outText (p, (const char *) ")", 1);
10359 if (i < h)
10360 {
10361 mcPretty_setNeedSpace (p);
10362 outText (p, (const char *) "|", 1);
10363 mcPretty_setNeedSpace (p);
10364 }
10365 i += 1;
10366 }
10367 outText (p, (const char *) ")", 1);
10368 }
10369 }
10370
10371
10372 /*
10373 getSetLow - returns the low value of the set type from
10374 expression, n.
10375 */
10376
10377 static decl_node getSetLow (decl_node n)
10378 {
10379 decl_node type;
10380
10381 if ((decl_getType (n)) == NULL)
10382 {
10383 return decl_makeLiteralInt (nameKey_makeKey ((const char *) "0", 1));
10384 }
10385 else
10386 {
10387 type = decl_skipType (decl_getType (n));
10388 if (decl_isSet (type))
10389 {
10390 return getMin (decl_skipType (decl_getType (type)));
10391 }
10392 else
10393 {
10394 return decl_makeLiteralInt (nameKey_makeKey ((const char *) "0", 1));
10395 }
10396 }
10397 /* static analysis guarentees a RETURN statement will be used before here. */
10398 __builtin_unreachable ();
10399 }
10400
10401
10402 /*
10403 doInC - performs (((1 << (l)) & (r)) != 0)
10404 */
10405
10406 static void doInC (mcPretty_pretty p, decl_node l, decl_node r)
10407 {
10408 decl_node lo;
10409
10410 lo = getSetLow (r);
10411 outText (p, (const char *) "(((1", 4);
10412 mcPretty_setNeedSpace (p);
10413 outText (p, (const char *) "<<", 2);
10414 mcPretty_setNeedSpace (p);
10415 outText (p, (const char *) "(", 1);
10416 doExprC (p, l);
10417 doSubtractC (p, lo);
10418 outText (p, (const char *) "))", 2);
10419 mcPretty_setNeedSpace (p);
10420 outText (p, (const char *) "&", 1);
10421 mcPretty_setNeedSpace (p);
10422 outText (p, (const char *) "(", 1);
10423 doExprC (p, r);
10424 outText (p, (const char *) "))", 2);
10425 mcPretty_setNeedSpace (p);
10426 outText (p, (const char *) "!=", 2);
10427 mcPretty_setNeedSpace (p);
10428 outText (p, (const char *) "0)", 2);
10429 }
10430
10431
10432 /*
10433 doThrowC -
10434 */
10435
10436 static void doThrowC (mcPretty_pretty p, decl_node n)
10437 {
10438 mcDebug_assert (isIntrinsic (n));
10439 outText (p, (const char *) "throw", 5);
10440 mcPretty_setNeedSpace (p);
10441 outText (p, (const char *) "(", 1);
10442 if ((expListLen (n->intrinsicF.args)) == 1)
10443 {
10444 doExprC (p, getExpList (n->intrinsicF.args, 1));
10445 }
10446 outText (p, (const char *) ")", 1);
10447 }
10448
10449
10450 /*
10451 doUnreachableC -
10452 */
10453
10454 static void doUnreachableC (mcPretty_pretty p, decl_node n)
10455 {
10456 mcDebug_assert (isIntrinsic (n));
10457 outText (p, (const char *) "__builtin_unreachable", 21);
10458 mcPretty_setNeedSpace (p);
10459 outText (p, (const char *) "(", 1);
10460 mcDebug_assert ((expListLen (n->intrinsicF.args)) == 0);
10461 outText (p, (const char *) ")", 1);
10462 }
10463
10464
10465 /*
10466 outNull -
10467 */
10468
10469 static void outNull (mcPretty_pretty p)
10470 {
10471 keyc_useNull ();
10472 outText (p, (const char *) "NULL", 4);
10473 }
10474
10475
10476 /*
10477 outTrue -
10478 */
10479
10480 static void outTrue (mcPretty_pretty p)
10481 {
10482 keyc_useTrue ();
10483 if ((mcOptions_useBool ()) && (lang == decl_ansiCP))
10484 {
10485 outText (p, (const char *) "true", 4);
10486 }
10487 else
10488 {
10489 outText (p, (const char *) "TRUE", 4);
10490 }
10491 }
10492
10493
10494 /*
10495 outFalse -
10496 */
10497
10498 static void outFalse (mcPretty_pretty p)
10499 {
10500 keyc_useFalse ();
10501 if ((mcOptions_useBool ()) && (lang == decl_ansiCP))
10502 {
10503 outText (p, (const char *) "false", 5);
10504 }
10505 else
10506 {
10507 outText (p, (const char *) "FALSE", 5);
10508 }
10509 }
10510
10511
10512 /*
10513 doExprC -
10514 */
10515
10516 static void doExprC (mcPretty_pretty p, decl_node n)
10517 {
10518 decl_node t;
10519
10520 mcDebug_assert (n != NULL);
10521 t = getExprType (n);
10522 switch (n->kind)
10523 {
10524 case decl_nil:
10525 outNull (p);
10526 break;
10527
10528 case decl_true:
10529 outTrue (p);
10530 break;
10531
10532 case decl_false:
10533 outFalse (p);
10534 break;
10535
10536 case decl_constexp:
10537 doUnary (p, (const char *) "", 0, n->unaryF.arg, n->unaryF.resultType, false, false);
10538 break;
10539
10540 case decl_neg:
10541 doUnary (p, (const char *) "-", 1, n->unaryF.arg, n->unaryF.resultType, false, false);
10542 break;
10543
10544 case decl_not:
10545 doUnary (p, (const char *) "!", 1, n->unaryF.arg, n->unaryF.resultType, false, true);
10546 break;
10547
10548 case decl_val:
10549 doValC (p, n);
10550 break;
10551
10552 case decl_adr:
10553 doAdrC (p, n);
10554 break;
10555
10556 case decl_size:
10557 case decl_tsize:
10558 doSizeC (p, n);
10559 break;
10560
10561 case decl_float:
10562 doConvertSC (p, n, mcOptions_getCRealType ());
10563 break;
10564
10565 case decl_trunc:
10566 doConvertC (p, n, (const char *) "int", 3);
10567 break;
10568
10569 case decl_ord:
10570 doConvertC (p, n, (const char *) "unsigned int", 12);
10571 break;
10572
10573 case decl_chr:
10574 doConvertC (p, n, (const char *) "char", 4);
10575 break;
10576
10577 case decl_cap:
10578 doCapC (p, n);
10579 break;
10580
10581 case decl_abs:
10582 doAbsC (p, n);
10583 break;
10584
10585 case decl_high:
10586 doFuncHighC (p, n->unaryF.arg);
10587 break;
10588
10589 case decl_length:
10590 doLengthC (p, n);
10591 break;
10592
10593 case decl_min:
10594 doMinC (p, n);
10595 break;
10596
10597 case decl_max:
10598 doMaxC (p, n);
10599 break;
10600
10601 case decl_throw:
10602 doThrowC (p, n);
10603 break;
10604
10605 case decl_unreachable:
10606 doUnreachableC (p, n);
10607 break;
10608
10609 case decl_re:
10610 doReC (p, n);
10611 break;
10612
10613 case decl_im:
10614 doImC (p, n);
10615 break;
10616
10617 case decl_cmplx:
10618 doCmplx (p, n);
10619 break;
10620
10621 case decl_deref:
10622 doDeRefC (p, n->unaryF.arg);
10623 break;
10624
10625 case decl_equal:
10626 doBinary (p, (const char *) "==", 2, n->binaryF.left, n->binaryF.right, true, true, true);
10627 break;
10628
10629 case decl_notequal:
10630 doBinary (p, (const char *) "!=", 2, n->binaryF.left, n->binaryF.right, true, true, true);
10631 break;
10632
10633 case decl_less:
10634 doBinary (p, (const char *) "<", 1, n->binaryF.left, n->binaryF.right, true, true, false);
10635 break;
10636
10637 case decl_greater:
10638 doBinary (p, (const char *) ">", 1, n->binaryF.left, n->binaryF.right, true, true, false);
10639 break;
10640
10641 case decl_greequal:
10642 doBinary (p, (const char *) ">=", 2, n->binaryF.left, n->binaryF.right, true, true, false);
10643 break;
10644
10645 case decl_lessequal:
10646 doBinary (p, (const char *) "<=", 2, n->binaryF.left, n->binaryF.right, true, true, false);
10647 break;
10648
10649 case decl_componentref:
10650 doComponentRefC (p, n->componentrefF.rec, n->componentrefF.field);
10651 break;
10652
10653 case decl_pointerref:
10654 doPointerRefC (p, n->pointerrefF.ptr, n->pointerrefF.field);
10655 break;
10656
10657 case decl_cast:
10658 doCastC (p, n->binaryF.left, n->binaryF.right);
10659 break;
10660
10661 case decl_plus:
10662 doPolyBinary (p, decl_plus, n->binaryF.left, n->binaryF.right, false, false);
10663 break;
10664
10665 case decl_sub:
10666 doPolyBinary (p, decl_sub, n->binaryF.left, n->binaryF.right, false, false);
10667 break;
10668
10669 case decl_div:
10670 doBinary (p, (const char *) "/", 1, n->binaryF.left, n->binaryF.right, true, true, false);
10671 break;
10672
10673 case decl_mod:
10674 doBinary (p, (const char *) "%", 1, n->binaryF.left, n->binaryF.right, true, true, false);
10675 break;
10676
10677 case decl_mult:
10678 doPolyBinary (p, decl_mult, n->binaryF.left, n->binaryF.right, false, false);
10679 break;
10680
10681 case decl_divide:
10682 doPolyBinary (p, decl_divide, n->binaryF.left, n->binaryF.right, false, false);
10683 break;
10684
10685 case decl_in:
10686 doInC (p, n->binaryF.left, n->binaryF.right);
10687 break;
10688
10689 case decl_and:
10690 doBinary (p, (const char *) "&&", 2, n->binaryF.left, n->binaryF.right, true, true, false);
10691 break;
10692
10693 case decl_or:
10694 doBinary (p, (const char *) "||", 2, n->binaryF.left, n->binaryF.right, true, true, false);
10695 break;
10696
10697 case decl_literal:
10698 doLiteralC (p, n);
10699 break;
10700
10701 case decl_const:
10702 doConstExpr (p, n);
10703 break;
10704
10705 case decl_enumerationfield:
10706 doEnumerationField (p, n);
10707 break;
10708
10709 case decl_string:
10710 doStringC (p, n);
10711 break;
10712
10713 case decl_var:
10714 doVar (p, n);
10715 break;
10716
10717 case decl_arrayref:
10718 doArrayRef (p, n);
10719 break;
10720
10721 case decl_funccall:
10722 doFuncExprC (p, n);
10723 break;
10724
10725 case decl_procedure:
10726 doProcedure (p, n);
10727 break;
10728
10729 case decl_recordfield:
10730 doRecordfield (p, n);
10731 break;
10732
10733 case decl_setvalue:
10734 doSetValueC (p, n);
10735 break;
10736
10737 case decl_char:
10738 case decl_cardinal:
10739 case decl_longcard:
10740 case decl_shortcard:
10741 case decl_integer:
10742 case decl_longint:
10743 case decl_shortint:
10744 case decl_complex:
10745 case decl_longcomplex:
10746 case decl_shortcomplex:
10747 case decl_real:
10748 case decl_longreal:
10749 case decl_shortreal:
10750 case decl_bitset:
10751 case decl_boolean:
10752 case decl_proc:
10753 doBaseC (p, n);
10754 break;
10755
10756 case decl_address:
10757 case decl_loc:
10758 case decl_byte:
10759 case decl_word:
10760 case decl_csizet:
10761 case decl_cssizet:
10762 doSystemC (p, n);
10763 break;
10764
10765 case decl_type:
10766 doTypeNameC (p, n);
10767 break;
10768
10769 case decl_pointer:
10770 doTypeNameC (p, n);
10771 break;
10772
10773
10774 default:
10775 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
10776 __builtin_unreachable ();
10777 }
10778 }
10779
10780
10781 /*
10782 doExprCup -
10783 */
10784
10785 static void doExprCup (mcPretty_pretty p, decl_node n, bool unpackProc)
10786 {
10787 decl_node t;
10788
10789 doExprC (p, n);
10790 if (unpackProc)
10791 {
10792 t = decl_skipType (getExprType (n));
10793 if ((t != NULL) && (isAProcType (t)))
10794 {
10795 outText (p, (const char *) ".proc", 5);
10796 }
10797 }
10798 }
10799
10800
10801 /*
10802 doExprM2 -
10803 */
10804
10805 static void doExprM2 (mcPretty_pretty p, decl_node n)
10806 {
10807 mcDebug_assert (n != NULL);
10808 switch (n->kind)
10809 {
10810 case decl_nil:
10811 outText (p, (const char *) "NIL", 3);
10812 break;
10813
10814 case decl_true:
10815 outText (p, (const char *) "TRUE", 4);
10816 break;
10817
10818 case decl_false:
10819 outText (p, (const char *) "FALSE", 5);
10820 break;
10821
10822 case decl_constexp:
10823 doUnary (p, (const char *) "", 0, n->unaryF.arg, n->unaryF.resultType, false, false);
10824 break;
10825
10826 case decl_neg:
10827 doUnary (p, (const char *) "-", 1, n->unaryF.arg, n->unaryF.resultType, false, false);
10828 break;
10829
10830 case decl_not:
10831 doUnary (p, (const char *) "NOT", 3, n->unaryF.arg, n->unaryF.resultType, true, true);
10832 break;
10833
10834 case decl_adr:
10835 doUnary (p, (const char *) "ADR", 3, n->unaryF.arg, n->unaryF.resultType, true, true);
10836 break;
10837
10838 case decl_size:
10839 doUnary (p, (const char *) "SIZE", 4, n->unaryF.arg, n->unaryF.resultType, true, true);
10840 break;
10841
10842 case decl_tsize:
10843 doUnary (p, (const char *) "TSIZE", 5, n->unaryF.arg, n->unaryF.resultType, true, true);
10844 break;
10845
10846 case decl_float:
10847 doUnary (p, (const char *) "FLOAT", 5, n->unaryF.arg, n->unaryF.resultType, true, true);
10848 break;
10849
10850 case decl_trunc:
10851 doUnary (p, (const char *) "TRUNC", 5, n->unaryF.arg, n->unaryF.resultType, true, true);
10852 break;
10853
10854 case decl_ord:
10855 doUnary (p, (const char *) "ORD", 3, n->unaryF.arg, n->unaryF.resultType, true, true);
10856 break;
10857
10858 case decl_chr:
10859 doUnary (p, (const char *) "CHR", 3, n->unaryF.arg, n->unaryF.resultType, true, true);
10860 break;
10861
10862 case decl_cap:
10863 doUnary (p, (const char *) "CAP", 3, n->unaryF.arg, n->unaryF.resultType, true, true);
10864 break;
10865
10866 case decl_high:
10867 doUnary (p, (const char *) "HIGH", 4, n->unaryF.arg, n->unaryF.resultType, true, true);
10868 break;
10869
10870 case decl_re:
10871 doUnary (p, (const char *) "RE", 2, n->unaryF.arg, n->unaryF.resultType, true, true);
10872 break;
10873
10874 case decl_im:
10875 doUnary (p, (const char *) "IM", 2, n->unaryF.arg, n->unaryF.resultType, true, true);
10876 break;
10877
10878 case decl_deref:
10879 doPostUnary (p, (const char *) "^", 1, n->unaryF.arg);
10880 break;
10881
10882 case decl_equal:
10883 doBinary (p, (const char *) "=", 1, n->binaryF.left, n->binaryF.right, true, true, false);
10884 break;
10885
10886 case decl_notequal:
10887 doBinary (p, (const char *) "#", 1, n->binaryF.left, n->binaryF.right, true, true, false);
10888 break;
10889
10890 case decl_less:
10891 doBinary (p, (const char *) "<", 1, n->binaryF.left, n->binaryF.right, true, true, false);
10892 break;
10893
10894 case decl_greater:
10895 doBinary (p, (const char *) ">", 1, n->binaryF.left, n->binaryF.right, true, true, false);
10896 break;
10897
10898 case decl_greequal:
10899 doBinary (p, (const char *) ">=", 2, n->binaryF.left, n->binaryF.right, true, true, false);
10900 break;
10901
10902 case decl_lessequal:
10903 doBinary (p, (const char *) "<=", 2, n->binaryF.left, n->binaryF.right, true, true, false);
10904 break;
10905
10906 case decl_componentref:
10907 doBinary (p, (const char *) ".", 1, n->componentrefF.rec, n->componentrefF.field, false, false, false);
10908 break;
10909
10910 case decl_pointerref:
10911 doBinary (p, (const char *) "^.", 2, n->pointerrefF.ptr, n->pointerrefF.field, false, false, false);
10912 break;
10913
10914 case decl_cast:
10915 doPreBinary (p, (const char *) "CAST", 4, n->binaryF.left, n->binaryF.right, true, true);
10916 break;
10917
10918 case decl_val:
10919 doPreBinary (p, (const char *) "VAL", 3, n->binaryF.left, n->binaryF.right, true, true);
10920 break;
10921
10922 case decl_cmplx:
10923 doPreBinary (p, (const char *) "CMPLX", 5, n->binaryF.left, n->binaryF.right, true, true);
10924 break;
10925
10926 case decl_plus:
10927 doBinary (p, (const char *) "+", 1, n->binaryF.left, n->binaryF.right, false, false, false);
10928 break;
10929
10930 case decl_sub:
10931 doBinary (p, (const char *) "-", 1, n->binaryF.left, n->binaryF.right, false, false, false);
10932 break;
10933
10934 case decl_div:
10935 doBinary (p, (const char *) "DIV", 3, n->binaryF.left, n->binaryF.right, true, true, false);
10936 break;
10937
10938 case decl_mod:
10939 doBinary (p, (const char *) "MOD", 3, n->binaryF.left, n->binaryF.right, true, true, false);
10940 break;
10941
10942 case decl_mult:
10943 doBinary (p, (const char *) "*", 1, n->binaryF.left, n->binaryF.right, false, false, false);
10944 break;
10945
10946 case decl_divide:
10947 doBinary (p, (const char *) "/", 1, n->binaryF.left, n->binaryF.right, false, false, false);
10948 break;
10949
10950 case decl_literal:
10951 doLiteral (p, n);
10952 break;
10953
10954 case decl_const:
10955 doConstExpr (p, n);
10956 break;
10957
10958 case decl_enumerationfield:
10959 doEnumerationField (p, n);
10960 break;
10961
10962 case decl_string:
10963 doString (p, n);
10964 break;
10965
10966 case decl_max:
10967 doUnary (p, (const char *) "MAX", 3, n->unaryF.arg, n->unaryF.resultType, true, true);
10968 break;
10969
10970 case decl_min:
10971 doUnary (p, (const char *) "MIN", 3, n->unaryF.arg, n->unaryF.resultType, true, true);
10972 break;
10973
10974 case decl_var:
10975 doVar (p, n);
10976 break;
10977
10978
10979 default:
10980 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
10981 __builtin_unreachable ();
10982 }
10983 }
10984
10985
10986 /*
10987 doVar -
10988 */
10989
10990 static void doVar (mcPretty_pretty p, decl_node n)
10991 {
10992 mcDebug_assert (decl_isVar (n));
10993 if (n->varF.isVarParameter)
10994 {
10995 outText (p, (const char *) "(*", 2);
10996 doFQDNameC (p, n, true);
10997 outText (p, (const char *) ")", 1);
10998 }
10999 else
11000 {
11001 doFQDNameC (p, n, true);
11002 }
11003 }
11004
11005
11006 /*
11007 doLiteralC -
11008 */
11009
11010 static void doLiteralC (mcPretty_pretty p, decl_node n)
11011 {
11012 DynamicStrings_String s;
11013
11014 mcDebug_assert (decl_isLiteral (n));
11015 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
11016 if (n->literalF.type == charN)
11017 {
11018 if ((DynamicStrings_char (s, -1)) == 'C')
11019 {
11020 s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
11021 if ((DynamicStrings_char (s, 0)) != '0')
11022 {
11023 s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0", 1), DynamicStrings_Mark (s));
11024 }
11025 }
11026 outText (p, (const char *) "(char)", 6);
11027 mcPretty_setNeedSpace (p);
11028 }
11029 else if ((DynamicStrings_char (s, -1)) == 'H')
11030 {
11031 /* avoid dangling else. */
11032 outText (p, (const char *) "0x", 2);
11033 s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
11034 }
11035 else if ((DynamicStrings_char (s, -1)) == 'B')
11036 {
11037 /* avoid dangling else. */
11038 outText (p, (const char *) "0", 1);
11039 s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
11040 }
11041 outTextS (p, s);
11042 s = DynamicStrings_KillString (s);
11043 }
11044
11045
11046 /*
11047 doLiteral -
11048 */
11049
11050 static void doLiteral (mcPretty_pretty p, decl_node n)
11051 {
11052 DynamicStrings_String s;
11053
11054 mcDebug_assert (decl_isLiteral (n));
11055 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
11056 if (n->literalF.type == charN)
11057 {
11058 if ((DynamicStrings_char (s, -1)) == 'C')
11059 {
11060 s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
11061 if ((DynamicStrings_char (s, 0)) != '0')
11062 {
11063 s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0", 1), DynamicStrings_Mark (s));
11064 }
11065 }
11066 outText (p, (const char *) "(char)", 6);
11067 mcPretty_setNeedSpace (p);
11068 }
11069 outTextS (p, s);
11070 s = DynamicStrings_KillString (s);
11071 }
11072
11073
11074 /*
11075 isString - returns TRUE if node, n, is a string.
11076 */
11077
11078 static bool isString (decl_node n)
11079 {
11080 mcDebug_assert (n != NULL);
11081 return n->kind == decl_string;
11082 /* static analysis guarentees a RETURN statement will be used before here. */
11083 __builtin_unreachable ();
11084 }
11085
11086
11087 /*
11088 doString -
11089 */
11090
11091 static void doString (mcPretty_pretty p, decl_node n)
11092 {
11093 DynamicStrings_String s;
11094
11095 mcDebug_assert (isString (n));
11096 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
11097 outTextS (p, s);
11098 s = DynamicStrings_KillString (s);
11099 /*
11100 IF DynamicStrings.Index (s, '"', 0)=-1
11101 THEN
11102 outText (p, '"') ;
11103 outTextS (p, s) ;
11104 outText (p, '"')
11105 ELSIF DynamicStrings.Index (s, "'", 0)=-1
11106 THEN
11107 outText (p, '"') ;
11108 outTextS (p, s) ;
11109 outText (p, '"')
11110 ELSE
11111 metaError1 ('illegal string {%1k}', n)
11112 END
11113 */
11114 M2RTS_HALT (-1);
11115 __builtin_unreachable ();
11116 }
11117
11118
11119 /*
11120 replaceChar - replace every occurance of, ch, by, a and return modified string, s.
11121 */
11122
11123 static DynamicStrings_String replaceChar (DynamicStrings_String s, char ch, const char *a_, unsigned int _a_high)
11124 {
11125 int i;
11126 char a[_a_high+1];
11127
11128 /* make a local copy of each unbounded array. */
11129 memcpy (a, a_, _a_high+1);
11130
11131 i = 0;
11132 for (;;)
11133 {
11134 i = DynamicStrings_Index (s, ch, static_cast<unsigned int> (i));
11135 if (i == 0)
11136 {
11137 s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) a, _a_high), DynamicStrings_Slice (s, 1, 0));
11138 i = StrLib_StrLen ((const char *) a, _a_high);
11139 }
11140 else if (i > 0)
11141 {
11142 /* avoid dangling else. */
11143 s = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_Slice (s, 0, i), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high))), DynamicStrings_Slice (s, i+1, 0));
11144 i += StrLib_StrLen ((const char *) a, _a_high);
11145 }
11146 else
11147 {
11148 /* avoid dangling else. */
11149 return s;
11150 }
11151 }
11152 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
11153 __builtin_unreachable ();
11154 }
11155
11156
11157 /*
11158 toCstring - translates string, n, into a C string
11159 and returns the new String.
11160 */
11161
11162 static DynamicStrings_String toCstring (nameKey_Name n)
11163 {
11164 DynamicStrings_String s;
11165
11166 s = DynamicStrings_Slice (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)), 1, -1);
11167 return replaceChar (replaceChar (s, '\\', (const char *) "\\\\", 2), '"', (const char *) "\\\"", 2);
11168 /* static analysis guarentees a RETURN statement will be used before here. */
11169 __builtin_unreachable ();
11170 }
11171
11172
11173 /*
11174 toCchar -
11175 */
11176
11177 static DynamicStrings_String toCchar (nameKey_Name n)
11178 {
11179 DynamicStrings_String s;
11180
11181 s = DynamicStrings_Slice (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)), 1, -1);
11182 return replaceChar (replaceChar (s, '\\', (const char *) "\\\\", 2), '\'', (const char *) "\\'", 2);
11183 /* static analysis guarentees a RETURN statement will be used before here. */
11184 __builtin_unreachable ();
11185 }
11186
11187
11188 /*
11189 countChar -
11190 */
11191
11192 static unsigned int countChar (DynamicStrings_String s, char ch)
11193 {
11194 int i;
11195 unsigned int c;
11196
11197 c = 0;
11198 i = 0;
11199 for (;;)
11200 {
11201 i = DynamicStrings_Index (s, ch, static_cast<unsigned int> (i));
11202 if (i >= 0)
11203 {
11204 i += 1;
11205 c += 1;
11206 }
11207 else
11208 {
11209 return c;
11210 }
11211 }
11212 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
11213 __builtin_unreachable ();
11214 }
11215
11216
11217 /*
11218 lenCstring -
11219 */
11220
11221 static unsigned int lenCstring (DynamicStrings_String s)
11222 {
11223 return (DynamicStrings_Length (s))-(countChar (s, '\\'));
11224 /* static analysis guarentees a RETURN statement will be used before here. */
11225 __builtin_unreachable ();
11226 }
11227
11228
11229 /*
11230 outCstring -
11231 */
11232
11233 static void outCstring (mcPretty_pretty p, decl_node s, bool aString)
11234 {
11235 if (aString)
11236 {
11237 outText (p, (const char *) "\"", 1);
11238 outRawS (p, s->stringF.cstring);
11239 outText (p, (const char *) "\"", 1);
11240 }
11241 else
11242 {
11243 outText (p, (const char *) "'", 1);
11244 outRawS (p, s->stringF.cchar);
11245 outText (p, (const char *) "'", 1);
11246 }
11247 }
11248
11249
11250 /*
11251 doStringC -
11252 */
11253
11254 static void doStringC (mcPretty_pretty p, decl_node n)
11255 {
11256 DynamicStrings_String s;
11257
11258 mcDebug_assert (isString (n));
11259 /*
11260 s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
11261 IF DynamicStrings.Length (s)>3
11262 THEN
11263 IF DynamicStrings.Index (s, '"', 0)=-1
11264 THEN
11265 s := DynamicStrings.Slice (s, 1, -1) ;
11266 outText (p, '"') ;
11267 outCstring (p, s) ;
11268 outText (p, '"')
11269 ELSIF DynamicStrings.Index (s, "'", 0)=-1
11270 THEN
11271 s := DynamicStrings.Slice (s, 1, -1) ;
11272 outText (p, '"') ;
11273 outCstring (p, s) ;
11274 outText (p, '"')
11275 ELSE
11276 metaError1 ('illegal string {%1k}', n)
11277 END
11278 ELSIF DynamicStrings.Length (s) = 3
11279 THEN
11280 s := DynamicStrings.Slice (s, 1, -1) ;
11281 outText (p, "'") ;
11282 IF DynamicStrings.char (s, 0) = "'"
11283 THEN
11284 outText (p, "\'")
11285 ELSIF DynamicStrings.char (s, 0) = "\"
11286 THEN
11287 outText (p, "\\")
11288 ELSE
11289 outTextS (p, s)
11290 END ;
11291 outText (p, "'")
11292 ELSE
11293 outText (p, "'\0'")
11294 END ;
11295 s := KillString (s)
11296 */
11297 outCstring (p, n, ! n->stringF.isCharCompatible);
11298 }
11299
11300
11301 /*
11302 isPunct -
11303 */
11304
11305 static bool isPunct (char ch)
11306 {
11307 return (((((((((ch == '.') || (ch == '(')) || (ch == ')')) || (ch == '^')) || (ch == ':')) || (ch == ';')) || (ch == '{')) || (ch == '}')) || (ch == ',')) || (ch == '*');
11308 /* static analysis guarentees a RETURN statement will be used before here. */
11309 __builtin_unreachable ();
11310 }
11311
11312
11313 /*
11314 isWhite -
11315 */
11316
11317 static bool isWhite (char ch)
11318 {
11319 return ((ch == ' ') || (ch == ASCII_tab)) || (ch == ASCII_lf);
11320 /* static analysis guarentees a RETURN statement will be used before here. */
11321 __builtin_unreachable ();
11322 }
11323
11324
11325 /*
11326 outText -
11327 */
11328
11329 static void outText (mcPretty_pretty p, const char *a_, unsigned int _a_high)
11330 {
11331 DynamicStrings_String s;
11332 char a[_a_high+1];
11333
11334 /* make a local copy of each unbounded array. */
11335 memcpy (a, a_, _a_high+1);
11336
11337 s = DynamicStrings_InitString ((const char *) a, _a_high);
11338 outTextS (p, s);
11339 s = DynamicStrings_KillString (s);
11340 }
11341
11342
11343 /*
11344 outRawS -
11345 */
11346
11347 static void outRawS (mcPretty_pretty p, DynamicStrings_String s)
11348 {
11349 mcPretty_raw (p, s);
11350 }
11351
11352
11353 /*
11354 outKm2 -
11355 */
11356
11357 static mcPretty_pretty outKm2 (mcPretty_pretty p, const char *a_, unsigned int _a_high)
11358 {
11359 unsigned int i;
11360 DynamicStrings_String s;
11361 char a[_a_high+1];
11362
11363 /* make a local copy of each unbounded array. */
11364 memcpy (a, a_, _a_high+1);
11365
11366 if (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "RECORD", 6))
11367 {
11368 p = mcPretty_pushPretty (p);
11369 i = mcPretty_getcurpos (p);
11370 mcPretty_setindent (p, i);
11371 outText (p, (const char *) a, _a_high);
11372 p = mcPretty_pushPretty (p);
11373 mcPretty_setindent (p, i+indentation);
11374 }
11375 else if (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "END", 3))
11376 {
11377 /* avoid dangling else. */
11378 p = mcPretty_popPretty (p);
11379 outText (p, (const char *) a, _a_high);
11380 p = mcPretty_popPretty (p);
11381 }
11382 return p;
11383 /* static analysis guarentees a RETURN statement will be used before here. */
11384 __builtin_unreachable ();
11385 }
11386
11387
11388 /*
11389 outKc -
11390 */
11391
11392 static mcPretty_pretty outKc (mcPretty_pretty p, const char *a_, unsigned int _a_high)
11393 {
11394 int i;
11395 unsigned int c;
11396 DynamicStrings_String s;
11397 DynamicStrings_String t;
11398 char a[_a_high+1];
11399
11400 /* make a local copy of each unbounded array. */
11401 memcpy (a, a_, _a_high+1);
11402
11403 s = DynamicStrings_InitString ((const char *) a, _a_high);
11404 i = DynamicStrings_Index (s, '\\', 0);
11405 if (i == -1)
11406 {
11407 t = NULL;
11408 }
11409 else
11410 {
11411 t = DynamicStrings_Slice (s, i, 0);
11412 s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i);
11413 }
11414 if ((DynamicStrings_char (s, 0)) == '{')
11415 {
11416 p = mcPretty_pushPretty (p);
11417 c = mcPretty_getcurpos (p);
11418 mcPretty_setindent (p, c);
11419 outTextS (p, s);
11420 p = mcPretty_pushPretty (p);
11421 mcPretty_setindent (p, c+indentationC);
11422 }
11423 else if ((DynamicStrings_char (s, 0)) == '}')
11424 {
11425 /* avoid dangling else. */
11426 p = mcPretty_popPretty (p);
11427 outTextS (p, s);
11428 p = mcPretty_popPretty (p);
11429 }
11430 outTextS (p, t);
11431 t = DynamicStrings_KillString (t);
11432 s = DynamicStrings_KillString (s);
11433 return p;
11434 /* static analysis guarentees a RETURN statement will be used before here. */
11435 __builtin_unreachable ();
11436 }
11437
11438
11439 /*
11440 outTextS -
11441 */
11442
11443 static void outTextS (mcPretty_pretty p, DynamicStrings_String s)
11444 {
11445 if (s != NULL)
11446 {
11447 mcPretty_prints (p, s);
11448 }
11449 }
11450
11451
11452 /*
11453 outCard -
11454 */
11455
11456 static void outCard (mcPretty_pretty p, unsigned int c)
11457 {
11458 DynamicStrings_String s;
11459
11460 s = StringConvert_CardinalToString (c, 0, ' ', 10, false);
11461 outTextS (p, s);
11462 s = DynamicStrings_KillString (s);
11463 }
11464
11465
11466 /*
11467 outTextN -
11468 */
11469
11470 static void outTextN (mcPretty_pretty p, nameKey_Name n)
11471 {
11472 DynamicStrings_String s;
11473
11474 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
11475 mcPretty_prints (p, s);
11476 s = DynamicStrings_KillString (s);
11477 }
11478
11479
11480 /*
11481 doTypeAliasC -
11482 */
11483
11484 static void doTypeAliasC (mcPretty_pretty p, decl_node n, decl_node *m)
11485 {
11486 mcPretty_print (p, (const char *) "typedef", 7);
11487 mcPretty_setNeedSpace (p);
11488 if ((decl_isTypeHidden (n)) && ((decl_isDef (decl_getMainModule ())) || ((decl_getScope (n)) != (decl_getMainModule ()))))
11489 {
11490 outText (p, (const char *) "void *", 6);
11491 }
11492 else
11493 {
11494 doTypeC (p, decl_getType (n), m);
11495 }
11496 if ((*m) != NULL)
11497 {
11498 doFQNameC (p, (*m));
11499 }
11500 mcPretty_print (p, (const char *) ";\\n\\n", 5);
11501 }
11502
11503
11504 /*
11505 doEnumerationC -
11506 */
11507
11508 static void doEnumerationC (mcPretty_pretty p, decl_node n)
11509 {
11510 unsigned int i;
11511 unsigned int h;
11512 decl_node s;
11513 DynamicStrings_String t;
11514
11515 outText (p, (const char *) "enum {", 6);
11516 i = Indexing_LowIndice (n->enumerationF.listOfSons);
11517 h = Indexing_HighIndice (n->enumerationF.listOfSons);
11518 while (i <= h)
11519 {
11520 s = static_cast<decl_node> (Indexing_GetIndice (n->enumerationF.listOfSons, i));
11521 doFQDNameC (p, s, false);
11522 if (i < h)
11523 {
11524 outText (p, (const char *) ",", 1);
11525 mcPretty_setNeedSpace (p);
11526 }
11527 i += 1;
11528 }
11529 outText (p, (const char *) "}", 1);
11530 }
11531
11532
11533 /*
11534 doNamesC -
11535 */
11536
11537 static void doNamesC (mcPretty_pretty p, nameKey_Name n)
11538 {
11539 DynamicStrings_String s;
11540
11541 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
11542 outTextS (p, s);
11543 s = DynamicStrings_KillString (s);
11544 }
11545
11546
11547 /*
11548 doNameC -
11549 */
11550
11551 static void doNameC (mcPretty_pretty p, decl_node n)
11552 {
11553 if ((n != NULL) && ((decl_getSymName (n)) != nameKey_NulName))
11554 {
11555 doNamesC (p, decl_getSymName (n));
11556 }
11557 }
11558
11559
11560 /*
11561 initCname -
11562 */
11563
11564 static void initCname (decl_cnameT *c)
11565 {
11566 (*c).init = false;
11567 }
11568
11569
11570 /*
11571 doCname -
11572 */
11573
11574 static nameKey_Name doCname (nameKey_Name n, decl_cnameT *c, bool scopes)
11575 {
11576 DynamicStrings_String s;
11577
11578 if ((*c).init)
11579 {
11580 return (*c).name;
11581 }
11582 else
11583 {
11584 (*c).init = true;
11585 s = keyc_cname (n, scopes);
11586 if (s == NULL)
11587 {
11588 (*c).name = n;
11589 }
11590 else
11591 {
11592 (*c).name = nameKey_makekey (DynamicStrings_string (s));
11593 s = DynamicStrings_KillString (s);
11594 }
11595 return (*c).name;
11596 }
11597 /* static analysis guarentees a RETURN statement will be used before here. */
11598 __builtin_unreachable ();
11599 }
11600
11601
11602 /*
11603 getDName -
11604 */
11605
11606 static nameKey_Name getDName (decl_node n, bool scopes)
11607 {
11608 nameKey_Name m;
11609
11610 m = decl_getSymName (n);
11611 switch (n->kind)
11612 {
11613 case decl_procedure:
11614 return doCname (m, &n->procedureF.cname, scopes);
11615 break;
11616
11617 case decl_var:
11618 return doCname (m, &n->varF.cname, scopes);
11619 break;
11620
11621 case decl_recordfield:
11622 return doCname (m, &n->recordfieldF.cname, scopes);
11623 break;
11624
11625 case decl_enumerationfield:
11626 return doCname (m, &n->enumerationfieldF.cname, scopes);
11627 break;
11628
11629
11630 default:
11631 break;
11632 }
11633 return m;
11634 /* static analysis guarentees a RETURN statement will be used before here. */
11635 __builtin_unreachable ();
11636 }
11637
11638
11639 /*
11640 doDNameC -
11641 */
11642
11643 static void doDNameC (mcPretty_pretty p, decl_node n, bool scopes)
11644 {
11645 if ((n != NULL) && ((decl_getSymName (n)) != nameKey_NulName))
11646 {
11647 doNamesC (p, getDName (n, scopes));
11648 }
11649 }
11650
11651
11652 /*
11653 doFQDNameC -
11654 */
11655
11656 static void doFQDNameC (mcPretty_pretty p, decl_node n, bool scopes)
11657 {
11658 DynamicStrings_String s;
11659
11660 s = getFQDstring (n, scopes);
11661 outTextS (p, s);
11662 s = DynamicStrings_KillString (s);
11663 }
11664
11665
11666 /*
11667 doFQNameC -
11668 */
11669
11670 static void doFQNameC (mcPretty_pretty p, decl_node n)
11671 {
11672 DynamicStrings_String s;
11673
11674 s = getFQstring (n);
11675 outTextS (p, s);
11676 s = DynamicStrings_KillString (s);
11677 }
11678
11679
11680 /*
11681 doNameM2 -
11682 */
11683
11684 static void doNameM2 (mcPretty_pretty p, decl_node n)
11685 {
11686 doNameC (p, n);
11687 }
11688
11689
11690 /*
11691 doUsed -
11692 */
11693
11694 static void doUsed (mcPretty_pretty p, bool used)
11695 {
11696 if (! used)
11697 {
11698 mcPretty_setNeedSpace (p);
11699 outText (p, (const char *) "__attribute__((unused))", 23);
11700 }
11701 }
11702
11703
11704 /*
11705 doHighC -
11706 */
11707
11708 static void doHighC (mcPretty_pretty p, decl_node a, nameKey_Name n, bool isused)
11709 {
11710 if ((decl_isArray (a)) && (decl_isUnbounded (a)))
11711 {
11712 /* need to display high. */
11713 mcPretty_print (p, (const char *) ",", 1);
11714 mcPretty_setNeedSpace (p);
11715 doTypeNameC (p, cardinalN);
11716 mcPretty_setNeedSpace (p);
11717 mcPretty_print (p, (const char *) "_", 1);
11718 outTextN (p, n);
11719 mcPretty_print (p, (const char *) "_high", 5);
11720 doUsed (p, isused);
11721 }
11722 }
11723
11724
11725 /*
11726 doParamConstCast -
11727 */
11728
11729 static void doParamConstCast (mcPretty_pretty p, decl_node n)
11730 {
11731 decl_node ptype;
11732
11733 ptype = decl_getType (n);
11734 if (((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) && (lang == decl_ansiCP))
11735 {
11736 outText (p, (const char *) "const", 5);
11737 mcPretty_setNeedSpace (p);
11738 }
11739 }
11740
11741
11742 /*
11743 getParameterVariable - returns the variable which shadows the parameter
11744 named, m, in parameter block, n.
11745 */
11746
11747 static decl_node getParameterVariable (decl_node n, nameKey_Name m)
11748 {
11749 decl_node p;
11750
11751 mcDebug_assert ((decl_isParam (n)) || (decl_isVarParam (n)));
11752 if (decl_isParam (n))
11753 {
11754 p = n->paramF.scope;
11755 }
11756 else
11757 {
11758 p = n->varparamF.scope;
11759 }
11760 mcDebug_assert (decl_isProcedure (p));
11761 return decl_lookupInScope (p, m);
11762 /* static analysis guarentees a RETURN statement will be used before here. */
11763 __builtin_unreachable ();
11764 }
11765
11766
11767 /*
11768 doParamTypeEmit - emit parameter type for C/C++. It checks to see if the
11769 parameter type is a procedure type and if it were declared
11770 in a definition module for "C" and if so it uses the "C"
11771 definition for a procedure type, rather than the mc
11772 C++ version.
11773 */
11774
11775 static void doParamTypeEmit (mcPretty_pretty p, decl_node paramnode, decl_node paramtype)
11776 {
11777 mcDebug_assert ((decl_isParam (paramnode)) || (decl_isVarParam (paramnode)));
11778 if ((isForC (paramnode)) && (decl_isProcType (decl_skipType (paramtype))))
11779 {
11780 doFQNameC (p, paramtype);
11781 outText (p, (const char *) "_C", 2);
11782 }
11783 else
11784 {
11785 doTypeNameC (p, paramtype);
11786 }
11787 }
11788
11789
11790 /*
11791 doParamC - emit parameter for C/C++.
11792 */
11793
11794 static void doParamC (mcPretty_pretty p, decl_node n)
11795 {
11796 decl_node v;
11797 decl_node ptype;
11798 nameKey_Name i;
11799 unsigned int c;
11800 unsigned int t;
11801 wlists_wlist l;
11802
11803 mcDebug_assert (decl_isParam (n));
11804 ptype = decl_getType (n);
11805 if (n->paramF.namelist == NULL)
11806 {
11807 /* avoid dangling else. */
11808 doParamConstCast (p, n);
11809 doTypeNameC (p, ptype);
11810 doUsed (p, n->paramF.isUsed);
11811 if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
11812 {
11813 outText (p, (const char *) ",", 1);
11814 mcPretty_setNeedSpace (p);
11815 outText (p, (const char *) "unsigned int", 12);
11816 }
11817 }
11818 else
11819 {
11820 mcDebug_assert (isIdentList (n->paramF.namelist));
11821 l = n->paramF.namelist->identlistF.names;
11822 if (l == NULL)
11823 {
11824 /* avoid dangling else. */
11825 doParamConstCast (p, n);
11826 doParamTypeEmit (p, n, ptype);
11827 if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
11828 {
11829 doUsed (p, n->paramF.isUsed);
11830 outText (p, (const char *) ",", 1);
11831 mcPretty_setNeedSpace (p);
11832 outText (p, (const char *) "unsigned int", 12);
11833 }
11834 }
11835 else
11836 {
11837 t = wlists_noOfItemsInList (l);
11838 c = 1;
11839 while (c <= t)
11840 {
11841 doParamConstCast (p, n);
11842 doParamTypeEmit (p, n, ptype);
11843 i = static_cast<nameKey_Name> (wlists_getItemFromList (l, c));
11844 if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
11845 {
11846 mcPretty_noSpace (p);
11847 }
11848 else
11849 {
11850 mcPretty_setNeedSpace (p);
11851 }
11852 v = getParameterVariable (n, i);
11853 if (v == NULL)
11854 {
11855 doNamesC (p, keyc_cnamen (i, true));
11856 }
11857 else
11858 {
11859 doFQDNameC (p, v, true);
11860 }
11861 if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
11862 {
11863 outText (p, (const char *) "_", 1);
11864 }
11865 doUsed (p, n->paramF.isUsed);
11866 doHighC (p, ptype, i, n->paramF.isUsed);
11867 if (c < t)
11868 {
11869 outText (p, (const char *) ",", 1);
11870 mcPretty_setNeedSpace (p);
11871 }
11872 c += 1;
11873 }
11874 }
11875 }
11876 }
11877
11878
11879 /*
11880 doVarParamC - emit a VAR parameter for C/C++.
11881 */
11882
11883 static void doVarParamC (mcPretty_pretty p, decl_node n)
11884 {
11885 decl_node v;
11886 decl_node ptype;
11887 nameKey_Name i;
11888 unsigned int c;
11889 unsigned int t;
11890 wlists_wlist l;
11891
11892 mcDebug_assert (decl_isVarParam (n));
11893 ptype = decl_getType (n);
11894 if (n->varparamF.namelist == NULL)
11895 {
11896 /* avoid dangling else. */
11897 doTypeNameC (p, ptype);
11898 /* doTypeC (p, ptype, n) ; */
11899 if (! (decl_isArray (ptype)))
11900 {
11901 mcPretty_setNeedSpace (p);
11902 outText (p, (const char *) "*", 1);
11903 }
11904 doUsed (p, n->varparamF.isUsed);
11905 if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
11906 {
11907 outText (p, (const char *) ",", 1);
11908 mcPretty_setNeedSpace (p);
11909 outText (p, (const char *) "unsigned int", 12);
11910 }
11911 }
11912 else
11913 {
11914 mcDebug_assert (isIdentList (n->varparamF.namelist));
11915 l = n->varparamF.namelist->identlistF.names;
11916 if (l == NULL)
11917 {
11918 doParamTypeEmit (p, n, ptype);
11919 doUsed (p, n->varparamF.isUsed);
11920 }
11921 else
11922 {
11923 t = wlists_noOfItemsInList (l);
11924 c = 1;
11925 while (c <= t)
11926 {
11927 doParamTypeEmit (p, n, ptype);
11928 if (! (decl_isArray (ptype)))
11929 {
11930 mcPretty_setNeedSpace (p);
11931 outText (p, (const char *) "*", 1);
11932 }
11933 i = static_cast<nameKey_Name> (wlists_getItemFromList (l, c));
11934 v = getParameterVariable (n, i);
11935 if (v == NULL)
11936 {
11937 doNamesC (p, keyc_cnamen (i, true));
11938 }
11939 else
11940 {
11941 doFQDNameC (p, v, true);
11942 }
11943 doUsed (p, n->varparamF.isUsed);
11944 doHighC (p, ptype, i, n->varparamF.isUsed);
11945 if (c < t)
11946 {
11947 outText (p, (const char *) ",", 1);
11948 mcPretty_setNeedSpace (p);
11949 }
11950 c += 1;
11951 }
11952 }
11953 }
11954 }
11955
11956
11957 /*
11958 doOptargC -
11959 */
11960
11961 static void doOptargC (mcPretty_pretty p, decl_node n)
11962 {
11963 decl_node ptype;
11964 nameKey_Name i;
11965 unsigned int t;
11966 wlists_wlist l;
11967
11968 mcDebug_assert (decl_isOptarg (n));
11969 ptype = decl_getType (n);
11970 mcDebug_assert (n->optargF.namelist != NULL);
11971 mcDebug_assert (isIdentList (n->paramF.namelist));
11972 l = n->paramF.namelist->identlistF.names;
11973 mcDebug_assert (l != NULL);
11974 t = wlists_noOfItemsInList (l);
11975 mcDebug_assert (t == 1);
11976 doTypeNameC (p, ptype);
11977 i = static_cast<nameKey_Name> (wlists_getItemFromList (l, 1));
11978 mcPretty_setNeedSpace (p);
11979 doNamesC (p, i);
11980 }
11981
11982
11983 /*
11984 doParameterC -
11985 */
11986
11987 static void doParameterC (mcPretty_pretty p, decl_node n)
11988 {
11989 if (decl_isParam (n))
11990 {
11991 doParamC (p, n);
11992 }
11993 else if (decl_isVarParam (n))
11994 {
11995 /* avoid dangling else. */
11996 doVarParamC (p, n);
11997 }
11998 else if (decl_isVarargs (n))
11999 {
12000 /* avoid dangling else. */
12001 mcPretty_print (p, (const char *) "...", 3);
12002 }
12003 else if (decl_isOptarg (n))
12004 {
12005 /* avoid dangling else. */
12006 doOptargC (p, n);
12007 }
12008 }
12009
12010
12011 /*
12012 doProcTypeC -
12013 */
12014
12015 static void doProcTypeC (mcPretty_pretty p, decl_node t, decl_node n)
12016 {
12017 mcDebug_assert (decl_isType (t));
12018 outputPartial (t);
12019 doCompletePartialProcType (p, t, n);
12020 }
12021
12022
12023 /*
12024 doTypesC -
12025 */
12026
12027 static void doTypesC (decl_node n)
12028 {
12029 decl_node m;
12030
12031 if (decl_isType (n))
12032 {
12033 m = decl_getType (n);
12034 if (decl_isProcType (m))
12035 {
12036 doProcTypeC (doP, n, m);
12037 }
12038 else if ((decl_isType (m)) || (decl_isPointer (m)))
12039 {
12040 /* avoid dangling else. */
12041 outText (doP, (const char *) "typedef", 7);
12042 mcPretty_setNeedSpace (doP);
12043 doTypeC (doP, m, &m);
12044 if (decl_isType (m))
12045 {
12046 mcPretty_setNeedSpace (doP);
12047 }
12048 doTypeNameC (doP, n);
12049 outText (doP, (const char *) ";\\n\\n", 5);
12050 }
12051 else if (decl_isEnumeration (m))
12052 {
12053 /* avoid dangling else. */
12054 outText (doP, (const char *) "typedef", 7);
12055 mcPretty_setNeedSpace (doP);
12056 doTypeC (doP, m, &m);
12057 mcPretty_setNeedSpace (doP);
12058 doTypeNameC (doP, n);
12059 outText (doP, (const char *) ";\\n\\n", 5);
12060 }
12061 else
12062 {
12063 /* avoid dangling else. */
12064 outText (doP, (const char *) "typedef", 7);
12065 mcPretty_setNeedSpace (doP);
12066 doTypeC (doP, m, &m);
12067 if (decl_isType (m))
12068 {
12069 mcPretty_setNeedSpace (doP);
12070 }
12071 doTypeNameC (doP, n);
12072 outText (doP, (const char *) ";\\n\\n", 5);
12073 }
12074 }
12075 }
12076
12077
12078 /*
12079 doCompletePartialC -
12080 */
12081
12082 static void doCompletePartialC (decl_node n)
12083 {
12084 decl_node m;
12085
12086 if (decl_isType (n))
12087 {
12088 m = decl_getType (n);
12089 if (decl_isRecord (m))
12090 {
12091 doCompletePartialRecord (doP, n, m);
12092 }
12093 else if (decl_isArray (m))
12094 {
12095 /* avoid dangling else. */
12096 doCompletePartialArray (doP, n, m);
12097 }
12098 else if (decl_isProcType (m))
12099 {
12100 /* avoid dangling else. */
12101 doCompletePartialProcType (doP, n, m);
12102 }
12103 }
12104 }
12105
12106
12107 /*
12108 doCompletePartialRecord -
12109 */
12110
12111 static void doCompletePartialRecord (mcPretty_pretty p, decl_node t, decl_node r)
12112 {
12113 unsigned int i;
12114 unsigned int h;
12115 decl_node f;
12116
12117 mcDebug_assert (decl_isRecord (r));
12118 mcDebug_assert (decl_isType (t));
12119 outText (p, (const char *) "struct", 6);
12120 mcPretty_setNeedSpace (p);
12121 doFQNameC (p, t);
12122 outText (p, (const char *) "_r", 2);
12123 mcPretty_setNeedSpace (p);
12124 p = outKc (p, (const char *) "{\\n", 3);
12125 i = Indexing_LowIndice (r->recordF.listOfSons);
12126 h = Indexing_HighIndice (r->recordF.listOfSons);
12127 while (i <= h)
12128 {
12129 f = static_cast<decl_node> (Indexing_GetIndice (r->recordF.listOfSons, i));
12130 if (decl_isRecordField (f))
12131 {
12132 /* avoid dangling else. */
12133 if (! f->recordfieldF.tag)
12134 {
12135 mcPretty_setNeedSpace (p);
12136 doRecordFieldC (p, f);
12137 outText (p, (const char *) ";\\n", 3);
12138 }
12139 }
12140 else if (decl_isVarient (f))
12141 {
12142 /* avoid dangling else. */
12143 doVarientC (p, f);
12144 outText (p, (const char *) ";\\n", 3);
12145 }
12146 else if (decl_isVarientField (f))
12147 {
12148 /* avoid dangling else. */
12149 doVarientFieldC (p, f);
12150 }
12151 i += 1;
12152 }
12153 p = outKc (p, (const char *) "};\\n\\n", 6);
12154 }
12155
12156
12157 /*
12158 doCompletePartialArray -
12159 */
12160
12161 static void doCompletePartialArray (mcPretty_pretty p, decl_node t, decl_node r)
12162 {
12163 decl_node type;
12164 decl_node s;
12165
12166 mcDebug_assert (decl_isArray (r));
12167 type = r->arrayF.type;
12168 s = NULL;
12169 outText (p, (const char *) "struct", 6);
12170 mcPretty_setNeedSpace (p);
12171 doFQNameC (p, t);
12172 outText (p, (const char *) "_a {", 4);
12173 mcPretty_setNeedSpace (p);
12174 doTypeC (p, type, &s);
12175 mcPretty_setNeedSpace (p);
12176 outText (p, (const char *) "array[", 6);
12177 doSubrC (p, r->arrayF.subr);
12178 outText (p, (const char *) "];", 2);
12179 mcPretty_setNeedSpace (p);
12180 outText (p, (const char *) "};\\n", 4);
12181 }
12182
12183
12184 /*
12185 lookupConst -
12186 */
12187
12188 static decl_node lookupConst (decl_node type, nameKey_Name n)
12189 {
12190 return decl_makeLiteralInt (n);
12191 /* static analysis guarentees a RETURN statement will be used before here. */
12192 __builtin_unreachable ();
12193 }
12194
12195
12196 /*
12197 doMin -
12198 */
12199
12200 static decl_node doMin (decl_node n)
12201 {
12202 if (n == booleanN)
12203 {
12204 return falseN;
12205 }
12206 else if (n == integerN)
12207 {
12208 /* avoid dangling else. */
12209 keyc_useIntMin ();
12210 return lookupConst (integerN, nameKey_makeKey ((const char *) "INT_MIN", 7));
12211 }
12212 else if (n == cardinalN)
12213 {
12214 /* avoid dangling else. */
12215 keyc_useUIntMin ();
12216 return lookupConst (cardinalN, nameKey_makeKey ((const char *) "UINT_MIN", 8));
12217 }
12218 else if (n == longintN)
12219 {
12220 /* avoid dangling else. */
12221 keyc_useLongMin ();
12222 return lookupConst (longintN, nameKey_makeKey ((const char *) "LONG_MIN", 8));
12223 }
12224 else if (n == longcardN)
12225 {
12226 /* avoid dangling else. */
12227 keyc_useULongMin ();
12228 return lookupConst (longcardN, nameKey_makeKey ((const char *) "LONG_MIN", 8));
12229 }
12230 else if (n == charN)
12231 {
12232 /* avoid dangling else. */
12233 keyc_useCharMin ();
12234 return lookupConst (charN, nameKey_makeKey ((const char *) "CHAR_MIN", 8));
12235 }
12236 else if (n == bitsetN)
12237 {
12238 /* avoid dangling else. */
12239 mcDebug_assert (decl_isSubrange (bitnumN));
12240 return bitnumN->subrangeF.low;
12241 }
12242 else if (n == locN)
12243 {
12244 /* avoid dangling else. */
12245 keyc_useUCharMin ();
12246 return lookupConst (locN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9));
12247 }
12248 else if (n == byteN)
12249 {
12250 /* avoid dangling else. */
12251 keyc_useUCharMin ();
12252 return lookupConst (byteN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9));
12253 }
12254 else if (n == wordN)
12255 {
12256 /* avoid dangling else. */
12257 keyc_useUIntMin ();
12258 return lookupConst (wordN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9));
12259 }
12260 else if (n == addressN)
12261 {
12262 /* avoid dangling else. */
12263 return lookupConst (addressN, nameKey_makeKey ((const char *) "((void *) 0)", 12));
12264 }
12265 else
12266 {
12267 /* avoid dangling else. */
12268 M2RTS_HALT (-1); /* finish the cacading elsif statement. */
12269 __builtin_unreachable ();
12270 }
12271 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
12272 __builtin_unreachable ();
12273 }
12274
12275
12276 /*
12277 doMax -
12278 */
12279
12280 static decl_node doMax (decl_node n)
12281 {
12282 if (n == booleanN)
12283 {
12284 return trueN;
12285 }
12286 else if (n == integerN)
12287 {
12288 /* avoid dangling else. */
12289 keyc_useIntMax ();
12290 return lookupConst (integerN, nameKey_makeKey ((const char *) "INT_MAX", 7));
12291 }
12292 else if (n == cardinalN)
12293 {
12294 /* avoid dangling else. */
12295 keyc_useUIntMax ();
12296 return lookupConst (cardinalN, nameKey_makeKey ((const char *) "UINT_MAX", 8));
12297 }
12298 else if (n == longintN)
12299 {
12300 /* avoid dangling else. */
12301 keyc_useLongMax ();
12302 return lookupConst (longintN, nameKey_makeKey ((const char *) "LONG_MAX", 8));
12303 }
12304 else if (n == longcardN)
12305 {
12306 /* avoid dangling else. */
12307 keyc_useULongMax ();
12308 return lookupConst (longcardN, nameKey_makeKey ((const char *) "ULONG_MAX", 9));
12309 }
12310 else if (n == charN)
12311 {
12312 /* avoid dangling else. */
12313 keyc_useCharMax ();
12314 return lookupConst (charN, nameKey_makeKey ((const char *) "CHAR_MAX", 8));
12315 }
12316 else if (n == bitsetN)
12317 {
12318 /* avoid dangling else. */
12319 mcDebug_assert (decl_isSubrange (bitnumN));
12320 return bitnumN->subrangeF.high;
12321 }
12322 else if (n == locN)
12323 {
12324 /* avoid dangling else. */
12325 keyc_useUCharMax ();
12326 return lookupConst (locN, nameKey_makeKey ((const char *) "UCHAR_MAX", 9));
12327 }
12328 else if (n == byteN)
12329 {
12330 /* avoid dangling else. */
12331 keyc_useUCharMax ();
12332 return lookupConst (byteN, nameKey_makeKey ((const char *) "UCHAR_MAX", 9));
12333 }
12334 else if (n == wordN)
12335 {
12336 /* avoid dangling else. */
12337 keyc_useUIntMax ();
12338 return lookupConst (wordN, nameKey_makeKey ((const char *) "UINT_MAX", 8));
12339 }
12340 else if (n == addressN)
12341 {
12342 /* avoid dangling else. */
12343 mcMetaError_metaError1 ((const char *) "trying to obtain MAX ({%1ad}) is illegal", 40, (const unsigned char *) &n, (sizeof (n)-1));
12344 return NULL;
12345 }
12346 else
12347 {
12348 /* avoid dangling else. */
12349 M2RTS_HALT (-1); /* finish the cacading elsif statement. */
12350 __builtin_unreachable ();
12351 }
12352 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
12353 __builtin_unreachable ();
12354 }
12355
12356
12357 /*
12358 getMax -
12359 */
12360
12361 static decl_node getMax (decl_node n)
12362 {
12363 n = decl_skipType (n);
12364 if (decl_isSubrange (n))
12365 {
12366 return n->subrangeF.high;
12367 }
12368 else if (decl_isEnumeration (n))
12369 {
12370 /* avoid dangling else. */
12371 return n->enumerationF.high;
12372 }
12373 else
12374 {
12375 /* avoid dangling else. */
12376 mcDebug_assert (isOrdinal (n));
12377 return doMax (n);
12378 }
12379 /* static analysis guarentees a RETURN statement will be used before here. */
12380 __builtin_unreachable ();
12381 }
12382
12383
12384 /*
12385 getMin -
12386 */
12387
12388 static decl_node getMin (decl_node n)
12389 {
12390 n = decl_skipType (n);
12391 if (decl_isSubrange (n))
12392 {
12393 return n->subrangeF.low;
12394 }
12395 else if (decl_isEnumeration (n))
12396 {
12397 /* avoid dangling else. */
12398 return n->enumerationF.low;
12399 }
12400 else
12401 {
12402 /* avoid dangling else. */
12403 mcDebug_assert (isOrdinal (n));
12404 return doMin (n);
12405 }
12406 /* static analysis guarentees a RETURN statement will be used before here. */
12407 __builtin_unreachable ();
12408 }
12409
12410
12411 /*
12412 doSubtractC -
12413 */
12414
12415 static void doSubtractC (mcPretty_pretty p, decl_node s)
12416 {
12417 if (! (isZero (s)))
12418 {
12419 outText (p, (const char *) "-", 1);
12420 doExprC (p, s);
12421 }
12422 }
12423
12424
12425 /*
12426 doSubrC -
12427 */
12428
12429 static void doSubrC (mcPretty_pretty p, decl_node s)
12430 {
12431 decl_node low;
12432 decl_node high;
12433
12434 s = decl_skipType (s);
12435 if (isOrdinal (s))
12436 {
12437 low = getMin (s);
12438 high = getMax (s);
12439 doExprC (p, high);
12440 doSubtractC (p, low);
12441 outText (p, (const char *) "+1", 2);
12442 }
12443 else if (decl_isEnumeration (s))
12444 {
12445 /* avoid dangling else. */
12446 low = getMin (s);
12447 high = getMax (s);
12448 doExprC (p, high);
12449 doSubtractC (p, low);
12450 outText (p, (const char *) "+1", 2);
12451 }
12452 else
12453 {
12454 /* avoid dangling else. */
12455 mcDebug_assert (decl_isSubrange (s));
12456 if ((s->subrangeF.high == NULL) || (s->subrangeF.low == NULL))
12457 {
12458 doSubrC (p, decl_getType (s));
12459 }
12460 else
12461 {
12462 doExprC (p, s->subrangeF.high);
12463 doSubtractC (p, s->subrangeF.low);
12464 outText (p, (const char *) "+1", 2);
12465 }
12466 }
12467 }
12468
12469
12470 /*
12471 doCompletePartialProcType -
12472 */
12473
12474 static void doCompletePartialProcType (mcPretty_pretty p, decl_node t, decl_node n)
12475 {
12476 unsigned int i;
12477 unsigned int h;
12478 decl_node v;
12479 decl_node u;
12480
12481 mcDebug_assert (decl_isProcType (n));
12482 u = NULL;
12483 outText (p, (const char *) "typedef", 7);
12484 mcPretty_setNeedSpace (p);
12485 doTypeC (p, n->proctypeF.returnType, &u);
12486 mcPretty_setNeedSpace (p);
12487 outText (p, (const char *) "(*", 2);
12488 doFQNameC (p, t);
12489 outText (p, (const char *) "_t) (", 5);
12490 i = Indexing_LowIndice (n->proctypeF.parameters);
12491 h = Indexing_HighIndice (n->proctypeF.parameters);
12492 while (i <= h)
12493 {
12494 v = static_cast<decl_node> (Indexing_GetIndice (n->proctypeF.parameters, i));
12495 doParameterC (p, v);
12496 mcPretty_noSpace (p);
12497 if (i < h)
12498 {
12499 outText (p, (const char *) ",", 1);
12500 mcPretty_setNeedSpace (p);
12501 }
12502 i += 1;
12503 }
12504 if (h == 0)
12505 {
12506 outText (p, (const char *) "void", 4);
12507 }
12508 outText (p, (const char *) ");\\n", 4);
12509 if (isDefForCNode (n))
12510 {
12511 /* emit a C named type which differs from the m2 proctype. */
12512 outText (p, (const char *) "typedef", 7);
12513 mcPretty_setNeedSpace (p);
12514 doFQNameC (p, t);
12515 outText (p, (const char *) "_t", 2);
12516 mcPretty_setNeedSpace (p);
12517 doFQNameC (p, t);
12518 outText (p, (const char *) "_C;\\n\\n", 7);
12519 }
12520 outText (p, (const char *) "struct", 6);
12521 mcPretty_setNeedSpace (p);
12522 doFQNameC (p, t);
12523 outText (p, (const char *) "_p {", 4);
12524 mcPretty_setNeedSpace (p);
12525 doFQNameC (p, t);
12526 outText (p, (const char *) "_t proc; };\\n\\n", 15);
12527 }
12528
12529
12530 /*
12531 isBase -
12532 */
12533
12534 static bool isBase (decl_node n)
12535 {
12536 switch (n->kind)
12537 {
12538 case decl_char:
12539 case decl_cardinal:
12540 case decl_longcard:
12541 case decl_shortcard:
12542 case decl_integer:
12543 case decl_longint:
12544 case decl_shortint:
12545 case decl_complex:
12546 case decl_longcomplex:
12547 case decl_shortcomplex:
12548 case decl_real:
12549 case decl_longreal:
12550 case decl_shortreal:
12551 case decl_bitset:
12552 case decl_boolean:
12553 case decl_proc:
12554 return true;
12555 break;
12556
12557
12558 default:
12559 return false;
12560 break;
12561 }
12562 /* static analysis guarentees a RETURN statement will be used before here. */
12563 __builtin_unreachable ();
12564 }
12565
12566
12567 /*
12568 doBoolC -
12569 */
12570
12571 static void doBoolC (mcPretty_pretty p)
12572 {
12573 if (mcOptions_useBool ())
12574 {
12575 outText (p, (const char *) "bool", 4);
12576 }
12577 else
12578 {
12579 outText (p, (const char *) "unsigned int", 12);
12580 }
12581 }
12582
12583
12584 /*
12585 doBaseC -
12586 */
12587
12588 static void doBaseC (mcPretty_pretty p, decl_node n)
12589 {
12590 switch (n->kind)
12591 {
12592 case decl_char:
12593 outText (p, (const char *) "char", 4);
12594 break;
12595
12596 case decl_cardinal:
12597 outText (p, (const char *) "unsigned int", 12);
12598 break;
12599
12600 case decl_longcard:
12601 outText (p, (const char *) "long unsigned int", 17);
12602 break;
12603
12604 case decl_shortcard:
12605 outText (p, (const char *) "short unsigned int", 18);
12606 break;
12607
12608 case decl_integer:
12609 outText (p, (const char *) "int", 3);
12610 break;
12611
12612 case decl_longint:
12613 outText (p, (const char *) "long int", 8);
12614 break;
12615
12616 case decl_shortint:
12617 outText (p, (const char *) "short int", 9);
12618 break;
12619
12620 case decl_complex:
12621 outText (p, (const char *) "double complex", 14);
12622 break;
12623
12624 case decl_longcomplex:
12625 outText (p, (const char *) "long double complex", 19);
12626 break;
12627
12628 case decl_shortcomplex:
12629 outText (p, (const char *) "float complex", 13);
12630 break;
12631
12632 case decl_real:
12633 outTextS (p, mcOptions_getCRealType ());
12634 break;
12635
12636 case decl_longreal:
12637 outTextS (p, mcOptions_getCLongRealType ());
12638 break;
12639
12640 case decl_shortreal:
12641 outTextS (p, mcOptions_getCShortRealType ());
12642 break;
12643
12644 case decl_bitset:
12645 outText (p, (const char *) "unsigned int", 12);
12646 break;
12647
12648 case decl_boolean:
12649 doBoolC (p);
12650 break;
12651
12652 case decl_proc:
12653 outText (p, (const char *) "PROC", 4);
12654 break;
12655
12656
12657 default:
12658 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
12659 __builtin_unreachable ();
12660 }
12661 mcPretty_setNeedSpace (p);
12662 }
12663
12664
12665 /*
12666 isSystem -
12667 */
12668
12669 static bool isSystem (decl_node n)
12670 {
12671 switch (n->kind)
12672 {
12673 case decl_address:
12674 return true;
12675 break;
12676
12677 case decl_loc:
12678 return true;
12679 break;
12680
12681 case decl_byte:
12682 return true;
12683 break;
12684
12685 case decl_word:
12686 return true;
12687 break;
12688
12689 case decl_csizet:
12690 return true;
12691 break;
12692
12693 case decl_cssizet:
12694 return true;
12695 break;
12696
12697
12698 default:
12699 return false;
12700 break;
12701 }
12702 /* static analysis guarentees a RETURN statement will be used before here. */
12703 __builtin_unreachable ();
12704 }
12705
12706
12707 /*
12708 doSystemC -
12709 */
12710
12711 static void doSystemC (mcPretty_pretty p, decl_node n)
12712 {
12713 switch (n->kind)
12714 {
12715 case decl_address:
12716 outText (p, (const char *) "void *", 6);
12717 break;
12718
12719 case decl_loc:
12720 outText (p, (const char *) "unsigned char", 13);
12721 mcPretty_setNeedSpace (p);
12722 break;
12723
12724 case decl_byte:
12725 outText (p, (const char *) "unsigned char", 13);
12726 mcPretty_setNeedSpace (p);
12727 break;
12728
12729 case decl_word:
12730 outText (p, (const char *) "unsigned int", 12);
12731 mcPretty_setNeedSpace (p);
12732 break;
12733
12734 case decl_csizet:
12735 outText (p, (const char *) "size_t", 6);
12736 mcPretty_setNeedSpace (p);
12737 keyc_useSize_t ();
12738 break;
12739
12740 case decl_cssizet:
12741 outText (p, (const char *) "ssize_t", 7);
12742 mcPretty_setNeedSpace (p);
12743 keyc_useSSize_t ();
12744 break;
12745
12746
12747 default:
12748 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
12749 __builtin_unreachable ();
12750 }
12751 }
12752
12753
12754 /*
12755 doArrayC -
12756 */
12757
12758 static void doArrayC (mcPretty_pretty p, decl_node n)
12759 {
12760 decl_node t;
12761 decl_node s;
12762 decl_node u;
12763
12764 mcDebug_assert (decl_isArray (n));
12765 t = n->arrayF.type;
12766 s = n->arrayF.subr;
12767 u = NULL;
12768 if (s == NULL)
12769 {
12770 doTypeC (p, t, &u);
12771 mcPretty_setNeedSpace (p);
12772 outText (p, (const char *) "*", 1);
12773 }
12774 else
12775 {
12776 outText (p, (const char *) "struct", 6);
12777 mcPretty_setNeedSpace (p);
12778 outText (p, (const char *) "{", 1);
12779 mcPretty_setNeedSpace (p);
12780 doTypeC (p, t, &u);
12781 mcPretty_setNeedSpace (p);
12782 outText (p, (const char *) "array[", 6);
12783 if (isZero (getMin (s)))
12784 {
12785 doExprC (p, getMax (s));
12786 }
12787 else
12788 {
12789 doExprC (p, getMax (s));
12790 doSubtractC (p, getMin (s));
12791 }
12792 outText (p, (const char *) "];", 2);
12793 mcPretty_setNeedSpace (p);
12794 outText (p, (const char *) "}", 1);
12795 mcPretty_setNeedSpace (p);
12796 }
12797 }
12798
12799
12800 /*
12801 doPointerC -
12802 */
12803
12804 static void doPointerC (mcPretty_pretty p, decl_node n, decl_node *m)
12805 {
12806 decl_node t;
12807 decl_node s;
12808
12809 t = n->pointerF.type;
12810 s = NULL;
12811 doTypeC (p, t, &s);
12812 mcPretty_setNeedSpace (p);
12813 outText (p, (const char *) "*", 1);
12814 }
12815
12816
12817 /*
12818 doRecordFieldC -
12819 */
12820
12821 static void doRecordFieldC (mcPretty_pretty p, decl_node f)
12822 {
12823 decl_node m;
12824
12825 m = NULL;
12826 mcPretty_setNeedSpace (p);
12827 doTypeC (p, f->recordfieldF.type, &m);
12828 doDNameC (p, f, false);
12829 }
12830
12831
12832 /*
12833 doVarientFieldC -
12834 */
12835
12836 static void doVarientFieldC (mcPretty_pretty p, decl_node n)
12837 {
12838 unsigned int i;
12839 unsigned int t;
12840 decl_node q;
12841
12842 mcDebug_assert (decl_isVarientField (n));
12843 if (! n->varientfieldF.simple)
12844 {
12845 outText (p, (const char *) "struct", 6);
12846 mcPretty_setNeedSpace (p);
12847 p = outKc (p, (const char *) "{\\n", 3);
12848 }
12849 i = Indexing_LowIndice (n->varientfieldF.listOfSons);
12850 t = Indexing_HighIndice (n->varientfieldF.listOfSons);
12851 while (i <= t)
12852 {
12853 q = static_cast<decl_node> (Indexing_GetIndice (n->varientfieldF.listOfSons, i));
12854 if (decl_isRecordField (q))
12855 {
12856 /* avoid dangling else. */
12857 if (! q->recordfieldF.tag)
12858 {
12859 doRecordFieldC (p, q);
12860 outText (p, (const char *) ";\\n", 3);
12861 }
12862 }
12863 else if (decl_isVarient (q))
12864 {
12865 /* avoid dangling else. */
12866 doVarientC (p, q);
12867 outText (p, (const char *) ";\\n", 3);
12868 }
12869 else
12870 {
12871 /* avoid dangling else. */
12872 M2RTS_HALT (-1);
12873 __builtin_unreachable ();
12874 }
12875 i += 1;
12876 }
12877 if (! n->varientfieldF.simple)
12878 {
12879 p = outKc (p, (const char *) "};\\n", 4);
12880 }
12881 }
12882
12883
12884 /*
12885 doVarientC -
12886 */
12887
12888 static void doVarientC (mcPretty_pretty p, decl_node n)
12889 {
12890 unsigned int i;
12891 unsigned int t;
12892 decl_node q;
12893
12894 mcDebug_assert (decl_isVarient (n));
12895 if (n->varientF.tag != NULL)
12896 {
12897 /* avoid gcc warning by using compound statement even if not strictly necessary. */
12898 if (decl_isRecordField (n->varientF.tag))
12899 {
12900 doRecordFieldC (p, n->varientF.tag);
12901 outText (p, (const char *) "; /* case tag */\\n", 19);
12902 }
12903 else if (decl_isVarientField (n->varientF.tag))
12904 {
12905 /* avoid dangling else. */
12906 /* doVarientFieldC (p, n^.varientF.tag) */
12907 M2RTS_HALT (-1);
12908 __builtin_unreachable ();
12909 }
12910 else
12911 {
12912 /* avoid dangling else. */
12913 M2RTS_HALT (-1);
12914 __builtin_unreachable ();
12915 }
12916 }
12917 outText (p, (const char *) "union", 5);
12918 mcPretty_setNeedSpace (p);
12919 p = outKc (p, (const char *) "{\\n", 3);
12920 i = Indexing_LowIndice (n->varientF.listOfSons);
12921 t = Indexing_HighIndice (n->varientF.listOfSons);
12922 while (i <= t)
12923 {
12924 q = static_cast<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
12925 if (decl_isRecordField (q))
12926 {
12927 /* avoid dangling else. */
12928 if (! q->recordfieldF.tag)
12929 {
12930 doRecordFieldC (p, q);
12931 outText (p, (const char *) ";\\n", 3);
12932 }
12933 }
12934 else if (decl_isVarientField (q))
12935 {
12936 /* avoid dangling else. */
12937 doVarientFieldC (p, q);
12938 }
12939 else
12940 {
12941 /* avoid dangling else. */
12942 M2RTS_HALT (-1);
12943 __builtin_unreachable ();
12944 }
12945 i += 1;
12946 }
12947 p = outKc (p, (const char *) "}", 1);
12948 }
12949
12950
12951 /*
12952 doRecordC -
12953 */
12954
12955 static void doRecordC (mcPretty_pretty p, decl_node n, decl_node *m)
12956 {
12957 unsigned int i;
12958 unsigned int h;
12959 decl_node f;
12960
12961 mcDebug_assert (decl_isRecord (n));
12962 outText (p, (const char *) "struct", 6);
12963 mcPretty_setNeedSpace (p);
12964 p = outKc (p, (const char *) "{", 1);
12965 i = Indexing_LowIndice (n->recordF.listOfSons);
12966 h = Indexing_HighIndice (n->recordF.listOfSons);
12967 mcPretty_setindent (p, (mcPretty_getcurpos (p))+indentation);
12968 outText (p, (const char *) "\\n", 2);
12969 while (i <= h)
12970 {
12971 f = static_cast<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
12972 if (decl_isRecordField (f))
12973 {
12974 /* avoid dangling else. */
12975 if (! f->recordfieldF.tag)
12976 {
12977 doRecordFieldC (p, f);
12978 outText (p, (const char *) ";\\n", 3);
12979 }
12980 }
12981 else if (decl_isVarient (f))
12982 {
12983 /* avoid dangling else. */
12984 doVarientC (p, f);
12985 outText (p, (const char *) ";\\n", 3);
12986 }
12987 else if (decl_isVarientField (f))
12988 {
12989 /* avoid dangling else. */
12990 doVarientFieldC (p, f);
12991 }
12992 i += 1;
12993 }
12994 p = outKc (p, (const char *) "}", 1);
12995 mcPretty_setNeedSpace (p);
12996 }
12997
12998
12999 /*
13000 isBitset -
13001 */
13002
13003 static bool isBitset (decl_node n)
13004 {
13005 return n == bitsetN;
13006 /* static analysis guarentees a RETURN statement will be used before here. */
13007 __builtin_unreachable ();
13008 }
13009
13010
13011 /*
13012 isNegative - returns TRUE if expression, n, is negative.
13013 */
13014
13015 static bool isNegative (decl_node n)
13016 {
13017 /* --fixme-- needs to be completed. */
13018 return false;
13019 /* static analysis guarentees a RETURN statement will be used before here. */
13020 __builtin_unreachable ();
13021 }
13022
13023
13024 /*
13025 doSubrangeC -
13026 */
13027
13028 static void doSubrangeC (mcPretty_pretty p, decl_node n)
13029 {
13030 mcDebug_assert (decl_isSubrange (n));
13031 if (isNegative (n->subrangeF.low))
13032 {
13033 outText (p, (const char *) "int", 3);
13034 mcPretty_setNeedSpace (p);
13035 }
13036 else
13037 {
13038 outText (p, (const char *) "unsigned int", 12);
13039 mcPretty_setNeedSpace (p);
13040 }
13041 }
13042
13043
13044 /*
13045 doSetC - generates a C type which holds the set.
13046 Currently we only support sets of size WORD.
13047 */
13048
13049 static void doSetC (mcPretty_pretty p, decl_node n)
13050 {
13051 mcDebug_assert (decl_isSet (n));
13052 outText (p, (const char *) "unsigned int", 12);
13053 mcPretty_setNeedSpace (p);
13054 }
13055
13056
13057 /*
13058 doTypeC -
13059 */
13060
13061 static void doTypeC (mcPretty_pretty p, decl_node n, decl_node *m)
13062 {
13063 if (n == NULL)
13064 {
13065 outText (p, (const char *) "void", 4);
13066 }
13067 else if (isBase (n))
13068 {
13069 /* avoid dangling else. */
13070 doBaseC (p, n);
13071 }
13072 else if (isSystem (n))
13073 {
13074 /* avoid dangling else. */
13075 doSystemC (p, n);
13076 }
13077 else if (decl_isEnumeration (n))
13078 {
13079 /* avoid dangling else. */
13080 doEnumerationC (p, n);
13081 }
13082 else if (decl_isType (n))
13083 {
13084 /* avoid dangling else. */
13085 doFQNameC (p, n);
13086 /*
13087 ELSIF isProcType (n) OR isArray (n) OR isRecord (n)
13088 THEN
13089 HALT n should have been simplified.
13090 */
13091 mcPretty_setNeedSpace (p);
13092 }
13093 else if (decl_isProcType (n))
13094 {
13095 /* avoid dangling else. */
13096 doProcTypeC (p, n, (*m));
13097 }
13098 else if (decl_isArray (n))
13099 {
13100 /* avoid dangling else. */
13101 doArrayC (p, n);
13102 }
13103 else if (decl_isRecord (n))
13104 {
13105 /* avoid dangling else. */
13106 doRecordC (p, n, m);
13107 }
13108 else if (decl_isPointer (n))
13109 {
13110 /* avoid dangling else. */
13111 doPointerC (p, n, m);
13112 }
13113 else if (decl_isSubrange (n))
13114 {
13115 /* avoid dangling else. */
13116 doSubrangeC (p, n);
13117 }
13118 else if (decl_isSet (n))
13119 {
13120 /* avoid dangling else. */
13121 doSetC (p, n);
13122 }
13123 else
13124 {
13125 /* avoid dangling else. */
13126 /* --fixme-- */
13127 mcPretty_print (p, (const char *) "to do ... typedef etc etc ", 27);
13128 doFQNameC (p, n);
13129 mcPretty_print (p, (const char *) ";\\n", 3);
13130 M2RTS_HALT (-1);
13131 __builtin_unreachable ();
13132 }
13133 }
13134
13135
13136 /*
13137 doArrayNameC - it displays the array declaration (it might be an unbounded).
13138 */
13139
13140 static void doArrayNameC (mcPretty_pretty p, decl_node n)
13141 {
13142 doTypeNameC (p, decl_getType (n));
13143 mcPretty_setNeedSpace (p);
13144 outText (p, (const char *) "*", 1);
13145 }
13146
13147
13148 /*
13149 doRecordNameC - emit the C/C++ record name <name of n>"_r".
13150 */
13151
13152 static void doRecordNameC (mcPretty_pretty p, decl_node n)
13153 {
13154 DynamicStrings_String s;
13155
13156 s = getFQstring (n);
13157 s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_r", 2)));
13158 outTextS (p, s);
13159 s = DynamicStrings_KillString (s);
13160 }
13161
13162
13163 /*
13164 doPointerNameC - emit the C/C++ pointer type <name of n>*.
13165 */
13166
13167 static void doPointerNameC (mcPretty_pretty p, decl_node n)
13168 {
13169 doTypeNameC (p, decl_getType (n));
13170 mcPretty_setNeedSpace (p);
13171 outText (p, (const char *) "*", 1);
13172 }
13173
13174
13175 /*
13176 doTypeNameC -
13177 */
13178
13179 static void doTypeNameC (mcPretty_pretty p, decl_node n)
13180 {
13181 DynamicStrings_String t;
13182
13183 if (n == NULL)
13184 {
13185 outText (p, (const char *) "void", 4);
13186 mcPretty_setNeedSpace (p);
13187 }
13188 else if (isBase (n))
13189 {
13190 /* avoid dangling else. */
13191 doBaseC (p, n);
13192 }
13193 else if (isSystem (n))
13194 {
13195 /* avoid dangling else. */
13196 doSystemC (p, n);
13197 }
13198 else if (decl_isEnumeration (n))
13199 {
13200 /* avoid dangling else. */
13201 mcPretty_print (p, (const char *) "is enumeration type name required\\n", 35);
13202 }
13203 else if (decl_isType (n))
13204 {
13205 /* avoid dangling else. */
13206 doFQNameC (p, n);
13207 }
13208 else if (decl_isProcType (n))
13209 {
13210 /* avoid dangling else. */
13211 doFQNameC (p, n);
13212 outText (p, (const char *) "_t", 2);
13213 }
13214 else if (decl_isArray (n))
13215 {
13216 /* avoid dangling else. */
13217 doArrayNameC (p, n);
13218 }
13219 else if (decl_isRecord (n))
13220 {
13221 /* avoid dangling else. */
13222 doRecordNameC (p, n);
13223 }
13224 else if (decl_isPointer (n))
13225 {
13226 /* avoid dangling else. */
13227 doPointerNameC (p, n);
13228 }
13229 else if (decl_isSubrange (n))
13230 {
13231 /* avoid dangling else. */
13232 doSubrangeC (p, n);
13233 }
13234 else
13235 {
13236 /* avoid dangling else. */
13237 mcPretty_print (p, (const char *) "is type unknown required\\n", 26);
13238 stop ();
13239 }
13240 }
13241
13242
13243 /*
13244 isExternal - returns TRUE if symbol, n, was declared in another module.
13245 */
13246
13247 static bool isExternal (decl_node n)
13248 {
13249 decl_node s;
13250
13251 s = decl_getScope (n);
13252 return ((s != NULL) && (decl_isDef (s))) && (((decl_isImp (decl_getMainModule ())) && (s != (decl_lookupDef (decl_getSymName (decl_getMainModule ()))))) || (decl_isModule (decl_getMainModule ())));
13253 /* static analysis guarentees a RETURN statement will be used before here. */
13254 __builtin_unreachable ();
13255 }
13256
13257
13258 /*
13259 doVarC -
13260 */
13261
13262 static void doVarC (decl_node n)
13263 {
13264 decl_node s;
13265
13266 if (decl_isDef (decl_getMainModule ()))
13267 {
13268 mcPretty_print (doP, (const char *) "EXTERN", 6);
13269 mcPretty_setNeedSpace (doP);
13270 }
13271 else if ((! (decl_isExported (n))) && (! (isLocal (n))))
13272 {
13273 /* avoid dangling else. */
13274 mcPretty_print (doP, (const char *) "static", 6);
13275 mcPretty_setNeedSpace (doP);
13276 }
13277 else if (mcOptions_getExtendedOpaque ())
13278 {
13279 /* avoid dangling else. */
13280 if (isExternal (n))
13281 {
13282 /* different module declared this variable, therefore it is extern. */
13283 mcPretty_print (doP, (const char *) "extern", 6);
13284 mcPretty_setNeedSpace (doP);
13285 }
13286 }
13287 s = NULL;
13288 doTypeC (doP, decl_getType (n), &s);
13289 mcPretty_setNeedSpace (doP);
13290 doFQDNameC (doP, n, false);
13291 mcPretty_print (doP, (const char *) ";\\n", 3);
13292 }
13293
13294
13295 /*
13296 doExternCP -
13297 */
13298
13299 static void doExternCP (mcPretty_pretty p)
13300 {
13301 if (lang == decl_ansiCP)
13302 {
13303 outText (p, (const char *) "extern \"C\"", 10);
13304 mcPretty_setNeedSpace (p);
13305 }
13306 }
13307
13308
13309 /*
13310 doProcedureCommentText -
13311 */
13312
13313 static void doProcedureCommentText (mcPretty_pretty p, DynamicStrings_String s)
13314 {
13315 /* remove
13316 from the start of the comment. */
13317 while (((DynamicStrings_Length (s)) > 0) && ((DynamicStrings_char (s, 0)) == ASCII_lf))
13318 {
13319 s = DynamicStrings_Slice (s, 1, 0);
13320 }
13321 outTextS (p, s);
13322 }
13323
13324
13325 /*
13326 doProcedureComment -
13327 */
13328
13329 static void doProcedureComment (mcPretty_pretty p, DynamicStrings_String s)
13330 {
13331 if (s != NULL)
13332 {
13333 outText (p, (const char *) "\\n/*\\n", 6);
13334 doProcedureCommentText (p, s);
13335 outText (p, (const char *) "*/\\n\\n", 6);
13336 }
13337 }
13338
13339
13340 /*
13341 doProcedureHeadingC -
13342 */
13343
13344 static void doProcedureHeadingC (decl_node n, bool prototype)
13345 {
13346 unsigned int i;
13347 unsigned int h;
13348 decl_node p;
13349 decl_node q;
13350
13351 mcDebug_assert (decl_isProcedure (n));
13352 mcPretty_noSpace (doP);
13353 if (decl_isDef (decl_getMainModule ()))
13354 {
13355 doProcedureComment (doP, mcComment_getContent (n->procedureF.defComment));
13356 outText (doP, (const char *) "EXTERN", 6);
13357 mcPretty_setNeedSpace (doP);
13358 }
13359 else if (decl_isExported (n))
13360 {
13361 /* avoid dangling else. */
13362 doProcedureComment (doP, mcComment_getContent (n->procedureF.modComment));
13363 doExternCP (doP);
13364 }
13365 else
13366 {
13367 /* avoid dangling else. */
13368 doProcedureComment (doP, mcComment_getContent (n->procedureF.modComment));
13369 outText (doP, (const char *) "static", 6);
13370 mcPretty_setNeedSpace (doP);
13371 }
13372 q = NULL;
13373 doTypeC (doP, n->procedureF.returnType, &q);
13374 mcPretty_setNeedSpace (doP);
13375 doFQDNameC (doP, n, false);
13376 mcPretty_setNeedSpace (doP);
13377 outText (doP, (const char *) "(", 1);
13378 i = Indexing_LowIndice (n->procedureF.parameters);
13379 h = Indexing_HighIndice (n->procedureF.parameters);
13380 while (i <= h)
13381 {
13382 p = static_cast<decl_node> (Indexing_GetIndice (n->procedureF.parameters, i));
13383 doParameterC (doP, p);
13384 mcPretty_noSpace (doP);
13385 if (i < h)
13386 {
13387 mcPretty_print (doP, (const char *) ",", 1);
13388 mcPretty_setNeedSpace (doP);
13389 }
13390 i += 1;
13391 }
13392 if (h == 0)
13393 {
13394 outText (doP, (const char *) "void", 4);
13395 }
13396 mcPretty_print (doP, (const char *) ")", 1);
13397 if ((n->procedureF.noreturn && prototype) && (! (mcOptions_getSuppressNoReturn ())))
13398 {
13399 mcPretty_setNeedSpace (doP);
13400 outText (doP, (const char *) "__attribute__ ((noreturn))", 26);
13401 }
13402 }
13403
13404
13405 /*
13406 checkDeclareUnboundedParamCopyC -
13407 */
13408
13409 static bool checkDeclareUnboundedParamCopyC (mcPretty_pretty p, decl_node n)
13410 {
13411 decl_node t;
13412 unsigned int i;
13413 unsigned int c;
13414 wlists_wlist l;
13415 bool seen;
13416
13417 seen = false;
13418 t = decl_getType (n);
13419 l = n->paramF.namelist->identlistF.names;
13420 if (((decl_isArray (t)) && (decl_isUnbounded (t))) && (l != NULL))
13421 {
13422 t = decl_getType (t);
13423 c = wlists_noOfItemsInList (l);
13424 i = 1;
13425 while (i <= c)
13426 {
13427 doTypeNameC (p, t);
13428 mcPretty_setNeedSpace (p);
13429 doNamesC (p, wlists_getItemFromList (l, i));
13430 outText (p, (const char *) "[_", 2);
13431 doNamesC (p, wlists_getItemFromList (l, i));
13432 outText (p, (const char *) "_high+1];\\n", 11);
13433 seen = true;
13434 i += 1;
13435 }
13436 }
13437 return seen;
13438 /* static analysis guarentees a RETURN statement will be used before here. */
13439 __builtin_unreachable ();
13440 }
13441
13442
13443 /*
13444 checkUnboundedParamCopyC -
13445 */
13446
13447 static void checkUnboundedParamCopyC (mcPretty_pretty p, decl_node n)
13448 {
13449 decl_node t;
13450 decl_node s;
13451 unsigned int i;
13452 unsigned int c;
13453 wlists_wlist l;
13454
13455 t = decl_getType (n);
13456 l = n->paramF.namelist->identlistF.names;
13457 if (((decl_isArray (t)) && (decl_isUnbounded (t))) && (l != NULL))
13458 {
13459 c = wlists_noOfItemsInList (l);
13460 i = 1;
13461 t = decl_getType (t);
13462 s = decl_skipType (t);
13463 while (i <= c)
13464 {
13465 keyc_useMemcpy ();
13466 outText (p, (const char *) "memcpy (", 8);
13467 doNamesC (p, wlists_getItemFromList (l, i));
13468 outText (p, (const char *) ",", 1);
13469 mcPretty_setNeedSpace (p);
13470 doNamesC (p, wlists_getItemFromList (l, i));
13471 outText (p, (const char *) "_, ", 3);
13472 if (((s == charN) || (s == byteN)) || (s == locN))
13473 {
13474 outText (p, (const char *) "_", 1);
13475 doNamesC (p, wlists_getItemFromList (l, i));
13476 outText (p, (const char *) "_high+1);\\n", 11);
13477 }
13478 else
13479 {
13480 outText (p, (const char *) "(_", 2);
13481 doNamesC (p, wlists_getItemFromList (l, i));
13482 outText (p, (const char *) "_high+1)", 8);
13483 mcPretty_setNeedSpace (p);
13484 doMultiplyBySize (p, t);
13485 outText (p, (const char *) ");\\n", 4);
13486 }
13487 i += 1;
13488 }
13489 }
13490 }
13491
13492
13493 /*
13494 doUnboundedParamCopyC -
13495 */
13496
13497 static void doUnboundedParamCopyC (mcPretty_pretty p, decl_node n)
13498 {
13499 unsigned int i;
13500 unsigned int h;
13501 decl_node q;
13502 bool seen;
13503
13504 mcDebug_assert (decl_isProcedure (n));
13505 i = Indexing_LowIndice (n->procedureF.parameters);
13506 h = Indexing_HighIndice (n->procedureF.parameters);
13507 seen = false;
13508 while (i <= h)
13509 {
13510 q = static_cast<decl_node> (Indexing_GetIndice (n->procedureF.parameters, i));
13511 if (decl_isParam (q))
13512 {
13513 seen = (checkDeclareUnboundedParamCopyC (p, q)) || seen;
13514 }
13515 i += 1;
13516 }
13517 if (seen)
13518 {
13519 outText (p, (const char *) "\\n", 2);
13520 outText (p, (const char *) "/* make a local copy of each unbounded array. */\\n", 51);
13521 i = Indexing_LowIndice (n->procedureF.parameters);
13522 while (i <= h)
13523 {
13524 q = static_cast<decl_node> (Indexing_GetIndice (n->procedureF.parameters, i));
13525 if (decl_isParam (q))
13526 {
13527 checkUnboundedParamCopyC (p, q);
13528 }
13529 i += 1;
13530 }
13531 }
13532 }
13533
13534
13535 /*
13536 doPrototypeC -
13537 */
13538
13539 static void doPrototypeC (decl_node n)
13540 {
13541 if (! (decl_isExported (n)))
13542 {
13543 keyc_enterScope (n);
13544 doProcedureHeadingC (n, true);
13545 mcPretty_print (doP, (const char *) ";\\n", 3);
13546 keyc_leaveScope (n);
13547 }
13548 }
13549
13550
13551 /*
13552 addTodo - adds, n, to the todo list.
13553 */
13554
13555 static void addTodo (decl_node n)
13556 {
13557 if (((n != NULL) && (! (alists_isItemInList (partialQ, reinterpret_cast<void *> (n))))) && (! (alists_isItemInList (doneQ, reinterpret_cast<void *> (n)))))
13558 {
13559 mcDebug_assert (! (decl_isVarient (n)));
13560 mcDebug_assert (! (decl_isVarientField (n)));
13561 mcDebug_assert (! (decl_isDef (n)));
13562 alists_includeItemIntoList (todoQ, reinterpret_cast<void *> (n));
13563 }
13564 }
13565
13566
13567 /*
13568 addVariablesTodo -
13569 */
13570
13571 static void addVariablesTodo (decl_node n)
13572 {
13573 if (decl_isVar (n))
13574 {
13575 /* avoid gcc warning by using compound statement even if not strictly necessary. */
13576 if (n->varF.isParameter || n->varF.isVarParameter)
13577 {
13578 addDone (n);
13579 addTodo (decl_getType (n));
13580 }
13581 else
13582 {
13583 addTodo (n);
13584 }
13585 }
13586 }
13587
13588
13589 /*
13590 addTypesTodo -
13591 */
13592
13593 static void addTypesTodo (decl_node n)
13594 {
13595 if (decl_isUnbounded (n))
13596 {
13597 addDone (n);
13598 }
13599 else
13600 {
13601 addTodo (n);
13602 }
13603 }
13604
13605
13606 /*
13607 tempName -
13608 */
13609
13610 static DynamicStrings_String tempName (void)
13611 {
13612 tempCount += 1;
13613 return FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "_T%d", 4), (const unsigned char *) &tempCount, (sizeof (tempCount)-1));
13614 /* static analysis guarentees a RETURN statement will be used before here. */
13615 __builtin_unreachable ();
13616 }
13617
13618
13619 /*
13620 makeIntermediateType -
13621 */
13622
13623 static decl_node makeIntermediateType (DynamicStrings_String s, decl_node p)
13624 {
13625 nameKey_Name n;
13626 decl_node o;
13627
13628 n = nameKey_makekey (DynamicStrings_string (s));
13629 decl_enterScope (decl_getScope (p));
13630 o = p;
13631 p = decl_makeType (nameKey_makekey (DynamicStrings_string (s)));
13632 decl_putType (p, o);
13633 putTypeInternal (p);
13634 decl_leaveScope ();
13635 return p;
13636 /* static analysis guarentees a RETURN statement will be used before here. */
13637 __builtin_unreachable ();
13638 }
13639
13640
13641 /*
13642 simplifyType -
13643 */
13644
13645 static void simplifyType (alists_alist l, decl_node *p)
13646 {
13647 DynamicStrings_String s;
13648
13649 if ((((*p) != NULL) && (((decl_isRecord ((*p))) || (decl_isArray ((*p)))) || (decl_isProcType ((*p))))) && (! (decl_isUnbounded ((*p)))))
13650 {
13651 s = tempName ();
13652 (*p) = makeIntermediateType (s, (*p));
13653 s = DynamicStrings_KillString (s);
13654 simplified = false;
13655 }
13656 simplifyNode (l, (*p));
13657 }
13658
13659
13660 /*
13661 simplifyVar -
13662 */
13663
13664 static void simplifyVar (alists_alist l, decl_node n)
13665 {
13666 unsigned int i;
13667 unsigned int t;
13668 decl_node v;
13669 decl_node d;
13670 decl_node o;
13671
13672 mcDebug_assert (decl_isVar (n));
13673 o = n->varF.type;
13674 simplifyType (l, &n->varF.type);
13675 if (o != n->varF.type)
13676 {
13677 /* simplification has occurred, make sure that all other variables of this type
13678 use the new type. */
13679 d = n->varF.decl;
13680 mcDebug_assert (isVarDecl (d));
13681 t = wlists_noOfItemsInList (d->vardeclF.names);
13682 i = 1;
13683 while (i <= t)
13684 {
13685 v = decl_lookupInScope (n->varF.scope, wlists_getItemFromList (d->vardeclF.names, i));
13686 mcDebug_assert (decl_isVar (v));
13687 v->varF.type = n->varF.type;
13688 i += 1;
13689 }
13690 }
13691 }
13692
13693
13694 /*
13695 simplifyRecord -
13696 */
13697
13698 static void simplifyRecord (alists_alist l, decl_node n)
13699 {
13700 unsigned int i;
13701 unsigned int t;
13702 decl_node q;
13703
13704 i = Indexing_LowIndice (n->recordF.listOfSons);
13705 t = Indexing_HighIndice (n->recordF.listOfSons);
13706 while (i <= t)
13707 {
13708 q = static_cast<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
13709 simplifyNode (l, q);
13710 i += 1;
13711 }
13712 }
13713
13714
13715 /*
13716 simplifyVarient -
13717 */
13718
13719 static void simplifyVarient (alists_alist l, decl_node n)
13720 {
13721 unsigned int i;
13722 unsigned int t;
13723 decl_node q;
13724
13725 simplifyNode (l, n->varientF.tag);
13726 i = Indexing_LowIndice (n->varientF.listOfSons);
13727 t = Indexing_HighIndice (n->varientF.listOfSons);
13728 while (i <= t)
13729 {
13730 q = static_cast<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
13731 simplifyNode (l, q);
13732 i += 1;
13733 }
13734 }
13735
13736
13737 /*
13738 simplifyVarientField -
13739 */
13740
13741 static void simplifyVarientField (alists_alist l, decl_node n)
13742 {
13743 unsigned int i;
13744 unsigned int t;
13745 decl_node q;
13746
13747 i = Indexing_LowIndice (n->varientfieldF.listOfSons);
13748 t = Indexing_HighIndice (n->varientfieldF.listOfSons);
13749 while (i <= t)
13750 {
13751 q = static_cast<decl_node> (Indexing_GetIndice (n->varientfieldF.listOfSons, i));
13752 simplifyNode (l, q);
13753 i += 1;
13754 }
13755 }
13756
13757
13758 /*
13759 doSimplifyNode -
13760 */
13761
13762 static void doSimplifyNode (alists_alist l, decl_node n)
13763 {
13764 if (n == NULL)
13765 {} /* empty. */
13766 else if (decl_isType (n))
13767 {
13768 /* avoid dangling else. */
13769 /* no need to simplify a type. */
13770 simplifyNode (l, decl_getType (n));
13771 }
13772 else if (decl_isVar (n))
13773 {
13774 /* avoid dangling else. */
13775 simplifyVar (l, n);
13776 }
13777 else if (decl_isRecord (n))
13778 {
13779 /* avoid dangling else. */
13780 simplifyRecord (l, n);
13781 }
13782 else if (decl_isRecordField (n))
13783 {
13784 /* avoid dangling else. */
13785 simplifyType (l, &n->recordfieldF.type);
13786 }
13787 else if (decl_isArray (n))
13788 {
13789 /* avoid dangling else. */
13790 simplifyType (l, &n->arrayF.type);
13791 }
13792 else if (decl_isVarient (n))
13793 {
13794 /* avoid dangling else. */
13795 simplifyVarient (l, n);
13796 }
13797 else if (decl_isVarientField (n))
13798 {
13799 /* avoid dangling else. */
13800 simplifyVarientField (l, n);
13801 }
13802 else if (decl_isPointer (n))
13803 {
13804 /* avoid dangling else. */
13805 simplifyType (l, &n->pointerF.type);
13806 }
13807 }
13808
13809
13810 /*
13811 simplifyNode -
13812 */
13813
13814 static void simplifyNode (alists_alist l, decl_node n)
13815 {
13816 if (! (alists_isItemInList (l, reinterpret_cast<void *> (n))))
13817 {
13818 alists_includeItemIntoList (l, reinterpret_cast<void *> (n));
13819 doSimplifyNode (l, n);
13820 }
13821 }
13822
13823
13824 /*
13825 doSimplify -
13826 */
13827
13828 static void doSimplify (decl_node n)
13829 {
13830 alists_alist l;
13831
13832 l = alists_initList ();
13833 simplifyNode (l, n);
13834 alists_killList (&l);
13835 }
13836
13837
13838 /*
13839 simplifyTypes -
13840 */
13841
13842 static void simplifyTypes (decl_scopeT s)
13843 {
13844 do {
13845 simplified = true;
13846 Indexing_ForeachIndiceInIndexDo (s.types, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doSimplify});
13847 Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doSimplify});
13848 } while (! (simplified));
13849 }
13850
13851
13852 /*
13853 outDeclsDefC -
13854 */
13855
13856 static void outDeclsDefC (mcPretty_pretty p, decl_node n)
13857 {
13858 decl_scopeT s;
13859
13860 s = n->defF.decls;
13861 simplifyTypes (s);
13862 includeConstType (s);
13863 doP = p;
13864 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
13865 /* try and output types, constants before variables and procedures. */
13866 includeDefVarProcedure (n);
13867 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
13868 Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC});
13869 }
13870
13871
13872 /*
13873 includeConstType -
13874 */
13875
13876 static void includeConstType (decl_scopeT s)
13877 {
13878 Indexing_ForeachIndiceInIndexDo (s.constants, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo});
13879 Indexing_ForeachIndiceInIndexDo (s.types, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTypesTodo});
13880 }
13881
13882
13883 /*
13884 includeVarProcedure -
13885 */
13886
13887 static void includeVarProcedure (decl_scopeT s)
13888 {
13889 Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo});
13890 Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addVariablesTodo});
13891 }
13892
13893
13894 /*
13895 includeVar -
13896 */
13897
13898 static void includeVar (decl_scopeT s)
13899 {
13900 Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo});
13901 }
13902
13903
13904 /*
13905 includeExternals -
13906 */
13907
13908 static void includeExternals (decl_node n)
13909 {
13910 alists_alist l;
13911
13912 l = alists_initList ();
13913 visitNode (l, n, (decl_nodeProcedure) {(decl_nodeProcedure_t) addExported});
13914 alists_killList (&l);
13915 }
13916
13917
13918 /*
13919 checkSystemInclude -
13920 */
13921
13922 static void checkSystemInclude (decl_node n)
13923 {
13924 }
13925
13926
13927 /*
13928 addExported -
13929 */
13930
13931 static void addExported (decl_node n)
13932 {
13933 decl_node s;
13934
13935 s = decl_getScope (n);
13936 if (((s != NULL) && (decl_isDef (s))) && (s != defModule))
13937 {
13938 if (((decl_isType (n)) || (decl_isVar (n))) || (decl_isConst (n)))
13939 {
13940 addTodo (n);
13941 }
13942 }
13943 }
13944
13945
13946 /*
13947 addExternal - only adds, n, if this symbol is external to the
13948 implementation module and is not a hidden type.
13949 */
13950
13951 static void addExternal (decl_node n)
13952 {
13953 if (((((decl_getScope (n)) == defModule) && (decl_isType (n))) && (decl_isTypeHidden (n))) && (! (mcOptions_getExtendedOpaque ())))
13954 {} /* empty. */
13955 /* do nothing. */
13956 else if (! (decl_isDef (n)))
13957 {
13958 /* avoid dangling else. */
13959 addTodo (n);
13960 }
13961 }
13962
13963
13964 /*
13965 includeDefConstType -
13966 */
13967
13968 static void includeDefConstType (decl_node n)
13969 {
13970 decl_node d;
13971
13972 if (decl_isImp (n))
13973 {
13974 defModule = decl_lookupDef (decl_getSymName (n));
13975 if (defModule != NULL)
13976 {
13977 simplifyTypes (defModule->defF.decls);
13978 includeConstType (defModule->defF.decls);
13979 symbolKey_foreachNodeDo (defModule->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addExternal});
13980 }
13981 }
13982 }
13983
13984
13985 /*
13986 runIncludeDefConstType -
13987 */
13988
13989 static void runIncludeDefConstType (decl_node n)
13990 {
13991 decl_node d;
13992
13993 if (decl_isDef (n))
13994 {
13995 simplifyTypes (n->defF.decls);
13996 includeConstType (n->defF.decls);
13997 symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addExternal});
13998 }
13999 }
14000
14001
14002 /*
14003 joinProcedures - copies procedures from definition module,
14004 d, into implementation module, i.
14005 */
14006
14007 static void joinProcedures (decl_node i, decl_node d)
14008 {
14009 unsigned int h;
14010 unsigned int j;
14011
14012 mcDebug_assert (decl_isDef (d));
14013 mcDebug_assert (decl_isImp (i));
14014 j = 1;
14015 h = Indexing_HighIndice (d->defF.decls.procedures);
14016 while (j <= h)
14017 {
14018 Indexing_IncludeIndiceIntoIndex (i->impF.decls.procedures, Indexing_GetIndice (d->defF.decls.procedures, j));
14019 j += 1;
14020 }
14021 }
14022
14023
14024 /*
14025 includeDefVarProcedure -
14026 */
14027
14028 static void includeDefVarProcedure (decl_node n)
14029 {
14030 decl_node d;
14031
14032 if (decl_isImp (n))
14033 {
14034 /* avoid dangling else. */
14035 defModule = decl_lookupDef (decl_getSymName (n));
14036 if (defModule != NULL)
14037 {
14038 /*
14039 includeVar (defModule^.defF.decls) ;
14040 simplifyTypes (defModule^.defF.decls) ;
14041 */
14042 joinProcedures (n, defModule);
14043 }
14044 }
14045 else if (decl_isDef (n))
14046 {
14047 /* avoid dangling else. */
14048 includeVar (n->defF.decls);
14049 simplifyTypes (n->defF.decls);
14050 }
14051 }
14052
14053
14054 /*
14055 foreachModuleDo -
14056 */
14057
14058 static void foreachModuleDo (decl_node n, symbolKey_performOperation p)
14059 {
14060 decl_foreachDefModuleDo (p);
14061 decl_foreachModModuleDo (p);
14062 }
14063
14064
14065 /*
14066 outDeclsImpC -
14067 */
14068
14069 static void outDeclsImpC (mcPretty_pretty p, decl_scopeT s)
14070 {
14071 simplifyTypes (s);
14072 includeConstType (s);
14073 doP = p;
14074 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
14075 /* try and output types, constants before variables and procedures. */
14076 includeVarProcedure (s);
14077 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
14078 }
14079
14080
14081 /*
14082 doStatementSequenceC -
14083 */
14084
14085 static void doStatementSequenceC (mcPretty_pretty p, decl_node s)
14086 {
14087 unsigned int i;
14088 unsigned int h;
14089
14090 mcDebug_assert (decl_isStatementSequence (s));
14091 h = Indexing_HighIndice (s->stmtF.statements);
14092 i = 1;
14093 while (i <= h)
14094 {
14095 doStatementsC (p, reinterpret_cast<decl_node> (Indexing_GetIndice (s->stmtF.statements, i)));
14096 i += 1;
14097 }
14098 }
14099
14100
14101 /*
14102 isStatementSequenceEmpty -
14103 */
14104
14105 static bool isStatementSequenceEmpty (decl_node s)
14106 {
14107 mcDebug_assert (decl_isStatementSequence (s));
14108 return (Indexing_HighIndice (s->stmtF.statements)) == 0;
14109 /* static analysis guarentees a RETURN statement will be used before here. */
14110 __builtin_unreachable ();
14111 }
14112
14113
14114 /*
14115 isSingleStatement - returns TRUE if the statement sequence, s, has
14116 only one statement.
14117 */
14118
14119 static bool isSingleStatement (decl_node s)
14120 {
14121 unsigned int h;
14122
14123 mcDebug_assert (decl_isStatementSequence (s));
14124 h = Indexing_HighIndice (s->stmtF.statements);
14125 if ((h == 0) || (h > 1))
14126 {
14127 return false;
14128 }
14129 s = static_cast<decl_node> (Indexing_GetIndice (s->stmtF.statements, 1));
14130 return (! (decl_isStatementSequence (s))) || (isSingleStatement (s));
14131 /* static analysis guarentees a RETURN statement will be used before here. */
14132 __builtin_unreachable ();
14133 }
14134
14135
14136 /*
14137 doCommentC -
14138 */
14139
14140 static void doCommentC (mcPretty_pretty p, decl_node s)
14141 {
14142 DynamicStrings_String c;
14143
14144 if (s != NULL)
14145 {
14146 mcDebug_assert (isComment (s));
14147 if (! (mcComment_isProcedureComment (s->commentF.content)))
14148 {
14149 if (mcComment_isAfterComment (s->commentF.content))
14150 {
14151 mcPretty_setNeedSpace (p);
14152 outText (p, (const char *) " /* ", 4);
14153 }
14154 else
14155 {
14156 outText (p, (const char *) "/* ", 3);
14157 }
14158 c = mcComment_getContent (s->commentF.content);
14159 c = DynamicStrings_RemoveWhitePrefix (DynamicStrings_RemoveWhitePostfix (c));
14160 outTextS (p, c);
14161 outText (p, (const char *) " */\\n", 6);
14162 }
14163 }
14164 }
14165
14166
14167 /*
14168 doAfterCommentC - emit an after comment, c, or a newline if, c, is empty.
14169 */
14170
14171 static void doAfterCommentC (mcPretty_pretty p, decl_node c)
14172 {
14173 if (c == NULL)
14174 {
14175 outText (p, (const char *) "\\n", 2);
14176 }
14177 else
14178 {
14179 doCommentC (p, c);
14180 }
14181 }
14182
14183
14184 /*
14185 doReturnC - issue a return statement and also place in an after comment if one exists.
14186 */
14187
14188 static void doReturnC (mcPretty_pretty p, decl_node s)
14189 {
14190 mcDebug_assert (decl_isReturn (s));
14191 doCommentC (p, s->returnF.returnComment.body);
14192 outText (p, (const char *) "return", 6);
14193 if (s->returnF.scope != NULL)
14194 {
14195 mcPretty_setNeedSpace (p);
14196 if ((! (decl_isProcedure (s->returnF.scope))) || ((decl_getType (s->returnF.scope)) == NULL))
14197 {
14198 mcMetaError_metaError1 ((const char *) "{%1DMad} has no return type", 27, (const unsigned char *) &s->returnF.scope, (sizeof (s->returnF.scope)-1));
14199 }
14200 else
14201 {
14202 doExprCastC (p, s->returnF.exp, decl_getType (s->returnF.scope));
14203 }
14204 }
14205 outText (p, (const char *) ";", 1);
14206 doAfterCommentC (p, s->returnF.returnComment.after);
14207 }
14208
14209
14210 /*
14211 isZtypeEquivalent -
14212 */
14213
14214 static bool isZtypeEquivalent (decl_node type)
14215 {
14216 switch (type->kind)
14217 {
14218 case decl_cardinal:
14219 case decl_longcard:
14220 case decl_shortcard:
14221 case decl_integer:
14222 case decl_longint:
14223 case decl_shortint:
14224 case decl_ztype:
14225 return true;
14226 break;
14227
14228
14229 default:
14230 return false;
14231 break;
14232 }
14233 /* static analysis guarentees a RETURN statement will be used before here. */
14234 __builtin_unreachable ();
14235 }
14236
14237
14238 /*
14239 isEquivalentType - returns TRUE if type1 and type2 are equivalent.
14240 */
14241
14242 static bool isEquivalentType (decl_node type1, decl_node type2)
14243 {
14244 type1 = decl_skipType (type1);
14245 type2 = decl_skipType (type2);
14246 return (type1 == type2) || ((isZtypeEquivalent (type1)) && (isZtypeEquivalent (type2)));
14247 /* static analysis guarentees a RETURN statement will be used before here. */
14248 __builtin_unreachable ();
14249 }
14250
14251
14252 /*
14253 doExprCastC - build a cast if necessary.
14254 */
14255
14256 static void doExprCastC (mcPretty_pretty p, decl_node e, decl_node type)
14257 {
14258 decl_node stype;
14259
14260 stype = decl_skipType (type);
14261 if ((! (isEquivalentType (type, getExprType (e)))) && (! ((e->kind == decl_nil) && ((decl_isPointer (stype)) || (stype->kind == decl_address)))))
14262 {
14263 if (lang == decl_ansiCP)
14264 {
14265 /* avoid gcc warning by using compound statement even if not strictly necessary. */
14266 /* potentially a cast is required. */
14267 if ((decl_isPointer (type)) || (type == addressN))
14268 {
14269 outText (p, (const char *) "reinterpret_cast<", 17);
14270 doTypeNameC (p, type);
14271 mcPretty_noSpace (p);
14272 outText (p, (const char *) "> (", 3);
14273 doExprC (p, e);
14274 outText (p, (const char *) ")", 1);
14275 return ;
14276 }
14277 else
14278 {
14279 outText (p, (const char *) "static_cast<", 12);
14280 if (decl_isProcType (decl_skipType (type)))
14281 {
14282 doTypeNameC (p, type);
14283 outText (p, (const char *) "_t", 2);
14284 }
14285 else
14286 {
14287 doTypeNameC (p, type);
14288 }
14289 mcPretty_noSpace (p);
14290 outText (p, (const char *) "> (", 3);
14291 doExprC (p, e);
14292 outText (p, (const char *) ")", 1);
14293 return ;
14294 }
14295 }
14296 }
14297 doExprC (p, e);
14298 }
14299
14300
14301 /*
14302 requiresUnpackProc - returns TRUE if either the expr is a procedure or the proctypes differ.
14303 */
14304
14305 static bool requiresUnpackProc (decl_node s)
14306 {
14307 mcDebug_assert (isAssignment (s));
14308 return (decl_isProcedure (s->assignmentF.expr)) || ((decl_skipType (decl_getType (s->assignmentF.des))) != (decl_skipType (decl_getType (s->assignmentF.expr))));
14309 /* static analysis guarentees a RETURN statement will be used before here. */
14310 __builtin_unreachable ();
14311 }
14312
14313
14314 /*
14315 doAssignmentC -
14316 */
14317
14318 static void doAssignmentC (mcPretty_pretty p, decl_node s)
14319 {
14320 mcDebug_assert (isAssignment (s));
14321 doCommentC (p, s->assignmentF.assignComment.body);
14322 doExprCup (p, s->assignmentF.des, requiresUnpackProc (s));
14323 mcPretty_setNeedSpace (p);
14324 outText (p, (const char *) "=", 1);
14325 mcPretty_setNeedSpace (p);
14326 doExprCastC (p, s->assignmentF.expr, decl_getType (s->assignmentF.des));
14327 outText (p, (const char *) ";", 1);
14328 doAfterCommentC (p, s->assignmentF.assignComment.after);
14329 }
14330
14331
14332 /*
14333 containsStatement -
14334 */
14335
14336 static bool containsStatement (decl_node s)
14337 {
14338 return ((s != NULL) && (decl_isStatementSequence (s))) && (! (isStatementSequenceEmpty (s)));
14339 /* static analysis guarentees a RETURN statement will be used before here. */
14340 __builtin_unreachable ();
14341 }
14342
14343
14344 /*
14345 doCompoundStmt -
14346 */
14347
14348 static void doCompoundStmt (mcPretty_pretty p, decl_node s)
14349 {
14350 if ((s == NULL) || ((decl_isStatementSequence (s)) && (isStatementSequenceEmpty (s))))
14351 {
14352 p = mcPretty_pushPretty (p);
14353 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14354 outText (p, (const char *) "{} /* empty. */\\n", 19);
14355 p = mcPretty_popPretty (p);
14356 }
14357 else if (((decl_isStatementSequence (s)) && (isSingleStatement (s))) && ! forceCompoundStatement)
14358 {
14359 /* avoid dangling else. */
14360 p = mcPretty_pushPretty (p);
14361 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14362 doStatementSequenceC (p, s);
14363 p = mcPretty_popPretty (p);
14364 }
14365 else
14366 {
14367 /* avoid dangling else. */
14368 p = mcPretty_pushPretty (p);
14369 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14370 outText (p, (const char *) "{\\n", 3);
14371 p = mcPretty_pushPretty (p);
14372 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14373 doStatementSequenceC (p, s);
14374 p = mcPretty_popPretty (p);
14375 outText (p, (const char *) "}\\n", 3);
14376 p = mcPretty_popPretty (p);
14377 }
14378 }
14379
14380
14381 /*
14382 doElsifC -
14383 */
14384
14385 static void doElsifC (mcPretty_pretty p, decl_node s)
14386 {
14387 mcDebug_assert (decl_isElsif (s));
14388 outText (p, (const char *) "else if", 7);
14389 mcPretty_setNeedSpace (p);
14390 outText (p, (const char *) "(", 1);
14391 doExprC (p, s->elsifF.expr);
14392 outText (p, (const char *) ")\\n", 3);
14393 mcDebug_assert ((s->elsifF.else_ == NULL) || (s->elsifF.elsif == NULL));
14394 if (forceCompoundStatement || ((hasIfAndNoElse (s->elsifF.then)) && ((s->elsifF.else_ != NULL) || (s->elsifF.elsif != NULL))))
14395 {
14396 /* avoid dangling else. */
14397 p = mcPretty_pushPretty (p);
14398 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14399 outText (p, (const char *) "{\\n", 3);
14400 p = mcPretty_pushPretty (p);
14401 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14402 outText (p, (const char *) "/* avoid dangling else. */\\n", 29);
14403 doStatementSequenceC (p, s->elsifF.then);
14404 p = mcPretty_popPretty (p);
14405 outText (p, (const char *) "}\\n", 3);
14406 p = mcPretty_popPretty (p);
14407 }
14408 else
14409 {
14410 doCompoundStmt (p, s->elsifF.then);
14411 }
14412 if (containsStatement (s->elsifF.else_))
14413 {
14414 outText (p, (const char *) "else\\n", 6);
14415 if (forceCompoundStatement)
14416 {
14417 /* avoid dangling else. */
14418 p = mcPretty_pushPretty (p);
14419 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14420 outText (p, (const char *) "{\\n", 3);
14421 p = mcPretty_pushPretty (p);
14422 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14423 outText (p, (const char *) "/* avoid dangling else. */\\n", 29);
14424 doStatementSequenceC (p, s->elsifF.else_);
14425 p = mcPretty_popPretty (p);
14426 outText (p, (const char *) "}\\n", 3);
14427 p = mcPretty_popPretty (p);
14428 }
14429 else
14430 {
14431 doCompoundStmt (p, s->elsifF.else_);
14432 }
14433 }
14434 else if ((s->elsifF.elsif != NULL) && (decl_isElsif (s->elsifF.elsif)))
14435 {
14436 /* avoid dangling else. */
14437 doElsifC (p, s->elsifF.elsif);
14438 }
14439 }
14440
14441
14442 /*
14443 noIfElse -
14444 */
14445
14446 static bool noIfElse (decl_node n)
14447 {
14448 return (((n != NULL) && (decl_isIf (n))) && (n->ifF.else_ == NULL)) && (n->ifF.elsif == NULL);
14449 /* static analysis guarentees a RETURN statement will be used before here. */
14450 __builtin_unreachable ();
14451 }
14452
14453
14454 /*
14455 noIfElseChained - returns TRUE if, n, is an IF statement which
14456 has no associated ELSE statement. An IF with an
14457 ELSIF is also checked for no ELSE and will result
14458 in a return value of TRUE.
14459 */
14460
14461 static bool noIfElseChained (decl_node n)
14462 {
14463 decl_node e;
14464
14465 if (n != NULL)
14466 {
14467 /* avoid gcc warning by using compound statement even if not strictly necessary. */
14468 if (decl_isIf (n))
14469 {
14470 if (n->ifF.else_ != NULL)
14471 {
14472 /* we do have an else, continue to check this statement. */
14473 return hasIfAndNoElse (n->ifF.else_);
14474 }
14475 else if (n->ifF.elsif == NULL)
14476 {
14477 /* avoid dangling else. */
14478 /* neither else or elsif. */
14479 return true;
14480 }
14481 else
14482 {
14483 /* avoid dangling else. */
14484 /* test elsif for lack of else. */
14485 e = n->ifF.elsif;
14486 mcDebug_assert (decl_isElsif (e));
14487 return noIfElseChained (e);
14488 }
14489 }
14490 else if (decl_isElsif (n))
14491 {
14492 /* avoid dangling else. */
14493 if (n->elsifF.else_ != NULL)
14494 {
14495 /* we do have an else, continue to check this statement. */
14496 return hasIfAndNoElse (n->elsifF.else_);
14497 }
14498 else if (n->elsifF.elsif == NULL)
14499 {
14500 /* avoid dangling else. */
14501 /* neither else or elsif. */
14502 return true;
14503 }
14504 else
14505 {
14506 /* avoid dangling else. */
14507 /* test elsif for lack of else. */
14508 e = n->elsifF.elsif;
14509 mcDebug_assert (decl_isElsif (e));
14510 return noIfElseChained (e);
14511 }
14512 }
14513 }
14514 return false;
14515 /* static analysis guarentees a RETURN statement will be used before here. */
14516 __builtin_unreachable ();
14517 }
14518
14519
14520 /*
14521 hasIfElse -
14522 */
14523
14524 static bool hasIfElse (decl_node n)
14525 {
14526 if (n != NULL)
14527 {
14528 if (decl_isStatementSequence (n))
14529 {
14530 /* avoid gcc warning by using compound statement even if not strictly necessary. */
14531 if (isStatementSequenceEmpty (n))
14532 {
14533 return false;
14534 }
14535 else if (isSingleStatement (n))
14536 {
14537 /* avoid dangling else. */
14538 n = static_cast<decl_node> (Indexing_GetIndice (n->stmtF.statements, 1));
14539 return isIfElse (n);
14540 }
14541 }
14542 }
14543 return false;
14544 /* static analysis guarentees a RETURN statement will be used before here. */
14545 __builtin_unreachable ();
14546 }
14547
14548
14549 /*
14550 isIfElse -
14551 */
14552
14553 static bool isIfElse (decl_node n)
14554 {
14555 return ((n != NULL) && (decl_isIf (n))) && ((n->ifF.else_ != NULL) || (n->ifF.elsif != NULL));
14556 /* static analysis guarentees a RETURN statement will be used before here. */
14557 __builtin_unreachable ();
14558 }
14559
14560
14561 /*
14562 hasIfAndNoElse - returns TRUE if statement, n, is a single statement
14563 which is an IF and it has no else statement.
14564 */
14565
14566 static bool hasIfAndNoElse (decl_node n)
14567 {
14568 if (n != NULL)
14569 {
14570 /* avoid gcc warning by using compound statement even if not strictly necessary. */
14571 if (decl_isStatementSequence (n))
14572 {
14573 if (isStatementSequenceEmpty (n))
14574 {
14575 return false;
14576 }
14577 else if (isSingleStatement (n))
14578 {
14579 /* avoid dangling else. */
14580 n = static_cast<decl_node> (Indexing_GetIndice (n->stmtF.statements, 1));
14581 return hasIfAndNoElse (n);
14582 }
14583 else
14584 {
14585 /* avoid dangling else. */
14586 n = static_cast<decl_node> (Indexing_GetIndice (n->stmtF.statements, Indexing_HighIndice (n->stmtF.statements)));
14587 return hasIfAndNoElse (n);
14588 }
14589 }
14590 else if ((decl_isElsif (n)) || (decl_isIf (n)))
14591 {
14592 /* avoid dangling else. */
14593 return noIfElseChained (n);
14594 }
14595 }
14596 return false;
14597 /* static analysis guarentees a RETURN statement will be used before here. */
14598 __builtin_unreachable ();
14599 }
14600
14601
14602 /*
14603 doIfC - issue an if statement and also place in an after comment if one exists.
14604 The if statement might contain an else or elsif which are also handled.
14605 */
14606
14607 static void doIfC (mcPretty_pretty p, decl_node s)
14608 {
14609 mcDebug_assert (decl_isIf (s));
14610 doCommentC (p, s->ifF.ifComment.body);
14611 outText (p, (const char *) "if", 2);
14612 mcPretty_setNeedSpace (p);
14613 outText (p, (const char *) "(", 1);
14614 doExprC (p, s->ifF.expr);
14615 outText (p, (const char *) ")", 1);
14616 doAfterCommentC (p, s->ifF.ifComment.after);
14617 if ((hasIfAndNoElse (s->ifF.then)) && ((s->ifF.else_ != NULL) || (s->ifF.elsif != NULL)))
14618 {
14619 /* avoid dangling else. */
14620 p = mcPretty_pushPretty (p);
14621 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14622 outText (p, (const char *) "{\\n", 3);
14623 p = mcPretty_pushPretty (p);
14624 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14625 outText (p, (const char *) "/* avoid dangling else. */\\n", 29);
14626 doStatementSequenceC (p, s->ifF.then);
14627 p = mcPretty_popPretty (p);
14628 outText (p, (const char *) "}\\n", 3);
14629 p = mcPretty_popPretty (p);
14630 }
14631 else if ((noIfElse (s)) && (hasIfElse (s->ifF.then)))
14632 {
14633 /* avoid dangling else. */
14634 /* gcc does not like legal non dangling else, as it is poor style.
14635 So we will avoid getting a warning. */
14636 p = mcPretty_pushPretty (p);
14637 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14638 outText (p, (const char *) "{\\n", 3);
14639 p = mcPretty_pushPretty (p);
14640 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14641 outText (p, (const char *) "/* avoid gcc warning by using compound statement even if not strictly necessary. */\\n", 86);
14642 doStatementSequenceC (p, s->ifF.then);
14643 p = mcPretty_popPretty (p);
14644 outText (p, (const char *) "}\\n", 3);
14645 p = mcPretty_popPretty (p);
14646 }
14647 else
14648 {
14649 /* avoid dangling else. */
14650 doCompoundStmt (p, s->ifF.then);
14651 }
14652 mcDebug_assert ((s->ifF.else_ == NULL) || (s->ifF.elsif == NULL));
14653 if (containsStatement (s->ifF.else_))
14654 {
14655 doCommentC (p, s->ifF.elseComment.body);
14656 outText (p, (const char *) "else", 4);
14657 doAfterCommentC (p, s->ifF.elseComment.after);
14658 doCompoundStmt (p, s->ifF.else_);
14659 }
14660 else if ((s->ifF.elsif != NULL) && (decl_isElsif (s->ifF.elsif)))
14661 {
14662 /* avoid dangling else. */
14663 doCommentC (p, s->ifF.elseComment.body);
14664 doCommentC (p, s->ifF.elseComment.after);
14665 doElsifC (p, s->ifF.elsif);
14666 }
14667 doCommentC (p, s->ifF.endComment.after);
14668 doCommentC (p, s->ifF.endComment.body);
14669 }
14670
14671
14672 /*
14673 doForIncCP -
14674 */
14675
14676 static void doForIncCP (mcPretty_pretty p, decl_node s)
14677 {
14678 decl_node t;
14679
14680 mcDebug_assert (decl_isFor (s));
14681 t = decl_skipType (decl_getType (s->forF.des));
14682 if (decl_isEnumeration (t))
14683 {
14684 if (s->forF.increment == NULL)
14685 {
14686 doExprC (p, s->forF.des);
14687 outText (p, (const char *) "= static_cast<", 14);
14688 doTypeNameC (p, decl_getType (s->forF.des));
14689 mcPretty_noSpace (p);
14690 outText (p, (const char *) ">(static_cast<int>(", 19);
14691 doExprC (p, s->forF.des);
14692 outText (p, (const char *) "+1))", 4);
14693 }
14694 else
14695 {
14696 doExprC (p, s->forF.des);
14697 outText (p, (const char *) "= static_cast<", 14);
14698 doTypeNameC (p, decl_getType (s->forF.des));
14699 mcPretty_noSpace (p);
14700 outText (p, (const char *) ">(static_cast<int>(", 19);
14701 doExprC (p, s->forF.des);
14702 outText (p, (const char *) "+", 1);
14703 doExprC (p, s->forF.increment);
14704 outText (p, (const char *) "))", 2);
14705 }
14706 }
14707 else
14708 {
14709 doForIncC (p, s);
14710 }
14711 }
14712
14713
14714 /*
14715 doForIncC -
14716 */
14717
14718 static void doForIncC (mcPretty_pretty p, decl_node s)
14719 {
14720 if (s->forF.increment == NULL)
14721 {
14722 doExprC (p, s->forF.des);
14723 outText (p, (const char *) "++", 2);
14724 }
14725 else
14726 {
14727 doExprC (p, s->forF.des);
14728 outText (p, (const char *) "=", 1);
14729 doExprC (p, s->forF.des);
14730 outText (p, (const char *) "+", 1);
14731 doExprC (p, s->forF.increment);
14732 }
14733 }
14734
14735
14736 /*
14737 doForInc -
14738 */
14739
14740 static void doForInc (mcPretty_pretty p, decl_node s)
14741 {
14742 if (lang == decl_ansiCP)
14743 {
14744 doForIncCP (p, s);
14745 }
14746 else
14747 {
14748 doForIncC (p, s);
14749 }
14750 }
14751
14752
14753 /*
14754 doForC -
14755 */
14756
14757 static void doForC (mcPretty_pretty p, decl_node s)
14758 {
14759 mcDebug_assert (decl_isFor (s));
14760 outText (p, (const char *) "for (", 5);
14761 doExprC (p, s->forF.des);
14762 outText (p, (const char *) "=", 1);
14763 doExprC (p, s->forF.start);
14764 outText (p, (const char *) ";", 1);
14765 mcPretty_setNeedSpace (p);
14766 doExprC (p, s->forF.des);
14767 outText (p, (const char *) "<=", 2);
14768 doExprC (p, s->forF.end);
14769 outText (p, (const char *) ";", 1);
14770 mcPretty_setNeedSpace (p);
14771 doForInc (p, s);
14772 outText (p, (const char *) ")\\n", 3);
14773 doCompoundStmt (p, s->forF.statements);
14774 }
14775
14776
14777 /*
14778 doRepeatC -
14779 */
14780
14781 static void doRepeatC (mcPretty_pretty p, decl_node s)
14782 {
14783 mcDebug_assert (decl_isRepeat (s));
14784 doCommentC (p, s->repeatF.repeatComment.body);
14785 outText (p, (const char *) "do {", 4);
14786 doAfterCommentC (p, s->repeatF.repeatComment.after);
14787 p = mcPretty_pushPretty (p);
14788 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
14789 doStatementSequenceC (p, s->repeatF.statements);
14790 doCommentC (p, s->repeatF.untilComment.body);
14791 p = mcPretty_popPretty (p);
14792 outText (p, (const char *) "} while (! (", 12);
14793 doExprC (p, s->repeatF.expr);
14794 outText (p, (const char *) "));", 3);
14795 doAfterCommentC (p, s->repeatF.untilComment.after);
14796 }
14797
14798
14799 /*
14800 doWhileC -
14801 */
14802
14803 static void doWhileC (mcPretty_pretty p, decl_node s)
14804 {
14805 mcDebug_assert (decl_isWhile (s));
14806 doCommentC (p, s->whileF.doComment.body);
14807 outText (p, (const char *) "while (", 7);
14808 doExprC (p, s->whileF.expr);
14809 outText (p, (const char *) ")", 1);
14810 doAfterCommentC (p, s->whileF.doComment.after);
14811 doCompoundStmt (p, s->whileF.statements);
14812 doCommentC (p, s->whileF.endComment.body);
14813 doCommentC (p, s->whileF.endComment.after);
14814 }
14815
14816
14817 /*
14818 doFuncHighC -
14819 */
14820
14821 static void doFuncHighC (mcPretty_pretty p, decl_node a)
14822 {
14823 decl_node s;
14824 decl_node n;
14825
14826 if ((decl_isLiteral (a)) && ((decl_getType (a)) == charN))
14827 {
14828 outCard (p, 0);
14829 }
14830 else if (isString (a))
14831 {
14832 /* avoid dangling else. */
14833 outCard (p, a->stringF.length-2);
14834 }
14835 else if ((decl_isConst (a)) && (isString (a->constF.value)))
14836 {
14837 /* avoid dangling else. */
14838 doFuncHighC (p, a->constF.value);
14839 }
14840 else if (decl_isUnbounded (decl_getType (a)))
14841 {
14842 /* avoid dangling else. */
14843 outText (p, (const char *) "_", 1);
14844 outTextN (p, decl_getSymName (a));
14845 outText (p, (const char *) "_high", 5);
14846 }
14847 else if (decl_isArray (decl_skipType (decl_getType (a))))
14848 {
14849 /* avoid dangling else. */
14850 n = decl_skipType (decl_getType (a));
14851 s = n->arrayF.subr;
14852 if (isZero (getMin (s)))
14853 {
14854 doExprC (p, getMax (s));
14855 }
14856 else
14857 {
14858 outText (p, (const char *) "(", 1);
14859 doExprC (p, getMax (s));
14860 doSubtractC (p, getMin (s));
14861 outText (p, (const char *) ")", 1);
14862 }
14863 }
14864 else
14865 {
14866 /* avoid dangling else. */
14867 /* output sizeof (a) in bytes for the high. */
14868 outText (p, (const char *) "(sizeof", 7);
14869 mcPretty_setNeedSpace (p);
14870 outText (p, (const char *) "(", 1);
14871 doExprC (p, a);
14872 outText (p, (const char *) ")-1)", 4);
14873 }
14874 }
14875
14876
14877 /*
14878 doMultiplyBySize -
14879 */
14880
14881 static void doMultiplyBySize (mcPretty_pretty p, decl_node a)
14882 {
14883 if (((a != charN) && (a != byteN)) && (a != locN))
14884 {
14885 mcPretty_setNeedSpace (p);
14886 outText (p, (const char *) "* sizeof (", 10);
14887 doTypeNameC (p, a);
14888 mcPretty_noSpace (p);
14889 outText (p, (const char *) ")", 1);
14890 }
14891 }
14892
14893
14894 /*
14895 doTotype -
14896 */
14897
14898 static void doTotype (mcPretty_pretty p, decl_node a, decl_node t)
14899 {
14900 if ((! (isString (a))) && (! (decl_isLiteral (a))))
14901 {
14902 if (decl_isVar (a))
14903 {
14904 if (((a->varF.isParameter || a->varF.isVarParameter) && (decl_isUnbounded (decl_getType (a)))) && ((decl_skipType (decl_getType (decl_getType (a)))) == (decl_skipType (decl_getType (t)))))
14905 {
14906 /* do not multiply by size as the existing high value is correct. */
14907 return ;
14908 }
14909 a = decl_getType (a);
14910 if (decl_isArray (a))
14911 {
14912 doMultiplyBySize (p, decl_skipType (decl_getType (a)));
14913 }
14914 }
14915 }
14916 if (t == wordN)
14917 {
14918 mcPretty_setNeedSpace (p);
14919 outText (p, (const char *) "/ sizeof (", 10);
14920 doTypeNameC (p, wordN);
14921 mcPretty_noSpace (p);
14922 outText (p, (const char *) ")", 1);
14923 }
14924 }
14925
14926
14927 /*
14928 doFuncUnbounded -
14929 */
14930
14931 static void doFuncUnbounded (mcPretty_pretty p, decl_node actual, decl_node formalParam, decl_node formal, decl_node func)
14932 {
14933 decl_node h;
14934 DynamicStrings_String s;
14935
14936 mcDebug_assert (decl_isUnbounded (formal));
14937 outText (p, (const char *) "(", 1);
14938 if ((lang == decl_ansiCP) && (decl_isParam (formalParam)))
14939 {
14940 outText (p, (const char *) "const", 5);
14941 mcPretty_setNeedSpace (p);
14942 }
14943 doTypeC (p, decl_getType (formal), &formal);
14944 mcPretty_setNeedSpace (p);
14945 outText (p, (const char *) "*)", 2);
14946 mcPretty_setNeedSpace (p);
14947 if ((decl_isLiteral (actual)) && ((decl_getType (actual)) == charN))
14948 {
14949 outText (p, (const char *) "\"\\0", 3);
14950 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (actual->literalF.name));
14951 s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
14952 outTextS (p, s);
14953 outText (p, (const char *) "\"", 1);
14954 s = DynamicStrings_KillString (s);
14955 }
14956 else if (isString (actual))
14957 {
14958 /* avoid dangling else. */
14959 outCstring (p, actual, true);
14960 }
14961 else if (decl_isConst (actual))
14962 {
14963 /* avoid dangling else. */
14964 actual = resolveString (actual);
14965 mcDebug_assert (isString (actual));
14966 outCstring (p, actual, true);
14967 }
14968 else if (isFuncCall (actual))
14969 {
14970 /* avoid dangling else. */
14971 if ((getExprType (actual)) == NULL)
14972 {
14973 mcMetaError_metaError3 ((const char *) "there is no return type to the procedure function {%3ad} which is being passed as the parameter {%1ad} to {%2ad}", 112, (const unsigned char *) &formal, (sizeof (formal)-1), (const unsigned char *) &func, (sizeof (func)-1), (const unsigned char *) &actual, (sizeof (actual)-1));
14974 }
14975 else
14976 {
14977 outText (p, (const char *) "&", 1);
14978 doExprC (p, actual);
14979 }
14980 }
14981 else if (decl_isUnbounded (decl_getType (actual)))
14982 {
14983 /* avoid dangling else. */
14984 /* doExprC (p, actual). */
14985 doFQNameC (p, actual);
14986 }
14987 else
14988 {
14989 /* avoid dangling else. */
14990 outText (p, (const char *) "&", 1);
14991 doExprC (p, actual);
14992 if (decl_isArray (decl_skipType (decl_getType (actual))))
14993 {
14994 outText (p, (const char *) ".array[0]", 9);
14995 }
14996 }
14997 if (! (enableDefForCStrings && (isDefForC (decl_getScope (func)))))
14998 {
14999 outText (p, (const char *) ",", 1);
15000 mcPretty_setNeedSpace (p);
15001 doFuncHighC (p, actual);
15002 doTotype (p, actual, formal);
15003 }
15004 }
15005
15006
15007 /*
15008 doProcedureParamC -
15009 */
15010
15011 static void doProcedureParamC (mcPretty_pretty p, decl_node actual, decl_node formal)
15012 {
15013 if (isForC (formal))
15014 {
15015 outText (p, (const char *) "(", 1);
15016 doFQNameC (p, decl_getType (formal));
15017 outText (p, (const char *) "_C", 2);
15018 outText (p, (const char *) ")", 1);
15019 mcPretty_setNeedSpace (p);
15020 doExprC (p, actual);
15021 }
15022 else
15023 {
15024 outText (p, (const char *) "(", 1);
15025 doTypeNameC (p, decl_getType (formal));
15026 outText (p, (const char *) ")", 1);
15027 mcPretty_setNeedSpace (p);
15028 outText (p, (const char *) "{", 1);
15029 outText (p, (const char *) "(", 1);
15030 doFQNameC (p, decl_getType (formal));
15031 outText (p, (const char *) "_t)", 3);
15032 mcPretty_setNeedSpace (p);
15033 doExprC (p, actual);
15034 outText (p, (const char *) "}", 1);
15035 }
15036 }
15037
15038
15039 /*
15040 doAdrExprC -
15041 */
15042
15043 static void doAdrExprC (mcPretty_pretty p, decl_node n)
15044 {
15045 if (isDeref (n))
15046 {
15047 /* no point in issuing & ( * n ) */
15048 doExprC (p, n->unaryF.arg);
15049 }
15050 else if ((decl_isVar (n)) && n->varF.isVarParameter)
15051 {
15052 /* avoid dangling else. */
15053 /* no point in issuing & ( * n ) */
15054 doFQNameC (p, n);
15055 }
15056 else
15057 {
15058 /* avoid dangling else. */
15059 outText (p, (const char *) "&", 1);
15060 doExprC (p, n);
15061 }
15062 }
15063
15064
15065 /*
15066 typePair -
15067 */
15068
15069 static bool typePair (decl_node a, decl_node b, decl_node x, decl_node y)
15070 {
15071 return ((a == x) && (b == y)) || ((a == y) && (b == x));
15072 /* static analysis guarentees a RETURN statement will be used before here. */
15073 __builtin_unreachable ();
15074 }
15075
15076
15077 /*
15078 needsCast - return TRUE if the actual type parameter needs to be cast to
15079 the formal type.
15080 */
15081
15082 static bool needsCast (decl_node at, decl_node ft)
15083 {
15084 at = decl_skipType (at);
15085 ft = decl_skipType (ft);
15086 if (((((((((((((at == nilN) || (at->kind == decl_nil)) || (at == ft)) || (typePair (at, ft, cardinalN, wordN))) || (typePair (at, ft, cardinalN, ztypeN))) || (typePair (at, ft, integerN, ztypeN))) || (typePair (at, ft, longcardN, ztypeN))) || (typePair (at, ft, shortcardN, ztypeN))) || (typePair (at, ft, longintN, ztypeN))) || (typePair (at, ft, shortintN, ztypeN))) || (typePair (at, ft, realN, rtypeN))) || (typePair (at, ft, longrealN, rtypeN))) || (typePair (at, ft, shortrealN, rtypeN)))
15087 {
15088 return false;
15089 }
15090 else
15091 {
15092 return true;
15093 }
15094 /* static analysis guarentees a RETURN statement will be used before here. */
15095 __builtin_unreachable ();
15096 }
15097
15098
15099 /*
15100 checkSystemCast - checks to see if we are passing to/from
15101 a system generic type (WORD, BYTE, ADDRESS)
15102 and if so emit a cast. It returns the number of
15103 open parenthesis.
15104 */
15105
15106 static unsigned int checkSystemCast (mcPretty_pretty p, decl_node actual, decl_node formal)
15107 {
15108 decl_node at;
15109 decl_node ft;
15110
15111 at = getExprType (actual);
15112 ft = decl_getType (formal);
15113 if (needsCast (at, ft))
15114 {
15115 /* avoid gcc warning by using compound statement even if not strictly necessary. */
15116 if (lang == decl_ansiCP)
15117 {
15118 if ((isString (actual)) && ((decl_skipType (ft)) == addressN))
15119 {
15120 outText (p, (const char *) "const_cast<void*> (reinterpret_cast<const void*> (", 50);
15121 return 2;
15122 }
15123 else if ((decl_isPointer (decl_skipType (ft))) || ((decl_skipType (ft)) == addressN))
15124 {
15125 /* avoid dangling else. */
15126 if (actual == nilN)
15127 {
15128 if (decl_isVarParam (formal))
15129 {
15130 mcMetaError_metaError1 ((const char *) "NIL is being passed to a VAR parameter {%1DMad}", 47, (const unsigned char *) &formal, (sizeof (formal)-1));
15131 }
15132 /* NULL is compatible with pointers/address. */
15133 return 0;
15134 }
15135 else
15136 {
15137 outText (p, (const char *) "reinterpret_cast<", 17);
15138 doTypeNameC (p, ft);
15139 if (decl_isVarParam (formal))
15140 {
15141 outText (p, (const char *) "*", 1);
15142 }
15143 mcPretty_noSpace (p);
15144 outText (p, (const char *) "> (", 3);
15145 }
15146 }
15147 else
15148 {
15149 /* avoid dangling else. */
15150 outText (p, (const char *) "static_cast<", 12);
15151 doTypeNameC (p, ft);
15152 if (decl_isVarParam (formal))
15153 {
15154 outText (p, (const char *) "*", 1);
15155 }
15156 mcPretty_noSpace (p);
15157 outText (p, (const char *) "> (", 3);
15158 }
15159 return 1;
15160 }
15161 else
15162 {
15163 outText (p, (const char *) "(", 1);
15164 doTypeNameC (p, ft);
15165 if (decl_isVarParam (formal))
15166 {
15167 outText (p, (const char *) "*", 1);
15168 }
15169 mcPretty_noSpace (p);
15170 outText (p, (const char *) ")", 1);
15171 mcPretty_setNeedSpace (p);
15172 }
15173 }
15174 return 0;
15175 /* static analysis guarentees a RETURN statement will be used before here. */
15176 __builtin_unreachable ();
15177 }
15178
15179
15180 /*
15181 emitN -
15182 */
15183
15184 static void emitN (mcPretty_pretty p, const char *a_, unsigned int _a_high, unsigned int n)
15185 {
15186 char a[_a_high+1];
15187
15188 /* make a local copy of each unbounded array. */
15189 memcpy (a, a_, _a_high+1);
15190
15191 while (n > 0)
15192 {
15193 outText (p, (const char *) a, _a_high);
15194 n -= 1;
15195 }
15196 }
15197
15198
15199 /*
15200 isForC - return true if node n is a varparam, param or procedure
15201 which was declared inside a definition module for "C".
15202 */
15203
15204 static bool isForC (decl_node n)
15205 {
15206 if (decl_isVarParam (n))
15207 {
15208 return n->varparamF.isForC;
15209 }
15210 else if (decl_isParam (n))
15211 {
15212 /* avoid dangling else. */
15213 return n->paramF.isForC;
15214 }
15215 else if (decl_isProcedure (n))
15216 {
15217 /* avoid dangling else. */
15218 return n->procedureF.isForC;
15219 }
15220 return false;
15221 /* static analysis guarentees a RETURN statement will be used before here. */
15222 __builtin_unreachable ();
15223 }
15224
15225
15226 /*
15227 isDefForCNode - return TRUE if node n was declared inside a definition module for "C".
15228 */
15229
15230 static bool isDefForCNode (decl_node n)
15231 {
15232 nameKey_Name name;
15233
15234 while ((n != NULL) && (! (((decl_isImp (n)) || (decl_isDef (n))) || (decl_isModule (n)))))
15235 {
15236 n = decl_getScope (n);
15237 }
15238 if ((n != NULL) && (decl_isImp (n)))
15239 {
15240 name = decl_getSymName (n);
15241 n = decl_lookupDef (name);
15242 }
15243 return ((n != NULL) && (decl_isDef (n))) && (isDefForC (n));
15244 /* static analysis guarentees a RETURN statement will be used before here. */
15245 __builtin_unreachable ();
15246 }
15247
15248
15249 /*
15250 doFuncParamC -
15251 */
15252
15253 static void doFuncParamC (mcPretty_pretty p, decl_node actual, decl_node formal, decl_node func)
15254 {
15255 decl_node ft;
15256 decl_node at;
15257 unsigned int lbr;
15258
15259 if (formal == NULL)
15260 {
15261 doExprC (p, actual);
15262 }
15263 else
15264 {
15265 ft = decl_skipType (decl_getType (formal));
15266 if (decl_isUnbounded (ft))
15267 {
15268 doFuncUnbounded (p, actual, formal, ft, func);
15269 }
15270 else
15271 {
15272 if ((isAProcType (ft)) && (decl_isProcedure (actual)))
15273 {
15274 if (decl_isVarParam (formal))
15275 {
15276 mcMetaError_metaError1 ((const char *) "{%1MDad} cannot be passed as a VAR parameter", 44, (const unsigned char *) &actual, (sizeof (actual)-1));
15277 }
15278 else
15279 {
15280 doProcedureParamC (p, actual, formal);
15281 }
15282 }
15283 else if (((((decl_getType (actual)) != NULL) && (decl_isProcType (decl_skipType (decl_getType (actual))))) && (isAProcType (ft))) && (isForC (formal)))
15284 {
15285 /* avoid dangling else. */
15286 if (decl_isVarParam (formal))
15287 {
15288 mcMetaError_metaError2 ((const char *) "{%1MDad} cannot be passed as a VAR parameter to the definition for C module as the parameter requires a cast to the formal type {%2MDtad}", 137, (const unsigned char *) &actual, (sizeof (actual)-1), (const unsigned char *) &formal, (sizeof (formal)-1));
15289 }
15290 else
15291 {
15292 outText (p, (const char *) "(", 1);
15293 doFQNameC (p, decl_getType (formal));
15294 outText (p, (const char *) "_C", 2);
15295 outText (p, (const char *) ")", 1);
15296 mcPretty_setNeedSpace (p);
15297 doExprC (p, actual);
15298 outText (p, (const char *) ".proc", 5);
15299 }
15300 }
15301 else if ((((decl_getType (actual)) != NULL) && (decl_isProcType (decl_skipType (decl_getType (actual))))) && ((decl_getType (actual)) != (decl_getType (formal))))
15302 {
15303 /* avoid dangling else. */
15304 if (decl_isVarParam (formal))
15305 {
15306 mcMetaError_metaError2 ((const char *) "{%1MDad} cannot be passed as a VAR parameter as the parameter requires a cast to the formal type {%2MDtad}", 106, (const unsigned char *) &actual, (sizeof (actual)-1), (const unsigned char *) &formal, (sizeof (formal)-1));
15307 }
15308 else
15309 {
15310 doCastC (p, decl_getType (formal), actual);
15311 }
15312 }
15313 else
15314 {
15315 /* avoid dangling else. */
15316 lbr = checkSystemCast (p, actual, formal);
15317 if (decl_isVarParam (formal))
15318 {
15319 doAdrExprC (p, actual);
15320 }
15321 else
15322 {
15323 doExprC (p, actual);
15324 }
15325 emitN (p, (const char *) ")", 1, lbr);
15326 }
15327 }
15328 }
15329 }
15330
15331
15332 /*
15333 getNthParamType - return the type of parameter, i, in list, l.
15334 If the parameter is a vararg NIL is returned.
15335 */
15336
15337 static decl_node getNthParamType (Indexing_Index l, unsigned int i)
15338 {
15339 decl_node p;
15340
15341 p = getNthParam (l, i);
15342 if (p != NULL)
15343 {
15344 return decl_getType (p);
15345 }
15346 return NULL;
15347 /* static analysis guarentees a RETURN statement will be used before here. */
15348 __builtin_unreachable ();
15349 }
15350
15351
15352 /*
15353 getNthParam - return the parameter, i, in list, l.
15354 If the parameter is a vararg NIL is returned.
15355 */
15356
15357 static decl_node getNthParam (Indexing_Index l, unsigned int i)
15358 {
15359 decl_node p;
15360 unsigned int j;
15361 unsigned int k;
15362 unsigned int h;
15363
15364 if (l != NULL)
15365 {
15366 j = Indexing_LowIndice (l);
15367 h = Indexing_HighIndice (l);
15368 while (j <= h)
15369 {
15370 p = static_cast<decl_node> (Indexing_GetIndice (l, j));
15371 if (decl_isParam (p))
15372 {
15373 k = identListLen (p->paramF.namelist);
15374 }
15375 else if (decl_isVarParam (p))
15376 {
15377 /* avoid dangling else. */
15378 k = identListLen (p->varparamF.namelist);
15379 }
15380 else
15381 {
15382 /* avoid dangling else. */
15383 mcDebug_assert (decl_isVarargs (p));
15384 return NULL;
15385 }
15386 if (i <= k)
15387 {
15388 return p;
15389 }
15390 else
15391 {
15392 i -= k;
15393 j += 1;
15394 }
15395 }
15396 }
15397 return NULL;
15398 /* static analysis guarentees a RETURN statement will be used before here. */
15399 __builtin_unreachable ();
15400 }
15401
15402
15403 /*
15404 doFuncArgsC -
15405 */
15406
15407 static void doFuncArgsC (mcPretty_pretty p, decl_node s, Indexing_Index l, bool needParen)
15408 {
15409 decl_node actual;
15410 decl_node formal;
15411 unsigned int i;
15412 unsigned int n;
15413
15414 if (needParen)
15415 {
15416 outText (p, (const char *) "(", 1);
15417 }
15418 if (s->funccallF.args != NULL)
15419 {
15420 i = 1;
15421 n = expListLen (s->funccallF.args);
15422 while (i <= n)
15423 {
15424 actual = getExpList (s->funccallF.args, i);
15425 formal = getNthParam (l, i);
15426 doFuncParamC (p, actual, formal, s->funccallF.function);
15427 if (i < n)
15428 {
15429 outText (p, (const char *) ",", 1);
15430 mcPretty_setNeedSpace (p);
15431 }
15432 i += 1;
15433 }
15434 }
15435 if (needParen)
15436 {
15437 mcPretty_noSpace (p);
15438 outText (p, (const char *) ")", 1);
15439 }
15440 }
15441
15442
15443 /*
15444 doProcTypeArgsC -
15445 */
15446
15447 static void doProcTypeArgsC (mcPretty_pretty p, decl_node s, Indexing_Index args, bool needParen)
15448 {
15449 decl_node a;
15450 decl_node b;
15451 unsigned int i;
15452 unsigned int n;
15453
15454 if (needParen)
15455 {
15456 outText (p, (const char *) "(", 1);
15457 }
15458 if (s->funccallF.args != NULL)
15459 {
15460 i = 1;
15461 n = expListLen (s->funccallF.args);
15462 while (i <= n)
15463 {
15464 a = getExpList (s->funccallF.args, i);
15465 b = static_cast<decl_node> (Indexing_GetIndice (args, i));
15466 doFuncParamC (p, a, b, s->funccallF.function);
15467 if (i < n)
15468 {
15469 outText (p, (const char *) ",", 1);
15470 mcPretty_setNeedSpace (p);
15471 }
15472 i += 1;
15473 }
15474 }
15475 if (needParen)
15476 {
15477 mcPretty_noSpace (p);
15478 outText (p, (const char *) ")", 1);
15479 }
15480 }
15481
15482
15483 /*
15484 doAdrArgC -
15485 */
15486
15487 static void doAdrArgC (mcPretty_pretty p, decl_node n)
15488 {
15489 if (isDeref (n))
15490 {
15491 /* & and * cancel each other out. */
15492 doExprC (p, n->unaryF.arg);
15493 }
15494 else if ((decl_isVar (n)) && n->varF.isVarParameter)
15495 {
15496 /* avoid dangling else. */
15497 outTextN (p, decl_getSymName (n)); /* --fixme-- does the caller need to cast it? */
15498 }
15499 else
15500 {
15501 /* avoid dangling else. */
15502 if (isString (n))
15503 {
15504 if (lang == decl_ansiCP)
15505 {
15506 outText (p, (const char *) "const_cast<void*> (reinterpret_cast<const void*>", 48);
15507 outText (p, (const char *) "(", 1);
15508 doExprC (p, n);
15509 outText (p, (const char *) "))", 2);
15510 }
15511 else
15512 {
15513 doExprC (p, n);
15514 }
15515 }
15516 else
15517 {
15518 outText (p, (const char *) "&", 1);
15519 doExprC (p, n);
15520 }
15521 }
15522 }
15523
15524
15525 /*
15526 doAdrC -
15527 */
15528
15529 static void doAdrC (mcPretty_pretty p, decl_node n)
15530 {
15531 mcDebug_assert (isUnary (n));
15532 doAdrArgC (p, n->unaryF.arg);
15533 }
15534
15535
15536 /*
15537 doInc -
15538 */
15539
15540 static void doInc (mcPretty_pretty p, decl_node n)
15541 {
15542 mcDebug_assert (isIntrinsic (n));
15543 if (lang == decl_ansiCP)
15544 {
15545 doIncDecCP (p, n, (const char *) "+", 1);
15546 }
15547 else
15548 {
15549 doIncDecC (p, n, (const char *) "+=", 2);
15550 }
15551 }
15552
15553
15554 /*
15555 doDec -
15556 */
15557
15558 static void doDec (mcPretty_pretty p, decl_node n)
15559 {
15560 mcDebug_assert (isIntrinsic (n));
15561 if (lang == decl_ansiCP)
15562 {
15563 doIncDecCP (p, n, (const char *) "-", 1);
15564 }
15565 else
15566 {
15567 doIncDecC (p, n, (const char *) "-=", 2);
15568 }
15569 }
15570
15571
15572 /*
15573 doIncDecC -
15574 */
15575
15576 static void doIncDecC (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high)
15577 {
15578 char op[_op_high+1];
15579
15580 /* make a local copy of each unbounded array. */
15581 memcpy (op, op_, _op_high+1);
15582
15583 mcDebug_assert (isIntrinsic (n));
15584 if (n->intrinsicF.args != NULL)
15585 {
15586 doExprC (p, getExpList (n->intrinsicF.args, 1));
15587 mcPretty_setNeedSpace (p);
15588 outText (p, (const char *) op, _op_high);
15589 mcPretty_setNeedSpace (p);
15590 if ((expListLen (n->intrinsicF.args)) == 1)
15591 {
15592 outText (p, (const char *) "1", 1);
15593 }
15594 else
15595 {
15596 doExprC (p, getExpList (n->intrinsicF.args, 2));
15597 }
15598 }
15599 }
15600
15601
15602 /*
15603 doIncDecCP -
15604 */
15605
15606 static void doIncDecCP (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high)
15607 {
15608 decl_node lhs;
15609 decl_node type;
15610 char op[_op_high+1];
15611
15612 /* make a local copy of each unbounded array. */
15613 memcpy (op, op_, _op_high+1);
15614
15615 mcDebug_assert (isIntrinsic (n));
15616 if (n->intrinsicF.args != NULL)
15617 {
15618 lhs = getExpList (n->intrinsicF.args, 1);
15619 doExprC (p, lhs);
15620 mcPretty_setNeedSpace (p);
15621 type = decl_getType (lhs);
15622 if ((decl_isPointer (type)) || (type == addressN))
15623 {
15624 /* cast to (char * ) and then back again after the arithmetic is complete. */
15625 outText (p, (const char *) "=", 1);
15626 mcPretty_setNeedSpace (p);
15627 outText (p, (const char *) "reinterpret_cast<", 17);
15628 doTypeNameC (p, type);
15629 mcPretty_noSpace (p);
15630 outText (p, (const char *) "> (reinterpret_cast<char *> (", 29);
15631 doExprC (p, lhs);
15632 mcPretty_noSpace (p);
15633 outText (p, (const char *) ")", 1);
15634 outText (p, (const char *) op, _op_high);
15635 if ((expListLen (n->intrinsicF.args)) == 1)
15636 {
15637 outText (p, (const char *) "1", 1);
15638 }
15639 else
15640 {
15641 doExprC (p, getExpList (n->intrinsicF.args, 2));
15642 }
15643 outText (p, (const char *) ")", 1);
15644 }
15645 else if (decl_isEnumeration (decl_skipType (type)))
15646 {
15647 /* avoid dangling else. */
15648 outText (p, (const char *) "= static_cast<", 14);
15649 doTypeNameC (p, type);
15650 mcPretty_noSpace (p);
15651 outText (p, (const char *) ">(static_cast<int>(", 19);
15652 doExprC (p, lhs);
15653 outText (p, (const char *) ")", 1);
15654 outText (p, (const char *) op, _op_high);
15655 if ((expListLen (n->intrinsicF.args)) == 1)
15656 {
15657 outText (p, (const char *) "1", 1);
15658 }
15659 else
15660 {
15661 doExprC (p, getExpList (n->intrinsicF.args, 2));
15662 }
15663 outText (p, (const char *) ")", 1);
15664 }
15665 else
15666 {
15667 /* avoid dangling else. */
15668 outText (p, (const char *) op, _op_high);
15669 outText (p, (const char *) "=", 1);
15670 mcPretty_setNeedSpace (p);
15671 if ((expListLen (n->intrinsicF.args)) == 1)
15672 {
15673 outText (p, (const char *) "1", 1);
15674 }
15675 else
15676 {
15677 doExprC (p, getExpList (n->intrinsicF.args, 2));
15678 }
15679 }
15680 }
15681 }
15682
15683
15684 /*
15685 doInclC -
15686 */
15687
15688 static void doInclC (mcPretty_pretty p, decl_node n)
15689 {
15690 decl_node lo;
15691
15692 mcDebug_assert (isIntrinsic (n));
15693 if (n->intrinsicF.args != NULL)
15694 {
15695 /* avoid gcc warning by using compound statement even if not strictly necessary. */
15696 if ((expListLen (n->intrinsicF.args)) == 2)
15697 {
15698 doExprC (p, getExpList (n->intrinsicF.args, 1));
15699 lo = getSetLow (getExpList (n->intrinsicF.args, 1));
15700 mcPretty_setNeedSpace (p);
15701 outText (p, (const char *) "|=", 2);
15702 mcPretty_setNeedSpace (p);
15703 outText (p, (const char *) "(1", 2);
15704 mcPretty_setNeedSpace (p);
15705 outText (p, (const char *) "<<", 2);
15706 mcPretty_setNeedSpace (p);
15707 outText (p, (const char *) "(", 1);
15708 doExprC (p, getExpList (n->intrinsicF.args, 2));
15709 doSubtractC (p, lo);
15710 mcPretty_setNeedSpace (p);
15711 outText (p, (const char *) "))", 2);
15712 }
15713 else
15714 {
15715 M2RTS_HALT (-1); /* metaError0 ('expecting two parameters to INCL') */
15716 __builtin_unreachable ();
15717 }
15718 }
15719 }
15720
15721
15722 /*
15723 doExclC -
15724 */
15725
15726 static void doExclC (mcPretty_pretty p, decl_node n)
15727 {
15728 decl_node lo;
15729
15730 mcDebug_assert (isIntrinsic (n));
15731 if (n->intrinsicF.args != NULL)
15732 {
15733 /* avoid gcc warning by using compound statement even if not strictly necessary. */
15734 if ((expListLen (n->intrinsicF.args)) == 2)
15735 {
15736 doExprC (p, getExpList (n->intrinsicF.args, 1));
15737 lo = getSetLow (getExpList (n->intrinsicF.args, 1));
15738 mcPretty_setNeedSpace (p);
15739 outText (p, (const char *) "&=", 2);
15740 mcPretty_setNeedSpace (p);
15741 outText (p, (const char *) "(~(1", 4);
15742 mcPretty_setNeedSpace (p);
15743 outText (p, (const char *) "<<", 2);
15744 mcPretty_setNeedSpace (p);
15745 outText (p, (const char *) "(", 1);
15746 doExprC (p, getExpList (n->intrinsicF.args, 2));
15747 doSubtractC (p, lo);
15748 mcPretty_setNeedSpace (p);
15749 outText (p, (const char *) ")))", 3);
15750 }
15751 else
15752 {
15753 M2RTS_HALT (-1); /* metaError0 ('expecting two parameters to EXCL') */
15754 __builtin_unreachable ();
15755 }
15756 }
15757 }
15758
15759
15760 /*
15761 doNewC -
15762 */
15763
15764 static void doNewC (mcPretty_pretty p, decl_node n)
15765 {
15766 decl_node t;
15767
15768 mcDebug_assert (isIntrinsic (n));
15769 if (n->intrinsicF.args == NULL)
15770 {
15771 M2RTS_HALT (-1);
15772 __builtin_unreachable ();
15773 }
15774 else
15775 {
15776 if ((expListLen (n->intrinsicF.args)) == 1)
15777 {
15778 keyc_useStorage ();
15779 outText (p, (const char *) "Storage_ALLOCATE", 16);
15780 mcPretty_setNeedSpace (p);
15781 outText (p, (const char *) "((void **)", 10);
15782 mcPretty_setNeedSpace (p);
15783 outText (p, (const char *) "&", 1);
15784 doExprC (p, getExpList (n->intrinsicF.args, 1));
15785 outText (p, (const char *) ",", 1);
15786 mcPretty_setNeedSpace (p);
15787 t = decl_skipType (decl_getType (getExpList (n->intrinsicF.args, 1)));
15788 if (decl_isPointer (t))
15789 {
15790 t = decl_getType (t);
15791 outText (p, (const char *) "sizeof", 6);
15792 mcPretty_setNeedSpace (p);
15793 outText (p, (const char *) "(", 1);
15794 doTypeNameC (p, t);
15795 mcPretty_noSpace (p);
15796 outText (p, (const char *) "))", 2);
15797 }
15798 else
15799 {
15800 mcMetaError_metaError1 ((const char *) "expecting a pointer type variable as the argument to NEW, rather than {%1ad}", 76, (const unsigned char *) &t, (sizeof (t)-1));
15801 }
15802 }
15803 }
15804 }
15805
15806
15807 /*
15808 doDisposeC -
15809 */
15810
15811 static void doDisposeC (mcPretty_pretty p, decl_node n)
15812 {
15813 decl_node t;
15814
15815 mcDebug_assert (isIntrinsic (n));
15816 if (n->intrinsicF.args == NULL)
15817 {
15818 M2RTS_HALT (-1);
15819 __builtin_unreachable ();
15820 }
15821 else
15822 {
15823 if ((expListLen (n->intrinsicF.args)) == 1)
15824 {
15825 keyc_useStorage ();
15826 outText (p, (const char *) "Storage_DEALLOCATE", 18);
15827 mcPretty_setNeedSpace (p);
15828 outText (p, (const char *) "((void **)", 10);
15829 mcPretty_setNeedSpace (p);
15830 outText (p, (const char *) "&", 1);
15831 doExprC (p, getExpList (n->intrinsicF.args, 1));
15832 outText (p, (const char *) ",", 1);
15833 mcPretty_setNeedSpace (p);
15834 t = decl_skipType (decl_getType (getExpList (n->intrinsicF.args, 1)));
15835 if (decl_isPointer (t))
15836 {
15837 t = decl_getType (t);
15838 outText (p, (const char *) "sizeof", 6);
15839 mcPretty_setNeedSpace (p);
15840 outText (p, (const char *) "(", 1);
15841 doTypeNameC (p, t);
15842 mcPretty_noSpace (p);
15843 outText (p, (const char *) "))", 2);
15844 }
15845 else
15846 {
15847 mcMetaError_metaError1 ((const char *) "expecting a pointer type variable as the argument to DISPOSE, rather than {%1ad}", 80, (const unsigned char *) &t, (sizeof (t)-1));
15848 }
15849 }
15850 else
15851 {
15852 M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to DISPOSE') */
15853 __builtin_unreachable ();
15854 }
15855 }
15856 }
15857
15858
15859 /*
15860 doCapC -
15861 */
15862
15863 static void doCapC (mcPretty_pretty p, decl_node n)
15864 {
15865 mcDebug_assert (isUnary (n));
15866 if (n->unaryF.arg == NULL)
15867 {
15868 M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to CAP') */
15869 __builtin_unreachable ();
15870 }
15871 else
15872 {
15873 keyc_useCtype ();
15874 if (mcOptions_getGccConfigSystem ())
15875 {
15876 outText (p, (const char *) "TOUPPER", 7);
15877 }
15878 else
15879 {
15880 outText (p, (const char *) "toupper", 7);
15881 }
15882 mcPretty_setNeedSpace (p);
15883 outText (p, (const char *) "(", 1);
15884 doExprC (p, n->unaryF.arg);
15885 outText (p, (const char *) ")", 1);
15886 }
15887 }
15888
15889
15890 /*
15891 doLengthC -
15892 */
15893
15894 static void doLengthC (mcPretty_pretty p, decl_node n)
15895 {
15896 mcDebug_assert (isUnary (n));
15897 if (n->unaryF.arg == NULL)
15898 {
15899 M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to LENGTH') */
15900 __builtin_unreachable ();
15901 }
15902 else
15903 {
15904 keyc_useM2RTS ();
15905 outText (p, (const char *) "M2RTS_Length", 12);
15906 mcPretty_setNeedSpace (p);
15907 outText (p, (const char *) "(", 1);
15908 doExprC (p, n->unaryF.arg);
15909 outText (p, (const char *) ",", 1);
15910 mcPretty_setNeedSpace (p);
15911 doFuncHighC (p, n->unaryF.arg);
15912 outText (p, (const char *) ")", 1);
15913 }
15914 }
15915
15916
15917 /*
15918 doAbsC -
15919 */
15920
15921 static void doAbsC (mcPretty_pretty p, decl_node n)
15922 {
15923 decl_node t;
15924
15925 mcDebug_assert (isUnary (n));
15926 if (n->unaryF.arg == NULL)
15927 {
15928 M2RTS_HALT (-1);
15929 __builtin_unreachable ();
15930 }
15931 else
15932 {
15933 t = getExprType (n);
15934 }
15935 if (t == longintN)
15936 {
15937 keyc_useLabs ();
15938 outText (p, (const char *) "labs", 4);
15939 }
15940 else if (t == integerN)
15941 {
15942 /* avoid dangling else. */
15943 keyc_useAbs ();
15944 outText (p, (const char *) "abs", 3);
15945 }
15946 else if (t == realN)
15947 {
15948 /* avoid dangling else. */
15949 keyc_useFabs ();
15950 outText (p, (const char *) "fabs", 4);
15951 }
15952 else if (t == longrealN)
15953 {
15954 /* avoid dangling else. */
15955 keyc_useFabsl ();
15956 outText (p, (const char *) "fabsl", 5);
15957 }
15958 else if (t == cardinalN)
15959 {
15960 /* avoid dangling else. */
15961 }
15962 else
15963 {
15964 /* avoid dangling else. */
15965 /* do nothing. */
15966 M2RTS_HALT (-1);
15967 __builtin_unreachable ();
15968 }
15969 mcPretty_setNeedSpace (p);
15970 outText (p, (const char *) "(", 1);
15971 doExprC (p, n->unaryF.arg);
15972 outText (p, (const char *) ")", 1);
15973 }
15974
15975
15976 /*
15977 doValC -
15978 */
15979
15980 static void doValC (mcPretty_pretty p, decl_node n)
15981 {
15982 mcDebug_assert (isBinary (n));
15983 outText (p, (const char *) "(", 1);
15984 doTypeNameC (p, n->binaryF.left);
15985 outText (p, (const char *) ")", 1);
15986 mcPretty_setNeedSpace (p);
15987 outText (p, (const char *) "(", 1);
15988 doExprC (p, n->binaryF.right);
15989 outText (p, (const char *) ")", 1);
15990 }
15991
15992
15993 /*
15994 doMinC -
15995 */
15996
15997 static void doMinC (mcPretty_pretty p, decl_node n)
15998 {
15999 decl_node t;
16000
16001 mcDebug_assert (isUnary (n));
16002 t = getExprType (n->unaryF.arg);
16003 doExprC (p, getMin (t));
16004 }
16005
16006
16007 /*
16008 doMaxC -
16009 */
16010
16011 static void doMaxC (mcPretty_pretty p, decl_node n)
16012 {
16013 decl_node t;
16014
16015 mcDebug_assert (isUnary (n));
16016 t = getExprType (n->unaryF.arg);
16017 doExprC (p, getMax (t));
16018 }
16019
16020
16021 /*
16022 isIntrinsic - returns if, n, is an intrinsic procedure.
16023 The intrinsic functions are represented as unary and binary nodes.
16024 */
16025
16026 static bool isIntrinsic (decl_node n)
16027 {
16028 switch (n->kind)
16029 {
16030 case decl_unreachable:
16031 case decl_throw:
16032 case decl_inc:
16033 case decl_dec:
16034 case decl_incl:
16035 case decl_excl:
16036 case decl_new:
16037 case decl_dispose:
16038 case decl_halt:
16039 return true;
16040 break;
16041
16042
16043 default:
16044 return false;
16045 break;
16046 }
16047 /* static analysis guarentees a RETURN statement will be used before here. */
16048 __builtin_unreachable ();
16049 }
16050
16051
16052 /*
16053 doHalt -
16054 */
16055
16056 static void doHalt (mcPretty_pretty p, decl_node n)
16057 {
16058 mcDebug_assert (n->kind == decl_halt);
16059 if ((n->intrinsicF.args == NULL) || ((expListLen (n->intrinsicF.args)) == 0))
16060 {
16061 outText (p, (const char *) "M2RTS_HALT", 10);
16062 mcPretty_setNeedSpace (p);
16063 outText (p, (const char *) "(-1)", 4);
16064 }
16065 else if ((expListLen (n->intrinsicF.args)) == 1)
16066 {
16067 /* avoid dangling else. */
16068 outText (p, (const char *) "M2RTS_HALT", 10);
16069 mcPretty_setNeedSpace (p);
16070 outText (p, (const char *) "(", 1);
16071 doExprC (p, getExpList (n->intrinsicF.args, 1));
16072 outText (p, (const char *) ")", 1);
16073 }
16074 }
16075
16076
16077 /*
16078 doCreal - emit the appropriate creal function.
16079 */
16080
16081 static void doCreal (mcPretty_pretty p, decl_node t)
16082 {
16083 switch (t->kind)
16084 {
16085 case decl_complex:
16086 keyc_useComplex ();
16087 outText (p, (const char *) "creal", 5);
16088 break;
16089
16090 case decl_longcomplex:
16091 keyc_useComplex ();
16092 outText (p, (const char *) "creall", 6);
16093 break;
16094
16095 case decl_shortcomplex:
16096 keyc_useComplex ();
16097 outText (p, (const char *) "crealf", 6);
16098 break;
16099
16100
16101 default:
16102 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
16103 __builtin_unreachable ();
16104 }
16105 }
16106
16107
16108 /*
16109 doCimag - emit the appropriate cimag function.
16110 */
16111
16112 static void doCimag (mcPretty_pretty p, decl_node t)
16113 {
16114 switch (t->kind)
16115 {
16116 case decl_complex:
16117 keyc_useComplex ();
16118 outText (p, (const char *) "cimag", 5);
16119 break;
16120
16121 case decl_longcomplex:
16122 keyc_useComplex ();
16123 outText (p, (const char *) "cimagl", 6);
16124 break;
16125
16126 case decl_shortcomplex:
16127 keyc_useComplex ();
16128 outText (p, (const char *) "cimagf", 6);
16129 break;
16130
16131
16132 default:
16133 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
16134 __builtin_unreachable ();
16135 }
16136 }
16137
16138
16139 /*
16140 doReC -
16141 */
16142
16143 static void doReC (mcPretty_pretty p, decl_node n)
16144 {
16145 decl_node t;
16146
16147 mcDebug_assert (n->kind == decl_re);
16148 if (n->unaryF.arg != NULL)
16149 {
16150 t = getExprType (n->unaryF.arg);
16151 }
16152 else
16153 {
16154 M2RTS_HALT (-1);
16155 __builtin_unreachable ();
16156 }
16157 doCreal (p, t);
16158 mcPretty_setNeedSpace (p);
16159 outText (p, (const char *) "(", 1);
16160 doExprC (p, n->unaryF.arg);
16161 outText (p, (const char *) ")", 1);
16162 }
16163
16164
16165 /*
16166 doImC -
16167 */
16168
16169 static void doImC (mcPretty_pretty p, decl_node n)
16170 {
16171 decl_node t;
16172
16173 mcDebug_assert (n->kind == decl_im);
16174 if (n->unaryF.arg != NULL)
16175 {
16176 t = getExprType (n->unaryF.arg);
16177 }
16178 else
16179 {
16180 M2RTS_HALT (-1);
16181 __builtin_unreachable ();
16182 }
16183 doCimag (p, t);
16184 mcPretty_setNeedSpace (p);
16185 outText (p, (const char *) "(", 1);
16186 doExprC (p, n->unaryF.arg);
16187 outText (p, (const char *) ")", 1);
16188 }
16189
16190
16191 /*
16192 doCmplx -
16193 */
16194
16195 static void doCmplx (mcPretty_pretty p, decl_node n)
16196 {
16197 mcDebug_assert (isBinary (n));
16198 keyc_useComplex ();
16199 mcPretty_setNeedSpace (p);
16200 outText (p, (const char *) "(", 1);
16201 doExprC (p, n->binaryF.left);
16202 outText (p, (const char *) ")", 1);
16203 mcPretty_setNeedSpace (p);
16204 outText (p, (const char *) "+", 1);
16205 mcPretty_setNeedSpace (p);
16206 outText (p, (const char *) "(", 1);
16207 doExprC (p, n->binaryF.right);
16208 mcPretty_setNeedSpace (p);
16209 outText (p, (const char *) "*", 1);
16210 mcPretty_setNeedSpace (p);
16211 outText (p, (const char *) "I", 1);
16212 outText (p, (const char *) ")", 1);
16213 }
16214
16215
16216 /*
16217 doIntrinsicC -
16218 */
16219
16220 static void doIntrinsicC (mcPretty_pretty p, decl_node n)
16221 {
16222 mcDebug_assert (isIntrinsic (n));
16223 doCommentC (p, n->intrinsicF.intrinsicComment.body);
16224 switch (n->kind)
16225 {
16226 case decl_unreachable:
16227 doUnreachableC (p, n);
16228 break;
16229
16230 case decl_throw:
16231 doThrowC (p, n);
16232 break;
16233
16234 case decl_halt:
16235 doHalt (p, n);
16236 break;
16237
16238 case decl_inc:
16239 doInc (p, n);
16240 break;
16241
16242 case decl_dec:
16243 doDec (p, n);
16244 break;
16245
16246 case decl_incl:
16247 doInclC (p, n);
16248 break;
16249
16250 case decl_excl:
16251 doExclC (p, n);
16252 break;
16253
16254 case decl_new:
16255 doNewC (p, n);
16256 break;
16257
16258 case decl_dispose:
16259 doDisposeC (p, n);
16260 break;
16261
16262
16263 default:
16264 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
16265 __builtin_unreachable ();
16266 }
16267 outText (p, (const char *) ";", 1);
16268 doAfterCommentC (p, n->intrinsicF.intrinsicComment.after);
16269 }
16270
16271
16272 /*
16273 isIntrinsicFunction - returns true if, n, is an instrinsic function.
16274 */
16275
16276 static bool isIntrinsicFunction (decl_node n)
16277 {
16278 switch (n->kind)
16279 {
16280 case decl_val:
16281 case decl_adr:
16282 case decl_size:
16283 case decl_tsize:
16284 case decl_float:
16285 case decl_trunc:
16286 case decl_ord:
16287 case decl_chr:
16288 case decl_cap:
16289 case decl_abs:
16290 case decl_high:
16291 case decl_length:
16292 case decl_min:
16293 case decl_max:
16294 case decl_re:
16295 case decl_im:
16296 case decl_cmplx:
16297 return true;
16298 break;
16299
16300
16301 default:
16302 return false;
16303 break;
16304 }
16305 /* static analysis guarentees a RETURN statement will be used before here. */
16306 __builtin_unreachable ();
16307 }
16308
16309
16310 /*
16311 doSizeC -
16312 */
16313
16314 static void doSizeC (mcPretty_pretty p, decl_node n)
16315 {
16316 mcDebug_assert (isUnary (n));
16317 outText (p, (const char *) "sizeof (", 8);
16318 doExprC (p, n->unaryF.arg);
16319 outText (p, (const char *) ")", 1);
16320 }
16321
16322
16323 /*
16324 doConvertC -
16325 */
16326
16327 static void doConvertC (mcPretty_pretty p, decl_node n, const char *conversion_, unsigned int _conversion_high)
16328 {
16329 DynamicStrings_String s;
16330 char conversion[_conversion_high+1];
16331
16332 /* make a local copy of each unbounded array. */
16333 memcpy (conversion, conversion_, _conversion_high+1);
16334
16335 s = DynamicStrings_InitString ((const char *) conversion, _conversion_high);
16336 doConvertSC (p, n, s);
16337 s = DynamicStrings_KillString (s);
16338 }
16339
16340
16341 /*
16342 doConvertSC -
16343 */
16344
16345 static void doConvertSC (mcPretty_pretty p, decl_node n, DynamicStrings_String conversion)
16346 {
16347 mcDebug_assert (isUnary (n));
16348 mcPretty_setNeedSpace (p);
16349 outText (p, (const char *) "((", 2);
16350 outTextS (p, conversion);
16351 outText (p, (const char *) ")", 1);
16352 mcPretty_setNeedSpace (p);
16353 outText (p, (const char *) "(", 1);
16354 doExprC (p, n->unaryF.arg);
16355 outText (p, (const char *) "))", 2);
16356 }
16357
16358
16359 /*
16360 getFuncFromExpr -
16361 */
16362
16363 static decl_node getFuncFromExpr (decl_node n)
16364 {
16365 n = decl_skipType (decl_getType (n));
16366 while ((n != procN) && (! (decl_isProcType (n))))
16367 {
16368 n = decl_skipType (decl_getType (n));
16369 }
16370 return n;
16371 /* static analysis guarentees a RETURN statement will be used before here. */
16372 __builtin_unreachable ();
16373 }
16374
16375
16376 /*
16377 doFuncExprC -
16378 */
16379
16380 static void doFuncExprC (mcPretty_pretty p, decl_node n)
16381 {
16382 decl_node t;
16383
16384 mcDebug_assert (isFuncCall (n));
16385 if (decl_isProcedure (n->funccallF.function))
16386 {
16387 doFQDNameC (p, n->funccallF.function, true);
16388 mcPretty_setNeedSpace (p);
16389 doFuncArgsC (p, n, n->funccallF.function->procedureF.parameters, true);
16390 }
16391 else
16392 {
16393 outText (p, (const char *) "(*", 2);
16394 doExprC (p, n->funccallF.function);
16395 outText (p, (const char *) ".proc", 5);
16396 outText (p, (const char *) ")", 1);
16397 t = getFuncFromExpr (n->funccallF.function);
16398 mcPretty_setNeedSpace (p);
16399 if (t == procN)
16400 {
16401 doProcTypeArgsC (p, n, NULL, true);
16402 }
16403 else
16404 {
16405 mcDebug_assert (decl_isProcType (t));
16406 doProcTypeArgsC (p, n, t->proctypeF.parameters, true);
16407 }
16408 }
16409 }
16410
16411
16412 /*
16413 doFuncCallC -
16414 */
16415
16416 static void doFuncCallC (mcPretty_pretty p, decl_node n)
16417 {
16418 doCommentC (p, n->funccallF.funccallComment.body);
16419 doFuncExprC (p, n);
16420 outText (p, (const char *) ";", 1);
16421 doAfterCommentC (p, n->funccallF.funccallComment.after);
16422 }
16423
16424
16425 /*
16426 doCaseStatementC -
16427 */
16428
16429 static void doCaseStatementC (mcPretty_pretty p, decl_node n, bool needBreak)
16430 {
16431 p = mcPretty_pushPretty (p);
16432 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
16433 doStatementSequenceC (p, n);
16434 if (needBreak)
16435 {
16436 outText (p, (const char *) "break;\\n", 8);
16437 }
16438 p = mcPretty_popPretty (p);
16439 }
16440
16441
16442 /*
16443 doExceptionC -
16444 */
16445
16446 static void doExceptionC (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n)
16447 {
16448 unsigned int w;
16449 char a[_a_high+1];
16450
16451 /* make a local copy of each unbounded array. */
16452 memcpy (a, a_, _a_high+1);
16453
16454 w = decl_getDeclaredMod (n);
16455 outText (p, (const char *) a, _a_high);
16456 mcPretty_setNeedSpace (p);
16457 outText (p, (const char *) "(\"", 2);
16458 outTextS (p, mcLexBuf_findFileNameFromToken (w, 0));
16459 outText (p, (const char *) "\",", 2);
16460 mcPretty_setNeedSpace (p);
16461 outCard (p, mcLexBuf_tokenToLineNo (w, 0));
16462 outText (p, (const char *) ",", 1);
16463 mcPretty_setNeedSpace (p);
16464 outCard (p, mcLexBuf_tokenToColumnNo (w, 0));
16465 outText (p, (const char *) ");\\n", 4);
16466 outText (p, (const char *) "__builtin_unreachable ();\\n", 27);
16467 }
16468
16469
16470 /*
16471 doExceptionCP -
16472 */
16473
16474 static void doExceptionCP (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n)
16475 {
16476 unsigned int w;
16477 char a[_a_high+1];
16478
16479 /* make a local copy of each unbounded array. */
16480 memcpy (a, a_, _a_high+1);
16481
16482 w = decl_getDeclaredMod (n);
16483 outText (p, (const char *) a, _a_high);
16484 mcPretty_setNeedSpace (p);
16485 outText (p, (const char *) "(\"", 2);
16486 outTextS (p, mcLexBuf_findFileNameFromToken (w, 0));
16487 outText (p, (const char *) "\",", 2);
16488 mcPretty_setNeedSpace (p);
16489 outCard (p, mcLexBuf_tokenToLineNo (w, 0));
16490 outText (p, (const char *) ",", 1);
16491 mcPretty_setNeedSpace (p);
16492 outCard (p, mcLexBuf_tokenToColumnNo (w, 0));
16493 outText (p, (const char *) ");\\n", 4);
16494 outText (p, (const char *) "__builtin_unreachable ();\\n", 27);
16495 }
16496
16497
16498 /*
16499 doException -
16500 */
16501
16502 static void doException (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n)
16503 {
16504 char a[_a_high+1];
16505
16506 /* make a local copy of each unbounded array. */
16507 memcpy (a, a_, _a_high+1);
16508
16509 keyc_useException ();
16510 if (lang == decl_ansiCP)
16511 {
16512 doExceptionCP (p, (const char *) a, _a_high, n);
16513 }
16514 else
16515 {
16516 doExceptionC (p, (const char *) a, _a_high, n);
16517 }
16518 }
16519
16520
16521 /*
16522 doRangeListC -
16523 */
16524
16525 static void doRangeListC (mcPretty_pretty p, decl_node c)
16526 {
16527 decl_node r;
16528 unsigned int i;
16529 unsigned int h;
16530
16531 mcDebug_assert (decl_isCaseList (c));
16532 i = 1;
16533 h = Indexing_HighIndice (c->caselistF.rangePairs);
16534 while (i <= h)
16535 {
16536 r = static_cast<decl_node> (Indexing_GetIndice (c->caselistF.rangePairs, i));
16537 mcDebug_assert ((r->rangeF.hi == NULL) || (r->rangeF.lo == r->rangeF.hi));
16538 outText (p, (const char *) "case", 4);
16539 mcPretty_setNeedSpace (p);
16540 doExprC (p, r->rangeF.lo);
16541 outText (p, (const char *) ":\\n", 3);
16542 i += 1;
16543 }
16544 }
16545
16546
16547 /*
16548 doRangeIfListC -
16549 */
16550
16551 static void doRangeIfListC (mcPretty_pretty p, decl_node e, decl_node c)
16552 {
16553 decl_node r;
16554 unsigned int i;
16555 unsigned int h;
16556
16557 mcDebug_assert (decl_isCaseList (c));
16558 i = 1;
16559 h = Indexing_HighIndice (c->caselistF.rangePairs);
16560 while (i <= h)
16561 {
16562 r = static_cast<decl_node> (Indexing_GetIndice (c->caselistF.rangePairs, i));
16563 if ((r->rangeF.lo != r->rangeF.hi) && (r->rangeF.hi != NULL))
16564 {
16565 outText (p, (const char *) "((", 2);
16566 doExprC (p, e);
16567 outText (p, (const char *) ")", 1);
16568 mcPretty_setNeedSpace (p);
16569 outText (p, (const char *) ">=", 2);
16570 mcPretty_setNeedSpace (p);
16571 doExprC (p, r->rangeF.lo);
16572 outText (p, (const char *) ")", 1);
16573 mcPretty_setNeedSpace (p);
16574 outText (p, (const char *) "&&", 2);
16575 mcPretty_setNeedSpace (p);
16576 outText (p, (const char *) "((", 2);
16577 doExprC (p, e);
16578 outText (p, (const char *) ")", 1);
16579 mcPretty_setNeedSpace (p);
16580 outText (p, (const char *) "<=", 2);
16581 mcPretty_setNeedSpace (p);
16582 doExprC (p, r->rangeF.hi);
16583 outText (p, (const char *) ")", 1);
16584 }
16585 else
16586 {
16587 outText (p, (const char *) "((", 2);
16588 doExprC (p, e);
16589 outText (p, (const char *) ")", 1);
16590 mcPretty_setNeedSpace (p);
16591 outText (p, (const char *) "==", 2);
16592 mcPretty_setNeedSpace (p);
16593 doExprC (p, r->rangeF.lo);
16594 outText (p, (const char *) ")", 1);
16595 }
16596 if (i < h)
16597 {
16598 mcPretty_setNeedSpace (p);
16599 outText (p, (const char *) "||", 2);
16600 mcPretty_setNeedSpace (p);
16601 }
16602 i += 1;
16603 }
16604 }
16605
16606
16607 /*
16608 doCaseLabels -
16609 */
16610
16611 static void doCaseLabels (mcPretty_pretty p, decl_node n, bool needBreak)
16612 {
16613 mcDebug_assert (decl_isCaseLabelList (n));
16614 doRangeListC (p, n->caselabellistF.caseList);
16615 p = mcPretty_pushPretty (p);
16616 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
16617 doStatementSequenceC (p, n->caselabellistF.statements);
16618 if (needBreak)
16619 {
16620 outText (p, (const char *) "break;\\n\\n", 10);
16621 }
16622 p = mcPretty_popPretty (p);
16623 }
16624
16625
16626 /*
16627 doCaseLabelListC -
16628 */
16629
16630 static void doCaseLabelListC (mcPretty_pretty p, decl_node n, bool haveElse)
16631 {
16632 unsigned int i;
16633 unsigned int h;
16634 decl_node c;
16635
16636 mcDebug_assert (decl_isCase (n));
16637 i = 1;
16638 h = Indexing_HighIndice (n->caseF.caseLabelList);
16639 while (i <= h)
16640 {
16641 c = static_cast<decl_node> (Indexing_GetIndice (n->caseF.caseLabelList, i));
16642 doCaseLabels (p, c, ((i < h) || haveElse) || caseException);
16643 i += 1;
16644 }
16645 }
16646
16647
16648 /*
16649 doCaseIfLabels -
16650 */
16651
16652 static void doCaseIfLabels (mcPretty_pretty p, decl_node e, decl_node n, unsigned int i, unsigned int h)
16653 {
16654 mcDebug_assert (decl_isCaseLabelList (n));
16655 if (i > 1)
16656 {
16657 outText (p, (const char *) "else", 4);
16658 mcPretty_setNeedSpace (p);
16659 }
16660 outText (p, (const char *) "if", 2);
16661 mcPretty_setNeedSpace (p);
16662 outText (p, (const char *) "(", 1);
16663 doRangeIfListC (p, e, n->caselabellistF.caseList);
16664 outText (p, (const char *) ")\\n", 3);
16665 if (h == 1)
16666 {
16667 doCompoundStmt (p, n->caselabellistF.statements);
16668 }
16669 else
16670 {
16671 outText (p, (const char *) "{\\n", 3);
16672 doStatementSequenceC (p, n->caselabellistF.statements);
16673 outText (p, (const char *) "}\\n", 3);
16674 }
16675 }
16676
16677
16678 /*
16679 doCaseIfLabelListC -
16680 */
16681
16682 static void doCaseIfLabelListC (mcPretty_pretty p, decl_node n)
16683 {
16684 unsigned int i;
16685 unsigned int h;
16686 decl_node c;
16687
16688 mcDebug_assert (decl_isCase (n));
16689 i = 1;
16690 h = Indexing_HighIndice (n->caseF.caseLabelList);
16691 while (i <= h)
16692 {
16693 c = static_cast<decl_node> (Indexing_GetIndice (n->caseF.caseLabelList, i));
16694 doCaseIfLabels (p, n->caseF.expression, c, i, h);
16695 i += 1;
16696 }
16697 }
16698
16699
16700 /*
16701 doCaseElseC -
16702 */
16703
16704 static void doCaseElseC (mcPretty_pretty p, decl_node n)
16705 {
16706 mcDebug_assert (decl_isCase (n));
16707 if (n->caseF.else_ == NULL)
16708 {
16709 /* avoid dangling else. */
16710 if (caseException)
16711 {
16712 outText (p, (const char *) "\\ndefault:\\n", 12);
16713 p = mcPretty_pushPretty (p);
16714 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
16715 doException (p, (const char *) "CaseException", 13, n);
16716 p = mcPretty_popPretty (p);
16717 }
16718 }
16719 else
16720 {
16721 outText (p, (const char *) "\\ndefault:\\n", 12);
16722 doCaseStatementC (p, n->caseF.else_, true);
16723 }
16724 }
16725
16726
16727 /*
16728 doCaseIfElseC -
16729 */
16730
16731 static void doCaseIfElseC (mcPretty_pretty p, decl_node n)
16732 {
16733 mcDebug_assert (decl_isCase (n));
16734 if (n->caseF.else_ == NULL)
16735 {
16736 /* avoid dangling else. */
16737 if (true)
16738 {
16739 outText (p, (const char *) "\\n", 2);
16740 outText (p, (const char *) "else {\\n", 8);
16741 p = mcPretty_pushPretty (p);
16742 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
16743 doException (p, (const char *) "CaseException", 13, n);
16744 p = mcPretty_popPretty (p);
16745 outText (p, (const char *) "}\\n", 3);
16746 }
16747 }
16748 else
16749 {
16750 outText (p, (const char *) "\\n", 2);
16751 outText (p, (const char *) "else {\\n", 8);
16752 doCaseStatementC (p, n->caseF.else_, false);
16753 outText (p, (const char *) "}\\n", 3);
16754 }
16755 }
16756
16757
16758 /*
16759 canUseSwitchCaseLabels - returns TRUE if all the case labels are
16760 single values and not ranges.
16761 */
16762
16763 static bool canUseSwitchCaseLabels (decl_node n)
16764 {
16765 unsigned int i;
16766 unsigned int h;
16767 decl_node r;
16768 decl_node l;
16769
16770 mcDebug_assert (decl_isCaseLabelList (n));
16771 l = n->caselabellistF.caseList;
16772 i = 1;
16773 h = Indexing_HighIndice (l->caselistF.rangePairs);
16774 while (i <= h)
16775 {
16776 r = static_cast<decl_node> (Indexing_GetIndice (l->caselistF.rangePairs, i));
16777 if ((r->rangeF.hi != NULL) && (r->rangeF.lo != r->rangeF.hi))
16778 {
16779 return false;
16780 }
16781 i += 1;
16782 }
16783 return true;
16784 /* static analysis guarentees a RETURN statement will be used before here. */
16785 __builtin_unreachable ();
16786 }
16787
16788
16789 /*
16790 canUseSwitch - returns TRUE if the case statement can be implement
16791 by a switch statement. This will be TRUE if all case
16792 selectors are single values rather than ranges.
16793 */
16794
16795 static bool canUseSwitch (decl_node n)
16796 {
16797 unsigned int i;
16798 unsigned int h;
16799 decl_node c;
16800
16801 mcDebug_assert (decl_isCase (n));
16802 i = 1;
16803 h = Indexing_HighIndice (n->caseF.caseLabelList);
16804 while (i <= h)
16805 {
16806 c = static_cast<decl_node> (Indexing_GetIndice (n->caseF.caseLabelList, i));
16807 if (! (canUseSwitchCaseLabels (c)))
16808 {
16809 return false;
16810 }
16811 i += 1;
16812 }
16813 return true;
16814 /* static analysis guarentees a RETURN statement will be used before here. */
16815 __builtin_unreachable ();
16816 }
16817
16818
16819 /*
16820 doCaseC -
16821 */
16822
16823 static void doCaseC (mcPretty_pretty p, decl_node n)
16824 {
16825 unsigned int i;
16826
16827 mcDebug_assert (decl_isCase (n));
16828 if (canUseSwitch (n))
16829 {
16830 i = mcPretty_getindent (p);
16831 outText (p, (const char *) "switch", 6);
16832 mcPretty_setNeedSpace (p);
16833 outText (p, (const char *) "(", 1);
16834 doExprC (p, n->caseF.expression);
16835 p = mcPretty_pushPretty (p);
16836 outText (p, (const char *) ")", 1);
16837 mcPretty_setindent (p, i+indentationC);
16838 outText (p, (const char *) "\\n{\\n", 5);
16839 p = mcPretty_pushPretty (p);
16840 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
16841 doCaseLabelListC (p, n, n->caseF.else_ != NULL);
16842 doCaseElseC (p, n);
16843 p = mcPretty_popPretty (p);
16844 outText (p, (const char *) "}\\n", 3);
16845 p = mcPretty_popPretty (p);
16846 }
16847 else
16848 {
16849 doCaseIfLabelListC (p, n);
16850 doCaseIfElseC (p, n);
16851 }
16852 }
16853
16854
16855 /*
16856 doLoopC -
16857 */
16858
16859 static void doLoopC (mcPretty_pretty p, decl_node s)
16860 {
16861 mcDebug_assert (decl_isLoop (s));
16862 outText (p, (const char *) "for (;;)\\n", 10);
16863 outText (p, (const char *) "{\\n", 3);
16864 p = mcPretty_pushPretty (p);
16865 mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
16866 doStatementSequenceC (p, s->loopF.statements);
16867 p = mcPretty_popPretty (p);
16868 outText (p, (const char *) "}\\n", 3);
16869 }
16870
16871
16872 /*
16873 doExitC -
16874 */
16875
16876 static void doExitC (mcPretty_pretty p, decl_node s)
16877 {
16878 mcDebug_assert (decl_isExit (s));
16879 outText (p, (const char *) "/* exit. */\\n", 14);
16880 }
16881
16882
16883 /*
16884 doStatementsC -
16885 */
16886
16887 static void doStatementsC (mcPretty_pretty p, decl_node s)
16888 {
16889 if (s == NULL)
16890 {} /* empty. */
16891 else if (decl_isStatementSequence (s))
16892 {
16893 /* avoid dangling else. */
16894 doStatementSequenceC (p, s);
16895 }
16896 else if (isComment (s))
16897 {
16898 /* avoid dangling else. */
16899 doCommentC (p, s);
16900 }
16901 else if (decl_isExit (s))
16902 {
16903 /* avoid dangling else. */
16904 doExitC (p, s);
16905 }
16906 else if (decl_isReturn (s))
16907 {
16908 /* avoid dangling else. */
16909 doReturnC (p, s);
16910 }
16911 else if (isAssignment (s))
16912 {
16913 /* avoid dangling else. */
16914 doAssignmentC (p, s);
16915 }
16916 else if (decl_isIf (s))
16917 {
16918 /* avoid dangling else. */
16919 doIfC (p, s);
16920 }
16921 else if (decl_isFor (s))
16922 {
16923 /* avoid dangling else. */
16924 doForC (p, s);
16925 }
16926 else if (decl_isRepeat (s))
16927 {
16928 /* avoid dangling else. */
16929 doRepeatC (p, s);
16930 }
16931 else if (decl_isWhile (s))
16932 {
16933 /* avoid dangling else. */
16934 doWhileC (p, s);
16935 }
16936 else if (isIntrinsic (s))
16937 {
16938 /* avoid dangling else. */
16939 doIntrinsicC (p, s);
16940 }
16941 else if (isFuncCall (s))
16942 {
16943 /* avoid dangling else. */
16944 doFuncCallC (p, s);
16945 }
16946 else if (decl_isCase (s))
16947 {
16948 /* avoid dangling else. */
16949 doCaseC (p, s);
16950 }
16951 else if (decl_isLoop (s))
16952 {
16953 /* avoid dangling else. */
16954 doLoopC (p, s);
16955 }
16956 else if (decl_isExit (s))
16957 {
16958 /* avoid dangling else. */
16959 doExitC (p, s);
16960 }
16961 else
16962 {
16963 /* avoid dangling else. */
16964 M2RTS_HALT (-1); /* need to handle another s^.kind. */
16965 __builtin_unreachable ();
16966 }
16967 }
16968
16969 static void stop (void)
16970 {
16971 }
16972
16973
16974 /*
16975 doLocalVarC -
16976 */
16977
16978 static void doLocalVarC (mcPretty_pretty p, decl_scopeT s)
16979 {
16980 includeVarProcedure (s);
16981 debugLists ();
16982 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
16983 }
16984
16985
16986 /*
16987 doLocalConstTypesC -
16988 */
16989
16990 static void doLocalConstTypesC (mcPretty_pretty p, decl_scopeT s)
16991 {
16992 simplifyTypes (s);
16993 includeConstType (s);
16994 doP = p;
16995 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
16996 }
16997
16998
16999 /*
17000 addParamDone -
17001 */
17002
17003 static void addParamDone (decl_node n)
17004 {
17005 if ((decl_isVar (n)) && n->varF.isParameter)
17006 {
17007 addDone (n);
17008 addDone (decl_getType (n));
17009 }
17010 }
17011
17012
17013 /*
17014 includeParameters -
17015 */
17016
17017 static void includeParameters (decl_node n)
17018 {
17019 mcDebug_assert (decl_isProcedure (n));
17020 Indexing_ForeachIndiceInIndexDo (n->procedureF.decls.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addParamDone});
17021 }
17022
17023
17024 /*
17025 isHalt -
17026 */
17027
17028 static bool isHalt (decl_node n)
17029 {
17030 return n->kind == decl_halt;
17031 /* static analysis guarentees a RETURN statement will be used before here. */
17032 __builtin_unreachable ();
17033 }
17034
17035
17036 /*
17037 isReturnOrHalt -
17038 */
17039
17040 static bool isReturnOrHalt (decl_node n)
17041 {
17042 return (isHalt (n)) || (decl_isReturn (n));
17043 /* static analysis guarentees a RETURN statement will be used before here. */
17044 __builtin_unreachable ();
17045 }
17046
17047
17048 /*
17049 isLastStatementReturn -
17050 */
17051
17052 static bool isLastStatementReturn (decl_node n)
17053 {
17054 return isLastStatement (n, (decl_isNodeF) {(decl_isNodeF_t) isReturnOrHalt});
17055 /* static analysis guarentees a RETURN statement will be used before here. */
17056 __builtin_unreachable ();
17057 }
17058
17059
17060 /*
17061 isLastStatementSequence -
17062 */
17063
17064 static bool isLastStatementSequence (decl_node n, decl_isNodeF q)
17065 {
17066 unsigned int h;
17067
17068 mcDebug_assert (decl_isStatementSequence (n));
17069 h = Indexing_HighIndice (n->stmtF.statements);
17070 if (h > 0)
17071 {
17072 return isLastStatement (reinterpret_cast<decl_node> (Indexing_GetIndice (n->stmtF.statements, h)), q);
17073 }
17074 return false;
17075 /* static analysis guarentees a RETURN statement will be used before here. */
17076 __builtin_unreachable ();
17077 }
17078
17079
17080 /*
17081 isLastStatementIf -
17082 */
17083
17084 static bool isLastStatementIf (decl_node n, decl_isNodeF q)
17085 {
17086 bool ret;
17087
17088 mcDebug_assert (decl_isIf (n));
17089 ret = true;
17090 if ((n->ifF.elsif != NULL) && ret)
17091 {
17092 ret = isLastStatement (n->ifF.elsif, q);
17093 }
17094 if ((n->ifF.then != NULL) && ret)
17095 {
17096 ret = isLastStatement (n->ifF.then, q);
17097 }
17098 if ((n->ifF.else_ != NULL) && ret)
17099 {
17100 ret = isLastStatement (n->ifF.else_, q);
17101 }
17102 return ret;
17103 /* static analysis guarentees a RETURN statement will be used before here. */
17104 __builtin_unreachable ();
17105 }
17106
17107
17108 /*
17109 isLastStatementElsif -
17110 */
17111
17112 static bool isLastStatementElsif (decl_node n, decl_isNodeF q)
17113 {
17114 bool ret;
17115
17116 mcDebug_assert (decl_isElsif (n));
17117 ret = true;
17118 if ((n->elsifF.elsif != NULL) && ret)
17119 {
17120 ret = isLastStatement (n->elsifF.elsif, q);
17121 }
17122 if ((n->elsifF.then != NULL) && ret)
17123 {
17124 ret = isLastStatement (n->elsifF.then, q);
17125 }
17126 if ((n->elsifF.else_ != NULL) && ret)
17127 {
17128 ret = isLastStatement (n->elsifF.else_, q);
17129 }
17130 return ret;
17131 /* static analysis guarentees a RETURN statement will be used before here. */
17132 __builtin_unreachable ();
17133 }
17134
17135
17136 /*
17137 isLastStatementCase -
17138 */
17139
17140 static bool isLastStatementCase (decl_node n, decl_isNodeF q)
17141 {
17142 bool ret;
17143 unsigned int i;
17144 unsigned int h;
17145 decl_node c;
17146
17147 ret = true;
17148 mcDebug_assert (decl_isCase (n));
17149 i = 1;
17150 h = Indexing_HighIndice (n->caseF.caseLabelList);
17151 while (i <= h)
17152 {
17153 c = static_cast<decl_node> (Indexing_GetIndice (n->caseF.caseLabelList, i));
17154 mcDebug_assert (decl_isCaseLabelList (c));
17155 ret = ret && (isLastStatement (c->caselabellistF.statements, q));
17156 i += 1;
17157 }
17158 if (n->caseF.else_ != NULL)
17159 {
17160 ret = ret && (isLastStatement (n->caseF.else_, q));
17161 }
17162 return ret;
17163 /* static analysis guarentees a RETURN statement will be used before here. */
17164 __builtin_unreachable ();
17165 }
17166
17167
17168 /*
17169 isLastStatement - returns TRUE if the last statement in, n, is, q.
17170 */
17171
17172 static bool isLastStatement (decl_node n, decl_isNodeF q)
17173 {
17174 bool ret;
17175
17176 if (n == NULL)
17177 {
17178 return false;
17179 }
17180 else if (decl_isStatementSequence (n))
17181 {
17182 /* avoid dangling else. */
17183 return isLastStatementSequence (n, q);
17184 }
17185 else if (decl_isProcedure (n))
17186 {
17187 /* avoid dangling else. */
17188 mcDebug_assert (decl_isProcedure (n));
17189 return isLastStatement (n->procedureF.beginStatements, q);
17190 }
17191 else if (decl_isIf (n))
17192 {
17193 /* avoid dangling else. */
17194 return isLastStatementIf (n, q);
17195 }
17196 else if (decl_isElsif (n))
17197 {
17198 /* avoid dangling else. */
17199 return isLastStatementElsif (n, q);
17200 }
17201 else if (decl_isCase (n))
17202 {
17203 /* avoid dangling else. */
17204 return isLastStatementCase (n, q);
17205 }
17206 else if ((*q.proc) (n))
17207 {
17208 /* avoid dangling else. */
17209 return true;
17210 }
17211 return false;
17212 /* static analysis guarentees a RETURN statement will be used before here. */
17213 __builtin_unreachable ();
17214 }
17215
17216
17217 /*
17218 doProcedureC -
17219 */
17220
17221 static void doProcedureC (decl_node n)
17222 {
17223 unsigned int s;
17224
17225 outText (doP, (const char *) "\\n", 2);
17226 includeParameters (n);
17227 keyc_enterScope (n);
17228 doProcedureHeadingC (n, false);
17229 outText (doP, (const char *) "\\n", 2);
17230 doP = outKc (doP, (const char *) "{\\n", 3);
17231 s = mcPretty_getcurline (doP);
17232 doLocalConstTypesC (doP, n->procedureF.decls);
17233 doLocalVarC (doP, n->procedureF.decls);
17234 doUnboundedParamCopyC (doP, n);
17235 if (s != (mcPretty_getcurline (doP)))
17236 {
17237 outText (doP, (const char *) "\\n", 2);
17238 }
17239 doStatementsC (doP, n->procedureF.beginStatements);
17240 if (n->procedureF.returnType != NULL)
17241 {
17242 if (returnException)
17243 {
17244 /* avoid gcc warning by using compound statement even if not strictly necessary. */
17245 if (isLastStatementReturn (n))
17246 {
17247 outText (doP, (const char *) "/* static analysis guarentees a RETURN statement will be used before here. */\\n", 80);
17248 outText (doP, (const char *) "__builtin_unreachable ();\\n", 27);
17249 }
17250 else
17251 {
17252 doException (doP, (const char *) "ReturnException", 15, n);
17253 }
17254 }
17255 }
17256 doP = outKc (doP, (const char *) "}\\n", 3);
17257 keyc_leaveScope (n);
17258 }
17259
17260
17261 /*
17262 outProceduresC -
17263 */
17264
17265 static void outProceduresC (mcPretty_pretty p, decl_scopeT s)
17266 {
17267 doP = p;
17268 if (debugDecl)
17269 {
17270 libc_printf ((const char *) "seen %d procedures\\n", 20, Indexing_HighIndice (s.procedures));
17271 }
17272 Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doProcedureC});
17273 }
17274
17275
17276 /*
17277 output -
17278 */
17279
17280 static void output (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v)
17281 {
17282 if (decl_isConst (n))
17283 {
17284 (*c.proc) (n);
17285 }
17286 else if (decl_isVar (n))
17287 {
17288 /* avoid dangling else. */
17289 (*v.proc) (n);
17290 }
17291 else
17292 {
17293 /* avoid dangling else. */
17294 (*t.proc) (n);
17295 }
17296 }
17297
17298
17299 /*
17300 allDependants -
17301 */
17302
17303 static decl_dependentState allDependants (decl_node n)
17304 {
17305 alists_alist l;
17306 decl_dependentState s;
17307
17308 l = alists_initList ();
17309 s = walkDependants (l, n);
17310 alists_killList (&l);
17311 return s;
17312 /* static analysis guarentees a RETURN statement will be used before here. */
17313 __builtin_unreachable ();
17314 }
17315
17316
17317 /*
17318 walkDependants -
17319 */
17320
17321 static decl_dependentState walkDependants (alists_alist l, decl_node n)
17322 {
17323 if ((n == NULL) || (alists_isItemInList (doneQ, reinterpret_cast<void *> (n))))
17324 {
17325 return decl_completed;
17326 }
17327 else if (alists_isItemInList (l, reinterpret_cast<void *> (n)))
17328 {
17329 /* avoid dangling else. */
17330 return decl_recursive;
17331 }
17332 else
17333 {
17334 /* avoid dangling else. */
17335 alists_includeItemIntoList (l, reinterpret_cast<void *> (n));
17336 return doDependants (l, n);
17337 }
17338 /* static analysis guarentees a RETURN statement will be used before here. */
17339 __builtin_unreachable ();
17340 }
17341
17342
17343 /*
17344 walkType -
17345 */
17346
17347 static decl_dependentState walkType (alists_alist l, decl_node n)
17348 {
17349 decl_node t;
17350
17351 t = decl_getType (n);
17352 if (alists_isItemInList (doneQ, reinterpret_cast<void *> (t)))
17353 {
17354 return decl_completed;
17355 }
17356 else if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
17357 {
17358 /* avoid dangling else. */
17359 return decl_blocked;
17360 }
17361 else
17362 {
17363 /* avoid dangling else. */
17364 queueBlocked (t);
17365 return decl_blocked;
17366 }
17367 /* static analysis guarentees a RETURN statement will be used before here. */
17368 __builtin_unreachable ();
17369 }
17370
17371
17372 /*
17373 db -
17374 */
17375
17376 static void db (const char *a_, unsigned int _a_high, decl_node n)
17377 {
17378 char a[_a_high+1];
17379
17380 /* make a local copy of each unbounded array. */
17381 memcpy (a, a_, _a_high+1);
17382
17383 if (mcOptions_getDebugTopological ())
17384 {
17385 outText (doP, (const char *) a, _a_high);
17386 if (n != NULL)
17387 {
17388 outTextS (doP, gen (n));
17389 }
17390 }
17391 }
17392
17393
17394 /*
17395 dbt -
17396 */
17397
17398 static void dbt (const char *a_, unsigned int _a_high)
17399 {
17400 char a[_a_high+1];
17401
17402 /* make a local copy of each unbounded array. */
17403 memcpy (a, a_, _a_high+1);
17404
17405 if (mcOptions_getDebugTopological ())
17406 {
17407 outText (doP, (const char *) a, _a_high);
17408 }
17409 }
17410
17411
17412 /*
17413 dbs -
17414 */
17415
17416 static void dbs (decl_dependentState s, decl_node n)
17417 {
17418 if (mcOptions_getDebugTopological ())
17419 {
17420 switch (s)
17421 {
17422 case decl_completed:
17423 outText (doP, (const char *) "{completed ", 11);
17424 break;
17425
17426 case decl_blocked:
17427 outText (doP, (const char *) "{blocked ", 9);
17428 break;
17429
17430 case decl_partial:
17431 outText (doP, (const char *) "{partial ", 9);
17432 break;
17433
17434 case decl_recursive:
17435 outText (doP, (const char *) "{recursive ", 11);
17436 break;
17437
17438
17439 default:
17440 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
17441 __builtin_unreachable ();
17442 }
17443 if (n != NULL)
17444 {
17445 outTextS (doP, gen (n));
17446 }
17447 outText (doP, (const char *) "}\\n", 3);
17448 }
17449 }
17450
17451
17452 /*
17453 dbq -
17454 */
17455
17456 static void dbq (decl_node n)
17457 {
17458 if (mcOptions_getDebugTopological ())
17459 {
17460 /* avoid gcc warning by using compound statement even if not strictly necessary. */
17461 if (alists_isItemInList (todoQ, reinterpret_cast<void *> (n)))
17462 {
17463 db ((const char *) "{T", 2, n);
17464 outText (doP, (const char *) "}", 1);
17465 }
17466 else if (alists_isItemInList (partialQ, reinterpret_cast<void *> (n)))
17467 {
17468 /* avoid dangling else. */
17469 db ((const char *) "{P", 2, n);
17470 outText (doP, (const char *) "}", 1);
17471 }
17472 else if (alists_isItemInList (doneQ, reinterpret_cast<void *> (n)))
17473 {
17474 /* avoid dangling else. */
17475 db ((const char *) "{D", 2, n);
17476 outText (doP, (const char *) "}", 1);
17477 }
17478 }
17479 }
17480
17481
17482 /*
17483 walkRecord -
17484 */
17485
17486 static decl_dependentState walkRecord (alists_alist l, decl_node n)
17487 {
17488 decl_dependentState s;
17489 unsigned int o;
17490 unsigned int i;
17491 unsigned int t;
17492 decl_node q;
17493
17494 i = Indexing_LowIndice (n->recordF.listOfSons);
17495 t = Indexing_HighIndice (n->recordF.listOfSons);
17496 db ((const char *) "\\nwalking ", 10, n);
17497 o = mcPretty_getindent (doP);
17498 mcPretty_setindent (doP, (mcPretty_getcurpos (doP))+3);
17499 dbq (n);
17500 while (i <= t)
17501 {
17502 q = static_cast<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
17503 db ((const char *) "", 0, q);
17504 if ((decl_isRecordField (q)) && q->recordfieldF.tag)
17505 {} /* empty. */
17506 else
17507 {
17508 /* do nothing as it is a tag selector processed in the varient. */
17509 s = walkDependants (l, q);
17510 if (s != decl_completed)
17511 {
17512 dbs (s, q);
17513 addTodo (n);
17514 dbq (n);
17515 db ((const char *) "\\n", 2, NULL);
17516 mcPretty_setindent (doP, o);
17517 return s;
17518 }
17519 }
17520 i += 1;
17521 }
17522 db ((const char *) "{completed", 10, n);
17523 dbt ((const char *) "}\\n", 3);
17524 mcPretty_setindent (doP, o);
17525 return decl_completed;
17526 /* static analysis guarentees a RETURN statement will be used before here. */
17527 __builtin_unreachable ();
17528 }
17529
17530
17531 /*
17532 walkVarient -
17533 */
17534
17535 static decl_dependentState walkVarient (alists_alist l, decl_node n)
17536 {
17537 decl_dependentState s;
17538 unsigned int i;
17539 unsigned int t;
17540 decl_node q;
17541
17542 db ((const char *) "\\nwalking", 9, n);
17543 s = walkDependants (l, n->varientF.tag);
17544 if (s != decl_completed)
17545 {
17546 dbs (s, n->varientF.tag);
17547 dbq (n->varientF.tag);
17548 db ((const char *) "\\n", 2, NULL);
17549 return s;
17550 }
17551 i = Indexing_LowIndice (n->varientF.listOfSons);
17552 t = Indexing_HighIndice (n->varientF.listOfSons);
17553 while (i <= t)
17554 {
17555 q = static_cast<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
17556 db ((const char *) "", 0, q);
17557 s = walkDependants (l, q);
17558 if (s != decl_completed)
17559 {
17560 dbs (s, q);
17561 db ((const char *) "\\n", 2, NULL);
17562 return s;
17563 }
17564 i += 1;
17565 }
17566 db ((const char *) "{completed", 10, n);
17567 dbt ((const char *) "}\\n", 3);
17568 return decl_completed;
17569 /* static analysis guarentees a RETURN statement will be used before here. */
17570 __builtin_unreachable ();
17571 }
17572
17573
17574 /*
17575 queueBlocked -
17576 */
17577
17578 static void queueBlocked (decl_node n)
17579 {
17580 if (! ((alists_isItemInList (doneQ, reinterpret_cast<void *> (n))) || (alists_isItemInList (partialQ, reinterpret_cast<void *> (n)))))
17581 {
17582 addTodo (n);
17583 }
17584 }
17585
17586
17587 /*
17588 walkVar -
17589 */
17590
17591 static decl_dependentState walkVar (alists_alist l, decl_node n)
17592 {
17593 decl_node t;
17594
17595 t = decl_getType (n);
17596 if (alists_isItemInList (doneQ, reinterpret_cast<void *> (t)))
17597 {
17598 return decl_completed;
17599 }
17600 else
17601 {
17602 queueBlocked (t);
17603 return decl_blocked;
17604 }
17605 /* static analysis guarentees a RETURN statement will be used before here. */
17606 __builtin_unreachable ();
17607 }
17608
17609
17610 /*
17611 walkEnumeration -
17612 */
17613
17614 static decl_dependentState walkEnumeration (alists_alist l, decl_node n)
17615 {
17616 decl_dependentState s;
17617 unsigned int i;
17618 unsigned int t;
17619 decl_node q;
17620
17621 i = Indexing_LowIndice (n->enumerationF.listOfSons);
17622 t = Indexing_HighIndice (n->enumerationF.listOfSons);
17623 s = decl_completed;
17624 while (i <= t)
17625 {
17626 q = static_cast<decl_node> (Indexing_GetIndice (n->enumerationF.listOfSons, i));
17627 s = walkDependants (l, q);
17628 if (s != decl_completed)
17629 {
17630 return s;
17631 }
17632 i += 1;
17633 }
17634 return s;
17635 /* static analysis guarentees a RETURN statement will be used before here. */
17636 __builtin_unreachable ();
17637 }
17638
17639
17640 /*
17641 walkSubrange -
17642 */
17643
17644 static decl_dependentState walkSubrange (alists_alist l, decl_node n)
17645 {
17646 decl_dependentState s;
17647
17648 s = walkDependants (l, n->subrangeF.low);
17649 if (s != decl_completed)
17650 {
17651 return s;
17652 }
17653 s = walkDependants (l, n->subrangeF.high);
17654 if (s != decl_completed)
17655 {
17656 return s;
17657 }
17658 s = walkDependants (l, n->subrangeF.type);
17659 if (s != decl_completed)
17660 {
17661 return s;
17662 }
17663 return decl_completed;
17664 /* static analysis guarentees a RETURN statement will be used before here. */
17665 __builtin_unreachable ();
17666 }
17667
17668
17669 /*
17670 walkSubscript -
17671 */
17672
17673 static decl_dependentState walkSubscript (alists_alist l, decl_node n)
17674 {
17675 decl_dependentState s;
17676
17677 s = walkDependants (l, n->subscriptF.expr);
17678 if (s != decl_completed)
17679 {
17680 return s;
17681 }
17682 s = walkDependants (l, n->subscriptF.type);
17683 if (s != decl_completed)
17684 {
17685 return s;
17686 }
17687 return decl_completed;
17688 /* static analysis guarentees a RETURN statement will be used before here. */
17689 __builtin_unreachable ();
17690 }
17691
17692
17693 /*
17694 walkPointer -
17695 */
17696
17697 static decl_dependentState walkPointer (alists_alist l, decl_node n)
17698 {
17699 decl_node t;
17700
17701 /* if the type of, n, is done or partial then we can output pointer. */
17702 t = decl_getType (n);
17703 if ((alists_isItemInList (partialQ, reinterpret_cast<void *> (t))) || (alists_isItemInList (doneQ, reinterpret_cast<void *> (t))))
17704 {
17705 /* pointer to partial can always generate a complete type. */
17706 return decl_completed;
17707 }
17708 return walkType (l, n);
17709 /* static analysis guarentees a RETURN statement will be used before here. */
17710 __builtin_unreachable ();
17711 }
17712
17713
17714 /*
17715 walkArray -
17716 */
17717
17718 static decl_dependentState walkArray (alists_alist l, decl_node n)
17719 {
17720 decl_dependentState s;
17721
17722 /* an array can only be declared if its data type has already been emitted. */
17723 if (! (alists_isItemInList (doneQ, reinterpret_cast<void *> (n->arrayF.type))))
17724 {
17725 s = walkDependants (l, n->arrayF.type);
17726 queueBlocked (n->arrayF.type);
17727 if (s == decl_completed)
17728 {
17729 /* downgrade the completed to partial as it has not yet been written. */
17730 return decl_partial;
17731 }
17732 else
17733 {
17734 return s;
17735 }
17736 }
17737 return walkDependants (l, n->arrayF.subr);
17738 /* static analysis guarentees a RETURN statement will be used before here. */
17739 __builtin_unreachable ();
17740 }
17741
17742
17743 /*
17744 walkConst -
17745 */
17746
17747 static decl_dependentState walkConst (alists_alist l, decl_node n)
17748 {
17749 decl_dependentState s;
17750
17751 s = walkDependants (l, n->constF.type);
17752 if (s != decl_completed)
17753 {
17754 return s;
17755 }
17756 s = walkDependants (l, n->constF.value);
17757 if (s != decl_completed)
17758 {
17759 return s;
17760 }
17761 return decl_completed;
17762 /* static analysis guarentees a RETURN statement will be used before here. */
17763 __builtin_unreachable ();
17764 }
17765
17766
17767 /*
17768 walkVarParam -
17769 */
17770
17771 static decl_dependentState walkVarParam (alists_alist l, decl_node n)
17772 {
17773 decl_node t;
17774
17775 t = decl_getType (n);
17776 if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
17777 {
17778 /* parameter can be issued from a partial. */
17779 return decl_completed;
17780 }
17781 return walkDependants (l, t);
17782 /* static analysis guarentees a RETURN statement will be used before here. */
17783 __builtin_unreachable ();
17784 }
17785
17786
17787 /*
17788 walkParam -
17789 */
17790
17791 static decl_dependentState walkParam (alists_alist l, decl_node n)
17792 {
17793 decl_node t;
17794
17795 t = decl_getType (n);
17796 if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
17797 {
17798 /* parameter can be issued from a partial. */
17799 return decl_completed;
17800 }
17801 return walkDependants (l, t);
17802 /* static analysis guarentees a RETURN statement will be used before here. */
17803 __builtin_unreachable ();
17804 }
17805
17806
17807 /*
17808 walkOptarg -
17809 */
17810
17811 static decl_dependentState walkOptarg (alists_alist l, decl_node n)
17812 {
17813 decl_node t;
17814
17815 t = decl_getType (n);
17816 if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
17817 {
17818 /* parameter can be issued from a partial. */
17819 return decl_completed;
17820 }
17821 return walkDependants (l, t);
17822 /* static analysis guarentees a RETURN statement will be used before here. */
17823 __builtin_unreachable ();
17824 }
17825
17826
17827 /*
17828 walkRecordField -
17829 */
17830
17831 static decl_dependentState walkRecordField (alists_alist l, decl_node n)
17832 {
17833 decl_node t;
17834 decl_dependentState s;
17835
17836 mcDebug_assert (decl_isRecordField (n));
17837 t = decl_getType (n);
17838 if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
17839 {
17840 dbs (decl_partial, n);
17841 return decl_partial;
17842 }
17843 else if (alists_isItemInList (doneQ, reinterpret_cast<void *> (t)))
17844 {
17845 /* avoid dangling else. */
17846 dbs (decl_completed, n);
17847 return decl_completed;
17848 }
17849 else
17850 {
17851 /* avoid dangling else. */
17852 addTodo (t);
17853 dbs (decl_blocked, n);
17854 dbq (n);
17855 dbq (t);
17856 /* s := walkDependants (l, t) */
17857 return decl_blocked;
17858 }
17859 /* static analysis guarentees a RETURN statement will be used before here. */
17860 __builtin_unreachable ();
17861 }
17862
17863
17864 /*
17865 walkVarientField -
17866 */
17867
17868 static decl_dependentState walkVarientField (alists_alist l, decl_node n)
17869 {
17870 decl_dependentState s;
17871 unsigned int i;
17872 unsigned int t;
17873 decl_node q;
17874
17875 i = Indexing_LowIndice (n->varientfieldF.listOfSons);
17876 t = Indexing_HighIndice (n->varientfieldF.listOfSons);
17877 s = decl_completed;
17878 while (i <= t)
17879 {
17880 q = static_cast<decl_node> (Indexing_GetIndice (n->varientfieldF.listOfSons, i));
17881 s = walkDependants (l, q);
17882 if (s != decl_completed)
17883 {
17884 dbs (s, n);
17885 return s;
17886 }
17887 i += 1;
17888 }
17889 n->varientfieldF.simple = t <= 1;
17890 dbs (s, n);
17891 return s;
17892 /* static analysis guarentees a RETURN statement will be used before here. */
17893 __builtin_unreachable ();
17894 }
17895
17896
17897 /*
17898 walkEnumerationField -
17899 */
17900
17901 static decl_dependentState walkEnumerationField (alists_alist l, decl_node n)
17902 {
17903 return decl_completed;
17904 /* static analysis guarentees a RETURN statement will be used before here. */
17905 __builtin_unreachable ();
17906 }
17907
17908
17909 /*
17910 walkSet -
17911 */
17912
17913 static decl_dependentState walkSet (alists_alist l, decl_node n)
17914 {
17915 return walkDependants (l, decl_getType (n));
17916 /* static analysis guarentees a RETURN statement will be used before here. */
17917 __builtin_unreachable ();
17918 }
17919
17920
17921 /*
17922 walkProcType -
17923 */
17924
17925 static decl_dependentState walkProcType (alists_alist l, decl_node n)
17926 {
17927 decl_dependentState s;
17928 decl_node t;
17929
17930 t = decl_getType (n);
17931 if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
17932 {} /* empty. */
17933 else
17934 {
17935 /* proctype can be generated from partial types. */
17936 s = walkDependants (l, t);
17937 if (s != decl_completed)
17938 {
17939 return s;
17940 }
17941 }
17942 return walkParameters (l, n->proctypeF.parameters);
17943 /* static analysis guarentees a RETURN statement will be used before here. */
17944 __builtin_unreachable ();
17945 }
17946
17947
17948 /*
17949 walkProcedure -
17950 */
17951
17952 static decl_dependentState walkProcedure (alists_alist l, decl_node n)
17953 {
17954 decl_dependentState s;
17955
17956 s = walkDependants (l, decl_getType (n));
17957 if (s != decl_completed)
17958 {
17959 return s;
17960 }
17961 return walkParameters (l, n->procedureF.parameters);
17962 /* static analysis guarentees a RETURN statement will be used before here. */
17963 __builtin_unreachable ();
17964 }
17965
17966
17967 /*
17968 walkParameters -
17969 */
17970
17971 static decl_dependentState walkParameters (alists_alist l, Indexing_Index p)
17972 {
17973 decl_dependentState s;
17974 unsigned int i;
17975 unsigned int h;
17976 decl_node q;
17977
17978 i = Indexing_LowIndice (p);
17979 h = Indexing_HighIndice (p);
17980 while (i <= h)
17981 {
17982 q = static_cast<decl_node> (Indexing_GetIndice (p, i));
17983 s = walkDependants (l, q);
17984 if (s != decl_completed)
17985 {
17986 return s;
17987 }
17988 i += 1;
17989 }
17990 return decl_completed;
17991 /* static analysis guarentees a RETURN statement will be used before here. */
17992 __builtin_unreachable ();
17993 }
17994
17995
17996 /*
17997 walkFuncCall -
17998 */
17999
18000 static decl_dependentState walkFuncCall (alists_alist l, decl_node n)
18001 {
18002 return decl_completed;
18003 /* static analysis guarentees a RETURN statement will be used before here. */
18004 __builtin_unreachable ();
18005 }
18006
18007
18008 /*
18009 walkUnary -
18010 */
18011
18012 static decl_dependentState walkUnary (alists_alist l, decl_node n)
18013 {
18014 decl_dependentState s;
18015
18016 s = walkDependants (l, n->unaryF.arg);
18017 if (s != decl_completed)
18018 {
18019 return s;
18020 }
18021 return walkDependants (l, n->unaryF.resultType);
18022 /* static analysis guarentees a RETURN statement will be used before here. */
18023 __builtin_unreachable ();
18024 }
18025
18026
18027 /*
18028 walkBinary -
18029 */
18030
18031 static decl_dependentState walkBinary (alists_alist l, decl_node n)
18032 {
18033 decl_dependentState s;
18034
18035 s = walkDependants (l, n->binaryF.left);
18036 if (s != decl_completed)
18037 {
18038 return s;
18039 }
18040 s = walkDependants (l, n->binaryF.right);
18041 if (s != decl_completed)
18042 {
18043 return s;
18044 }
18045 return walkDependants (l, n->binaryF.resultType);
18046 /* static analysis guarentees a RETURN statement will be used before here. */
18047 __builtin_unreachable ();
18048 }
18049
18050
18051 /*
18052 walkComponentRef -
18053 */
18054
18055 static decl_dependentState walkComponentRef (alists_alist l, decl_node n)
18056 {
18057 decl_dependentState s;
18058
18059 s = walkDependants (l, n->componentrefF.rec);
18060 if (s != decl_completed)
18061 {
18062 return s;
18063 }
18064 s = walkDependants (l, n->componentrefF.field);
18065 if (s != decl_completed)
18066 {
18067 return s;
18068 }
18069 return walkDependants (l, n->componentrefF.resultType);
18070 /* static analysis guarentees a RETURN statement will be used before here. */
18071 __builtin_unreachable ();
18072 }
18073
18074
18075 /*
18076 walkPointerRef -
18077 */
18078
18079 static decl_dependentState walkPointerRef (alists_alist l, decl_node n)
18080 {
18081 decl_dependentState s;
18082
18083 s = walkDependants (l, n->pointerrefF.ptr);
18084 if (s != decl_completed)
18085 {
18086 return s;
18087 }
18088 s = walkDependants (l, n->pointerrefF.field);
18089 if (s != decl_completed)
18090 {
18091 return s;
18092 }
18093 return walkDependants (l, n->pointerrefF.resultType);
18094 /* static analysis guarentees a RETURN statement will be used before here. */
18095 __builtin_unreachable ();
18096 }
18097
18098
18099 /*
18100 walkSetValue -
18101 */
18102
18103 static decl_dependentState walkSetValue (alists_alist l, decl_node n)
18104 {
18105 decl_dependentState s;
18106 unsigned int i;
18107 unsigned int j;
18108
18109 mcDebug_assert (decl_isSetValue (n));
18110 s = walkDependants (l, n->setvalueF.type);
18111 if (s != decl_completed)
18112 {
18113 return s;
18114 }
18115 i = Indexing_LowIndice (n->setvalueF.values);
18116 j = Indexing_HighIndice (n->setvalueF.values);
18117 while (i <= j)
18118 {
18119 s = walkDependants (l, reinterpret_cast<decl_node> (Indexing_GetIndice (n->setvalueF.values, i)));
18120 if (s != decl_completed)
18121 {
18122 return s;
18123 }
18124 i += 1;
18125 }
18126 return decl_completed;
18127 /* static analysis guarentees a RETURN statement will be used before here. */
18128 __builtin_unreachable ();
18129 }
18130
18131
18132 /*
18133 doDependants - return the dependentState depending upon whether
18134 all dependants have been declared.
18135 */
18136
18137 static decl_dependentState doDependants (alists_alist l, decl_node n)
18138 {
18139 switch (n->kind)
18140 {
18141 case decl_throw:
18142 case decl_varargs:
18143 case decl_address:
18144 case decl_loc:
18145 case decl_byte:
18146 case decl_word:
18147 case decl_csizet:
18148 case decl_cssizet:
18149 case decl_boolean:
18150 case decl_char:
18151 case decl_cardinal:
18152 case decl_longcard:
18153 case decl_shortcard:
18154 case decl_integer:
18155 case decl_longint:
18156 case decl_shortint:
18157 case decl_real:
18158 case decl_longreal:
18159 case decl_shortreal:
18160 case decl_bitset:
18161 case decl_ztype:
18162 case decl_rtype:
18163 case decl_complex:
18164 case decl_longcomplex:
18165 case decl_shortcomplex:
18166 case decl_proc:
18167 /* base types. */
18168 return decl_completed;
18169 break;
18170
18171 case decl_type:
18172 /* language features and compound type attributes. */
18173 return walkType (l, n);
18174 break;
18175
18176 case decl_record:
18177 return walkRecord (l, n);
18178 break;
18179
18180 case decl_varient:
18181 return walkVarient (l, n);
18182 break;
18183
18184 case decl_var:
18185 return walkVar (l, n);
18186 break;
18187
18188 case decl_enumeration:
18189 return walkEnumeration (l, n);
18190 break;
18191
18192 case decl_subrange:
18193 return walkSubrange (l, n);
18194 break;
18195
18196 case decl_pointer:
18197 return walkPointer (l, n);
18198 break;
18199
18200 case decl_array:
18201 return walkArray (l, n);
18202 break;
18203
18204 case decl_string:
18205 return decl_completed;
18206 break;
18207
18208 case decl_const:
18209 return walkConst (l, n);
18210 break;
18211
18212 case decl_literal:
18213 return decl_completed;
18214 break;
18215
18216 case decl_varparam:
18217 return walkVarParam (l, n);
18218 break;
18219
18220 case decl_param:
18221 return walkParam (l, n);
18222 break;
18223
18224 case decl_optarg:
18225 return walkOptarg (l, n);
18226 break;
18227
18228 case decl_recordfield:
18229 return walkRecordField (l, n);
18230 break;
18231
18232 case decl_varientfield:
18233 return walkVarientField (l, n);
18234 break;
18235
18236 case decl_enumerationfield:
18237 return walkEnumerationField (l, n);
18238 break;
18239
18240 case decl_set:
18241 return walkSet (l, n);
18242 break;
18243
18244 case decl_proctype:
18245 return walkProcType (l, n);
18246 break;
18247
18248 case decl_subscript:
18249 return walkSubscript (l, n);
18250 break;
18251
18252 case decl_procedure:
18253 /* blocks. */
18254 return walkProcedure (l, n);
18255 break;
18256
18257 case decl_def:
18258 case decl_imp:
18259 case decl_module:
18260 case decl_loop:
18261 case decl_while:
18262 case decl_for:
18263 case decl_repeat:
18264 case decl_if:
18265 case decl_elsif:
18266 case decl_assignment:
18267 /* statements. */
18268 M2RTS_HALT (-1);
18269 __builtin_unreachable ();
18270 break;
18271
18272 case decl_componentref:
18273 /* expressions. */
18274 return walkComponentRef (l, n);
18275 break;
18276
18277 case decl_pointerref:
18278 return walkPointerRef (l, n);
18279 break;
18280
18281 case decl_not:
18282 case decl_abs:
18283 case decl_min:
18284 case decl_max:
18285 case decl_chr:
18286 case decl_cap:
18287 case decl_ord:
18288 case decl_float:
18289 case decl_trunc:
18290 case decl_high:
18291 return walkUnary (l, n);
18292 break;
18293
18294 case decl_cast:
18295 case decl_val:
18296 case decl_plus:
18297 case decl_sub:
18298 case decl_div:
18299 case decl_mod:
18300 case decl_mult:
18301 case decl_divide:
18302 return walkBinary (l, n);
18303 break;
18304
18305 case decl_constexp:
18306 case decl_neg:
18307 case decl_adr:
18308 case decl_size:
18309 case decl_tsize:
18310 case decl_deref:
18311 return walkUnary (l, n);
18312 break;
18313
18314 case decl_equal:
18315 case decl_notequal:
18316 case decl_less:
18317 case decl_greater:
18318 case decl_greequal:
18319 case decl_lessequal:
18320 return walkBinary (l, n);
18321 break;
18322
18323 case decl_funccall:
18324 return walkFuncCall (l, n);
18325 break;
18326
18327 case decl_setvalue:
18328 return walkSetValue (l, n);
18329 break;
18330
18331
18332 default:
18333 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
18334 __builtin_unreachable ();
18335 }
18336 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
18337 __builtin_unreachable ();
18338 }
18339
18340
18341 /*
18342 tryComplete - returns TRUE if node, n, can be and was completed.
18343 */
18344
18345 static bool tryComplete (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v)
18346 {
18347 if (decl_isEnumeration (n))
18348 {
18349 /* can always emit enumerated types. */
18350 output (n, c, t, v);
18351 return true;
18352 }
18353 else if (((decl_isType (n)) && (decl_isTypeHidden (n))) && ((decl_getType (n)) == NULL))
18354 {
18355 /* avoid dangling else. */
18356 /* can always emit hidden types. */
18357 outputHidden (n);
18358 return true;
18359 }
18360 else if ((allDependants (n)) == decl_completed)
18361 {
18362 /* avoid dangling else. */
18363 output (n, c, t, v);
18364 return true;
18365 }
18366 return false;
18367 /* static analysis guarentees a RETURN statement will be used before here. */
18368 __builtin_unreachable ();
18369 }
18370
18371
18372 /*
18373 tryCompleteFromPartial -
18374 */
18375
18376 static bool tryCompleteFromPartial (decl_node n, decl_nodeProcedure t)
18377 {
18378 if ((((decl_isType (n)) && ((decl_getType (n)) != NULL)) && (decl_isPointer (decl_getType (n)))) && ((allDependants (decl_getType (n))) == decl_completed))
18379 {
18380 /* alists.includeItemIntoList (partialQ, getType (n)) ; */
18381 outputHiddenComplete (n);
18382 return true;
18383 }
18384 else if ((allDependants (n)) == decl_completed)
18385 {
18386 /* avoid dangling else. */
18387 (*t.proc) (n);
18388 return true;
18389 }
18390 return false;
18391 /* static analysis guarentees a RETURN statement will be used before here. */
18392 __builtin_unreachable ();
18393 }
18394
18395
18396 /*
18397 visitIntrinsicFunction -
18398 */
18399
18400 static void visitIntrinsicFunction (alists_alist v, decl_node n, decl_nodeProcedure p)
18401 {
18402 mcDebug_assert (isIntrinsicFunction (n));
18403 switch (n->kind)
18404 {
18405 case decl_val:
18406 case decl_cmplx:
18407 visitNode (v, n->binaryF.left, p);
18408 visitNode (v, n->binaryF.right, p);
18409 visitNode (v, n->binaryF.resultType, p);
18410 break;
18411
18412 case decl_length:
18413 case decl_adr:
18414 case decl_size:
18415 case decl_tsize:
18416 case decl_float:
18417 case decl_trunc:
18418 case decl_ord:
18419 case decl_chr:
18420 case decl_cap:
18421 case decl_abs:
18422 case decl_high:
18423 case decl_min:
18424 case decl_max:
18425 case decl_re:
18426 case decl_im:
18427 visitNode (v, n->unaryF.arg, p);
18428 visitNode (v, n->unaryF.resultType, p);
18429 break;
18430
18431
18432 default:
18433 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
18434 __builtin_unreachable ();
18435 }
18436 }
18437
18438
18439 /*
18440 visitUnary -
18441 */
18442
18443 static void visitUnary (alists_alist v, decl_node n, decl_nodeProcedure p)
18444 {
18445 mcDebug_assert (isUnary (n));
18446 visitNode (v, n->unaryF.arg, p);
18447 visitNode (v, n->unaryF.resultType, p);
18448 }
18449
18450
18451 /*
18452 visitBinary -
18453 */
18454
18455 static void visitBinary (alists_alist v, decl_node n, decl_nodeProcedure p)
18456 {
18457 visitNode (v, n->binaryF.left, p);
18458 visitNode (v, n->binaryF.right, p);
18459 visitNode (v, n->binaryF.resultType, p);
18460 }
18461
18462
18463 /*
18464 visitBoolean -
18465 */
18466
18467 static void visitBoolean (alists_alist v, decl_node n, decl_nodeProcedure p)
18468 {
18469 visitNode (v, falseN, p);
18470 visitNode (v, trueN, p);
18471 }
18472
18473
18474 /*
18475 visitScope -
18476 */
18477
18478 static void visitScope (alists_alist v, decl_node n, decl_nodeProcedure p)
18479 {
18480 if (mustVisitScope)
18481 {
18482 visitNode (v, n, p);
18483 }
18484 }
18485
18486
18487 /*
18488 visitType -
18489 */
18490
18491 static void visitType (alists_alist v, decl_node n, decl_nodeProcedure p)
18492 {
18493 mcDebug_assert (decl_isType (n));
18494 visitNode (v, n->typeF.type, p);
18495 visitScope (v, n->typeF.scope, p);
18496 }
18497
18498
18499 /*
18500 visitIndex -
18501 */
18502
18503 static void visitIndex (alists_alist v, Indexing_Index i, decl_nodeProcedure p)
18504 {
18505 unsigned int j;
18506 unsigned int h;
18507
18508 j = 1;
18509 h = Indexing_HighIndice (i);
18510 while (j <= h)
18511 {
18512 visitNode (v, reinterpret_cast<decl_node> (Indexing_GetIndice (i, j)), p);
18513 j += 1;
18514 }
18515 }
18516
18517
18518 /*
18519 visitRecord -
18520 */
18521
18522 static void visitRecord (alists_alist v, decl_node n, decl_nodeProcedure p)
18523 {
18524 mcDebug_assert (decl_isRecord (n));
18525 visitScope (v, n->recordF.scope, p);
18526 visitIndex (v, n->recordF.listOfSons, p);
18527 }
18528
18529
18530 /*
18531 visitVarient -
18532 */
18533
18534 static void visitVarient (alists_alist v, decl_node n, decl_nodeProcedure p)
18535 {
18536 mcDebug_assert (decl_isVarient (n));
18537 visitIndex (v, n->varientF.listOfSons, p);
18538 visitNode (v, n->varientF.varient, p);
18539 visitNode (v, n->varientF.tag, p);
18540 visitScope (v, n->varientF.scope, p);
18541 }
18542
18543
18544 /*
18545 visitVar -
18546 */
18547
18548 static void visitVar (alists_alist v, decl_node n, decl_nodeProcedure p)
18549 {
18550 mcDebug_assert (decl_isVar (n));
18551 visitNode (v, n->varF.type, p);
18552 visitNode (v, n->varF.decl, p);
18553 visitScope (v, n->varF.scope, p);
18554 }
18555
18556
18557 /*
18558 visitEnumeration -
18559 */
18560
18561 static void visitEnumeration (alists_alist v, decl_node n, decl_nodeProcedure p)
18562 {
18563 mcDebug_assert (decl_isEnumeration (n));
18564 visitIndex (v, n->enumerationF.listOfSons, p);
18565 visitScope (v, n->enumerationF.scope, p);
18566 }
18567
18568
18569 /*
18570 visitSubrange -
18571 */
18572
18573 static void visitSubrange (alists_alist v, decl_node n, decl_nodeProcedure p)
18574 {
18575 mcDebug_assert (decl_isSubrange (n));
18576 visitNode (v, n->subrangeF.low, p);
18577 visitNode (v, n->subrangeF.high, p);
18578 visitNode (v, n->subrangeF.type, p);
18579 visitScope (v, n->subrangeF.scope, p);
18580 }
18581
18582
18583 /*
18584 visitPointer -
18585 */
18586
18587 static void visitPointer (alists_alist v, decl_node n, decl_nodeProcedure p)
18588 {
18589 mcDebug_assert (decl_isPointer (n));
18590 visitNode (v, n->pointerF.type, p);
18591 visitScope (v, n->pointerF.scope, p);
18592 }
18593
18594
18595 /*
18596 visitArray -
18597 */
18598
18599 static void visitArray (alists_alist v, decl_node n, decl_nodeProcedure p)
18600 {
18601 mcDebug_assert (decl_isArray (n));
18602 visitNode (v, n->arrayF.subr, p);
18603 visitNode (v, n->arrayF.type, p);
18604 visitScope (v, n->arrayF.scope, p);
18605 }
18606
18607
18608 /*
18609 visitConst -
18610 */
18611
18612 static void visitConst (alists_alist v, decl_node n, decl_nodeProcedure p)
18613 {
18614 mcDebug_assert (decl_isConst (n));
18615 visitNode (v, n->constF.type, p);
18616 visitNode (v, n->constF.value, p);
18617 visitScope (v, n->constF.scope, p);
18618 }
18619
18620
18621 /*
18622 visitVarParam -
18623 */
18624
18625 static void visitVarParam (alists_alist v, decl_node n, decl_nodeProcedure p)
18626 {
18627 mcDebug_assert (decl_isVarParam (n));
18628 visitNode (v, n->varparamF.namelist, p);
18629 visitNode (v, n->varparamF.type, p);
18630 visitScope (v, n->varparamF.scope, p);
18631 }
18632
18633
18634 /*
18635 visitParam -
18636 */
18637
18638 static void visitParam (alists_alist v, decl_node n, decl_nodeProcedure p)
18639 {
18640 mcDebug_assert (decl_isParam (n));
18641 visitNode (v, n->paramF.namelist, p);
18642 visitNode (v, n->paramF.type, p);
18643 visitScope (v, n->paramF.scope, p);
18644 }
18645
18646
18647 /*
18648 visitOptarg -
18649 */
18650
18651 static void visitOptarg (alists_alist v, decl_node n, decl_nodeProcedure p)
18652 {
18653 mcDebug_assert (decl_isOptarg (n));
18654 visitNode (v, n->optargF.namelist, p);
18655 visitNode (v, n->optargF.type, p);
18656 visitNode (v, n->optargF.init, p);
18657 visitScope (v, n->optargF.scope, p);
18658 }
18659
18660
18661 /*
18662 visitRecordField -
18663 */
18664
18665 static void visitRecordField (alists_alist v, decl_node n, decl_nodeProcedure p)
18666 {
18667 mcDebug_assert (decl_isRecordField (n));
18668 visitNode (v, n->recordfieldF.type, p);
18669 visitNode (v, n->recordfieldF.parent, p);
18670 visitNode (v, n->recordfieldF.varient, p);
18671 visitScope (v, n->recordfieldF.scope, p);
18672 }
18673
18674
18675 /*
18676 visitVarientField -
18677 */
18678
18679 static void visitVarientField (alists_alist v, decl_node n, decl_nodeProcedure p)
18680 {
18681 mcDebug_assert (decl_isVarientField (n));
18682 visitNode (v, n->varientfieldF.parent, p);
18683 visitNode (v, n->varientfieldF.varient, p);
18684 visitIndex (v, n->varientfieldF.listOfSons, p);
18685 visitScope (v, n->varientfieldF.scope, p);
18686 }
18687
18688
18689 /*
18690 visitEnumerationField -
18691 */
18692
18693 static void visitEnumerationField (alists_alist v, decl_node n, decl_nodeProcedure p)
18694 {
18695 mcDebug_assert (decl_isEnumerationField (n));
18696 visitNode (v, n->enumerationfieldF.type, p);
18697 visitScope (v, n->enumerationfieldF.scope, p);
18698 }
18699
18700
18701 /*
18702 visitSet -
18703 */
18704
18705 static void visitSet (alists_alist v, decl_node n, decl_nodeProcedure p)
18706 {
18707 mcDebug_assert (decl_isSet (n));
18708 visitNode (v, n->setF.type, p);
18709 visitScope (v, n->setF.scope, p);
18710 }
18711
18712
18713 /*
18714 visitProcType -
18715 */
18716
18717 static void visitProcType (alists_alist v, decl_node n, decl_nodeProcedure p)
18718 {
18719 mcDebug_assert (decl_isProcType (n));
18720 visitIndex (v, n->proctypeF.parameters, p);
18721 visitNode (v, n->proctypeF.optarg_, p);
18722 visitNode (v, n->proctypeF.returnType, p);
18723 visitScope (v, n->proctypeF.scope, p);
18724 }
18725
18726
18727 /*
18728 visitSubscript -
18729 */
18730
18731 static void visitSubscript (alists_alist v, decl_node n, decl_nodeProcedure p)
18732 {
18733 }
18734
18735
18736 /*
18737 visitDecls -
18738 */
18739
18740 static void visitDecls (alists_alist v, decl_scopeT s, decl_nodeProcedure p)
18741 {
18742 visitIndex (v, s.constants, p);
18743 visitIndex (v, s.types, p);
18744 visitIndex (v, s.procedures, p);
18745 visitIndex (v, s.variables, p);
18746 }
18747
18748
18749 /*
18750 visitProcedure -
18751 */
18752
18753 static void visitProcedure (alists_alist v, decl_node n, decl_nodeProcedure p)
18754 {
18755 mcDebug_assert (decl_isProcedure (n));
18756 visitDecls (v, n->procedureF.decls, p);
18757 visitScope (v, n->procedureF.scope, p);
18758 visitIndex (v, n->procedureF.parameters, p);
18759 visitNode (v, n->procedureF.optarg_, p);
18760 visitNode (v, n->procedureF.returnType, p);
18761 visitNode (v, n->procedureF.beginStatements, p);
18762 }
18763
18764
18765 /*
18766 visitDef -
18767 */
18768
18769 static void visitDef (alists_alist v, decl_node n, decl_nodeProcedure p)
18770 {
18771 mcDebug_assert (decl_isDef (n));
18772 visitDecls (v, n->defF.decls, p);
18773 }
18774
18775
18776 /*
18777 visitImp -
18778 */
18779
18780 static void visitImp (alists_alist v, decl_node n, decl_nodeProcedure p)
18781 {
18782 mcDebug_assert (decl_isImp (n));
18783 visitDecls (v, n->impF.decls, p);
18784 visitNode (v, n->impF.beginStatements, p);
18785 /* --fixme-- do we need to visit definitionModule? */
18786 visitNode (v, n->impF.finallyStatements, p);
18787 }
18788
18789
18790 /*
18791 visitModule -
18792 */
18793
18794 static void visitModule (alists_alist v, decl_node n, decl_nodeProcedure p)
18795 {
18796 mcDebug_assert (decl_isModule (n));
18797 visitDecls (v, n->moduleF.decls, p);
18798 visitNode (v, n->moduleF.beginStatements, p);
18799 visitNode (v, n->moduleF.finallyStatements, p);
18800 }
18801
18802
18803 /*
18804 visitLoop -
18805 */
18806
18807 static void visitLoop (alists_alist v, decl_node n, decl_nodeProcedure p)
18808 {
18809 mcDebug_assert (decl_isLoop (n));
18810 visitNode (v, n->loopF.statements, p);
18811 }
18812
18813
18814 /*
18815 visitWhile -
18816 */
18817
18818 static void visitWhile (alists_alist v, decl_node n, decl_nodeProcedure p)
18819 {
18820 mcDebug_assert (decl_isWhile (n));
18821 visitNode (v, n->whileF.expr, p);
18822 visitNode (v, n->whileF.statements, p);
18823 }
18824
18825
18826 /*
18827 visitRepeat -
18828 */
18829
18830 static void visitRepeat (alists_alist v, decl_node n, decl_nodeProcedure p)
18831 {
18832 mcDebug_assert (decl_isRepeat (n));
18833 visitNode (v, n->repeatF.expr, p);
18834 visitNode (v, n->repeatF.statements, p);
18835 }
18836
18837
18838 /*
18839 visitCase -
18840 */
18841
18842 static void visitCase (alists_alist v, decl_node n, decl_nodeProcedure p)
18843 {
18844 mcDebug_assert (decl_isCase (n));
18845 visitNode (v, n->caseF.expression, p);
18846 visitIndex (v, n->caseF.caseLabelList, p);
18847 visitNode (v, n->caseF.else_, p);
18848 }
18849
18850
18851 /*
18852 visitCaseLabelList -
18853 */
18854
18855 static void visitCaseLabelList (alists_alist v, decl_node n, decl_nodeProcedure p)
18856 {
18857 mcDebug_assert (decl_isCaseLabelList (n));
18858 visitNode (v, n->caselabellistF.caseList, p);
18859 visitNode (v, n->caselabellistF.statements, p);
18860 }
18861
18862
18863 /*
18864 visitCaseList -
18865 */
18866
18867 static void visitCaseList (alists_alist v, decl_node n, decl_nodeProcedure p)
18868 {
18869 mcDebug_assert (decl_isCaseList (n));
18870 visitIndex (v, n->caselistF.rangePairs, p);
18871 }
18872
18873
18874 /*
18875 visitRange -
18876 */
18877
18878 static void visitRange (alists_alist v, decl_node n, decl_nodeProcedure p)
18879 {
18880 mcDebug_assert (decl_isRange (n));
18881 visitNode (v, n->rangeF.lo, p);
18882 visitNode (v, n->rangeF.hi, p);
18883 }
18884
18885
18886 /*
18887 visitIf -
18888 */
18889
18890 static void visitIf (alists_alist v, decl_node n, decl_nodeProcedure p)
18891 {
18892 mcDebug_assert (decl_isIf (n));
18893 visitNode (v, n->ifF.expr, p);
18894 visitNode (v, n->ifF.elsif, p);
18895 visitNode (v, n->ifF.then, p);
18896 visitNode (v, n->ifF.else_, p);
18897 }
18898
18899
18900 /*
18901 visitElsif -
18902 */
18903
18904 static void visitElsif (alists_alist v, decl_node n, decl_nodeProcedure p)
18905 {
18906 mcDebug_assert (decl_isElsif (n));
18907 visitNode (v, n->elsifF.expr, p);
18908 visitNode (v, n->elsifF.elsif, p);
18909 visitNode (v, n->elsifF.then, p);
18910 visitNode (v, n->elsifF.else_, p);
18911 }
18912
18913
18914 /*
18915 visitFor -
18916 */
18917
18918 static void visitFor (alists_alist v, decl_node n, decl_nodeProcedure p)
18919 {
18920 mcDebug_assert (decl_isFor (n));
18921 visitNode (v, n->forF.des, p);
18922 visitNode (v, n->forF.start, p);
18923 visitNode (v, n->forF.end, p);
18924 visitNode (v, n->forF.increment, p);
18925 visitNode (v, n->forF.statements, p);
18926 }
18927
18928
18929 /*
18930 visitAssignment -
18931 */
18932
18933 static void visitAssignment (alists_alist v, decl_node n, decl_nodeProcedure p)
18934 {
18935 mcDebug_assert (isAssignment (n));
18936 visitNode (v, n->assignmentF.des, p);
18937 visitNode (v, n->assignmentF.expr, p);
18938 }
18939
18940
18941 /*
18942 visitComponentRef -
18943 */
18944
18945 static void visitComponentRef (alists_alist v, decl_node n, decl_nodeProcedure p)
18946 {
18947 mcDebug_assert (isComponentRef (n));
18948 visitNode (v, n->componentrefF.rec, p);
18949 visitNode (v, n->componentrefF.field, p);
18950 visitNode (v, n->componentrefF.resultType, p);
18951 }
18952
18953
18954 /*
18955 visitPointerRef -
18956 */
18957
18958 static void visitPointerRef (alists_alist v, decl_node n, decl_nodeProcedure p)
18959 {
18960 mcDebug_assert (decl_isPointerRef (n));
18961 visitNode (v, n->pointerrefF.ptr, p);
18962 visitNode (v, n->pointerrefF.field, p);
18963 visitNode (v, n->pointerrefF.resultType, p);
18964 }
18965
18966
18967 /*
18968 visitArrayRef -
18969 */
18970
18971 static void visitArrayRef (alists_alist v, decl_node n, decl_nodeProcedure p)
18972 {
18973 mcDebug_assert (isArrayRef (n));
18974 visitNode (v, n->arrayrefF.array, p);
18975 visitNode (v, n->arrayrefF.index, p);
18976 visitNode (v, n->arrayrefF.resultType, p);
18977 }
18978
18979
18980 /*
18981 visitFunccall -
18982 */
18983
18984 static void visitFunccall (alists_alist v, decl_node n, decl_nodeProcedure p)
18985 {
18986 mcDebug_assert (isFuncCall (n));
18987 visitNode (v, n->funccallF.function, p);
18988 visitNode (v, n->funccallF.args, p);
18989 visitNode (v, n->funccallF.type, p);
18990 }
18991
18992
18993 /*
18994 visitVarDecl -
18995 */
18996
18997 static void visitVarDecl (alists_alist v, decl_node n, decl_nodeProcedure p)
18998 {
18999 mcDebug_assert (isVarDecl (n));
19000 visitNode (v, n->vardeclF.type, p);
19001 visitScope (v, n->vardeclF.scope, p);
19002 }
19003
19004
19005 /*
19006 visitExplist -
19007 */
19008
19009 static void visitExplist (alists_alist v, decl_node n, decl_nodeProcedure p)
19010 {
19011 mcDebug_assert (decl_isExpList (n));
19012 visitIndex (v, n->explistF.exp, p);
19013 }
19014
19015
19016 /*
19017 visitExit -
19018 */
19019
19020 static void visitExit (alists_alist v, decl_node n, decl_nodeProcedure p)
19021 {
19022 mcDebug_assert (decl_isExit (n));
19023 visitNode (v, n->exitF.loop, p);
19024 }
19025
19026
19027 /*
19028 visitReturn -
19029 */
19030
19031 static void visitReturn (alists_alist v, decl_node n, decl_nodeProcedure p)
19032 {
19033 mcDebug_assert (decl_isReturn (n));
19034 visitNode (v, n->returnF.exp, p);
19035 }
19036
19037
19038 /*
19039 visitStmtSeq -
19040 */
19041
19042 static void visitStmtSeq (alists_alist v, decl_node n, decl_nodeProcedure p)
19043 {
19044 mcDebug_assert (decl_isStatementSequence (n));
19045 visitIndex (v, n->stmtF.statements, p);
19046 }
19047
19048
19049 /*
19050 visitVarargs -
19051 */
19052
19053 static void visitVarargs (alists_alist v, decl_node n, decl_nodeProcedure p)
19054 {
19055 mcDebug_assert (decl_isVarargs (n));
19056 visitScope (v, n->varargsF.scope, p);
19057 }
19058
19059
19060 /*
19061 visitSetValue -
19062 */
19063
19064 static void visitSetValue (alists_alist v, decl_node n, decl_nodeProcedure p)
19065 {
19066 mcDebug_assert (decl_isSetValue (n));
19067 visitNode (v, n->setvalueF.type, p);
19068 visitIndex (v, n->setvalueF.values, p);
19069 }
19070
19071
19072 /*
19073 visitIntrinsic -
19074 */
19075
19076 static void visitIntrinsic (alists_alist v, decl_node n, decl_nodeProcedure p)
19077 {
19078 mcDebug_assert (isIntrinsic (n));
19079 visitNode (v, n->intrinsicF.args, p);
19080 }
19081
19082
19083 /*
19084 visitDependants - helper procedure function called from visitNode.
19085 node n has just been visited, this procedure will
19086 visit node, n, dependants.
19087 */
19088
19089 static void visitDependants (alists_alist v, decl_node n, decl_nodeProcedure p)
19090 {
19091 mcDebug_assert (n != NULL);
19092 mcDebug_assert (alists_isItemInList (v, reinterpret_cast<void *> (n)));
19093 switch (n->kind)
19094 {
19095 case decl_explist:
19096 visitExplist (v, n, p);
19097 break;
19098
19099 case decl_funccall:
19100 visitFunccall (v, n, p);
19101 break;
19102
19103 case decl_exit:
19104 visitExit (v, n, p);
19105 break;
19106
19107 case decl_return:
19108 visitReturn (v, n, p);
19109 break;
19110
19111 case decl_stmtseq:
19112 visitStmtSeq (v, n, p);
19113 break;
19114
19115 case decl_comment:
19116 break;
19117
19118 case decl_length:
19119 visitIntrinsicFunction (v, n, p);
19120 break;
19121
19122 case decl_unreachable:
19123 case decl_throw:
19124 case decl_halt:
19125 case decl_new:
19126 case decl_dispose:
19127 case decl_inc:
19128 case decl_dec:
19129 case decl_incl:
19130 case decl_excl:
19131 visitIntrinsic (v, n, p);
19132 break;
19133
19134 case decl_boolean:
19135 visitBoolean (v, n, p);
19136 break;
19137
19138 case decl_nil:
19139 case decl_false:
19140 case decl_true:
19141 break;
19142
19143 case decl_varargs:
19144 visitVarargs (v, n, p);
19145 break;
19146
19147 case decl_address:
19148 case decl_loc:
19149 case decl_byte:
19150 case decl_word:
19151 case decl_csizet:
19152 case decl_cssizet:
19153 case decl_char:
19154 case decl_cardinal:
19155 case decl_longcard:
19156 case decl_shortcard:
19157 case decl_integer:
19158 case decl_longint:
19159 case decl_shortint:
19160 case decl_real:
19161 case decl_longreal:
19162 case decl_shortreal:
19163 case decl_bitset:
19164 case decl_ztype:
19165 case decl_rtype:
19166 case decl_complex:
19167 case decl_longcomplex:
19168 case decl_shortcomplex:
19169 case decl_proc:
19170 break;
19171
19172 case decl_type:
19173 /* language features and compound type attributes. */
19174 visitType (v, n, p);
19175 break;
19176
19177 case decl_record:
19178 visitRecord (v, n, p);
19179 break;
19180
19181 case decl_varient:
19182 visitVarient (v, n, p);
19183 break;
19184
19185 case decl_var:
19186 visitVar (v, n, p);
19187 break;
19188
19189 case decl_enumeration:
19190 visitEnumeration (v, n, p);
19191 break;
19192
19193 case decl_subrange:
19194 visitSubrange (v, n, p);
19195 break;
19196
19197 case decl_pointer:
19198 visitPointer (v, n, p);
19199 break;
19200
19201 case decl_array:
19202 visitArray (v, n, p);
19203 break;
19204
19205 case decl_string:
19206 break;
19207
19208 case decl_const:
19209 visitConst (v, n, p);
19210 break;
19211
19212 case decl_literal:
19213 break;
19214
19215 case decl_varparam:
19216 visitVarParam (v, n, p);
19217 break;
19218
19219 case decl_param:
19220 visitParam (v, n, p);
19221 break;
19222
19223 case decl_optarg:
19224 visitOptarg (v, n, p);
19225 break;
19226
19227 case decl_recordfield:
19228 visitRecordField (v, n, p);
19229 break;
19230
19231 case decl_varientfield:
19232 visitVarientField (v, n, p);
19233 break;
19234
19235 case decl_enumerationfield:
19236 visitEnumerationField (v, n, p);
19237 break;
19238
19239 case decl_set:
19240 visitSet (v, n, p);
19241 break;
19242
19243 case decl_proctype:
19244 visitProcType (v, n, p);
19245 break;
19246
19247 case decl_subscript:
19248 visitSubscript (v, n, p);
19249 break;
19250
19251 case decl_procedure:
19252 /* blocks. */
19253 visitProcedure (v, n, p);
19254 break;
19255
19256 case decl_def:
19257 visitDef (v, n, p);
19258 break;
19259
19260 case decl_imp:
19261 visitImp (v, n, p);
19262 break;
19263
19264 case decl_module:
19265 visitModule (v, n, p);
19266 break;
19267
19268 case decl_loop:
19269 /* statements. */
19270 visitLoop (v, n, p);
19271 break;
19272
19273 case decl_while:
19274 visitWhile (v, n, p);
19275 break;
19276
19277 case decl_for:
19278 visitFor (v, n, p);
19279 break;
19280
19281 case decl_repeat:
19282 visitRepeat (v, n, p);
19283 break;
19284
19285 case decl_case:
19286 visitCase (v, n, p);
19287 break;
19288
19289 case decl_caselabellist:
19290 visitCaseLabelList (v, n, p);
19291 break;
19292
19293 case decl_caselist:
19294 visitCaseList (v, n, p);
19295 break;
19296
19297 case decl_range:
19298 visitRange (v, n, p);
19299 break;
19300
19301 case decl_if:
19302 visitIf (v, n, p);
19303 break;
19304
19305 case decl_elsif:
19306 visitElsif (v, n, p);
19307 break;
19308
19309 case decl_assignment:
19310 visitAssignment (v, n, p);
19311 break;
19312
19313 case decl_componentref:
19314 /* expressions. */
19315 visitComponentRef (v, n, p);
19316 break;
19317
19318 case decl_pointerref:
19319 visitPointerRef (v, n, p);
19320 break;
19321
19322 case decl_arrayref:
19323 visitArrayRef (v, n, p);
19324 break;
19325
19326 case decl_cmplx:
19327 case decl_equal:
19328 case decl_notequal:
19329 case decl_less:
19330 case decl_greater:
19331 case decl_greequal:
19332 case decl_lessequal:
19333 case decl_and:
19334 case decl_or:
19335 case decl_in:
19336 case decl_cast:
19337 case decl_val:
19338 case decl_plus:
19339 case decl_sub:
19340 case decl_div:
19341 case decl_mod:
19342 case decl_mult:
19343 case decl_divide:
19344 visitBinary (v, n, p);
19345 break;
19346
19347 case decl_re:
19348 visitUnary (v, n, p);
19349 break;
19350
19351 case decl_im:
19352 visitUnary (v, n, p);
19353 break;
19354
19355 case decl_abs:
19356 visitUnary (v, n, p);
19357 break;
19358
19359 case decl_chr:
19360 visitUnary (v, n, p);
19361 break;
19362
19363 case decl_cap:
19364 visitUnary (v, n, p);
19365 break;
19366
19367 case decl_high:
19368 visitUnary (v, n, p);
19369 break;
19370
19371 case decl_ord:
19372 visitUnary (v, n, p);
19373 break;
19374
19375 case decl_float:
19376 visitUnary (v, n, p);
19377 break;
19378
19379 case decl_trunc:
19380 visitUnary (v, n, p);
19381 break;
19382
19383 case decl_not:
19384 visitUnary (v, n, p);
19385 break;
19386
19387 case decl_neg:
19388 visitUnary (v, n, p);
19389 break;
19390
19391 case decl_adr:
19392 visitUnary (v, n, p);
19393 break;
19394
19395 case decl_size:
19396 visitUnary (v, n, p);
19397 break;
19398
19399 case decl_tsize:
19400 visitUnary (v, n, p);
19401 break;
19402
19403 case decl_min:
19404 visitUnary (v, n, p);
19405 break;
19406
19407 case decl_max:
19408 visitUnary (v, n, p);
19409 break;
19410
19411 case decl_constexp:
19412 visitUnary (v, n, p);
19413 break;
19414
19415 case decl_deref:
19416 visitUnary (v, n, p);
19417 break;
19418
19419 case decl_identlist:
19420 break;
19421
19422 case decl_vardecl:
19423 visitVarDecl (v, n, p);
19424 break;
19425
19426 case decl_setvalue:
19427 visitSetValue (v, n, p);
19428 break;
19429
19430
19431 default:
19432 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
19433 __builtin_unreachable ();
19434 }
19435 }
19436
19437
19438 /*
19439 visitNode - visits node, n, if it is not already in the alist, v.
19440 It calls p(n) if the node is unvisited.
19441 */
19442
19443 static void visitNode (alists_alist v, decl_node n, decl_nodeProcedure p)
19444 {
19445 if ((n != NULL) && (! (alists_isItemInList (v, reinterpret_cast<void *> (n)))))
19446 {
19447 alists_includeItemIntoList (v, reinterpret_cast<void *> (n));
19448 (*p.proc) (n);
19449 visitDependants (v, n, p);
19450 }
19451 }
19452
19453
19454 /*
19455 genKind - returns a string depending upon the kind of node, n.
19456 */
19457
19458 static DynamicStrings_String genKind (decl_node n)
19459 {
19460 switch (n->kind)
19461 {
19462 case decl_nil:
19463 case decl_true:
19464 case decl_false:
19465 case decl_address:
19466 case decl_loc:
19467 case decl_byte:
19468 case decl_word:
19469 case decl_csizet:
19470 case decl_cssizet:
19471 case decl_char:
19472 case decl_cardinal:
19473 case decl_longcard:
19474 case decl_shortcard:
19475 case decl_integer:
19476 case decl_longint:
19477 case decl_shortint:
19478 case decl_real:
19479 case decl_longreal:
19480 case decl_shortreal:
19481 case decl_bitset:
19482 case decl_boolean:
19483 case decl_proc:
19484 case decl_ztype:
19485 case decl_rtype:
19486 case decl_complex:
19487 case decl_longcomplex:
19488 case decl_shortcomplex:
19489 /* types, no need to generate a kind string as it it contained in the name. */
19490 return NULL;
19491 break;
19492
19493 case decl_type:
19494 /* language features and compound type attributes. */
19495 return DynamicStrings_InitString ((const char *) "type", 4);
19496 break;
19497
19498 case decl_record:
19499 return DynamicStrings_InitString ((const char *) "record", 6);
19500 break;
19501
19502 case decl_varient:
19503 return DynamicStrings_InitString ((const char *) "varient", 7);
19504 break;
19505
19506 case decl_var:
19507 return DynamicStrings_InitString ((const char *) "var", 3);
19508 break;
19509
19510 case decl_enumeration:
19511 return DynamicStrings_InitString ((const char *) "enumeration", 11);
19512 break;
19513
19514 case decl_subrange:
19515 return DynamicStrings_InitString ((const char *) "subrange", 8);
19516 break;
19517
19518 case decl_array:
19519 return DynamicStrings_InitString ((const char *) "array", 5);
19520 break;
19521
19522 case decl_subscript:
19523 return DynamicStrings_InitString ((const char *) "subscript", 9);
19524 break;
19525
19526 case decl_string:
19527 return DynamicStrings_InitString ((const char *) "string", 6);
19528 break;
19529
19530 case decl_const:
19531 return DynamicStrings_InitString ((const char *) "const", 5);
19532 break;
19533
19534 case decl_literal:
19535 return DynamicStrings_InitString ((const char *) "literal", 7);
19536 break;
19537
19538 case decl_varparam:
19539 return DynamicStrings_InitString ((const char *) "varparam", 8);
19540 break;
19541
19542 case decl_param:
19543 return DynamicStrings_InitString ((const char *) "param", 5);
19544 break;
19545
19546 case decl_varargs:
19547 return DynamicStrings_InitString ((const char *) "varargs", 7);
19548 break;
19549
19550 case decl_pointer:
19551 return DynamicStrings_InitString ((const char *) "pointer", 7);
19552 break;
19553
19554 case decl_recordfield:
19555 return DynamicStrings_InitString ((const char *) "recordfield", 11);
19556 break;
19557
19558 case decl_varientfield:
19559 return DynamicStrings_InitString ((const char *) "varientfield", 12);
19560 break;
19561
19562 case decl_enumerationfield:
19563 return DynamicStrings_InitString ((const char *) "enumerationfield", 16);
19564 break;
19565
19566 case decl_set:
19567 return DynamicStrings_InitString ((const char *) "set", 3);
19568 break;
19569
19570 case decl_proctype:
19571 return DynamicStrings_InitString ((const char *) "proctype", 8);
19572 break;
19573
19574 case decl_procedure:
19575 /* blocks. */
19576 return DynamicStrings_InitString ((const char *) "procedure", 9);
19577 break;
19578
19579 case decl_def:
19580 return DynamicStrings_InitString ((const char *) "def", 3);
19581 break;
19582
19583 case decl_imp:
19584 return DynamicStrings_InitString ((const char *) "imp", 3);
19585 break;
19586
19587 case decl_module:
19588 return DynamicStrings_InitString ((const char *) "module", 6);
19589 break;
19590
19591 case decl_loop:
19592 /* statements. */
19593 return DynamicStrings_InitString ((const char *) "loop", 4);
19594 break;
19595
19596 case decl_while:
19597 return DynamicStrings_InitString ((const char *) "while", 5);
19598 break;
19599
19600 case decl_for:
19601 return DynamicStrings_InitString ((const char *) "for", 3);
19602 break;
19603
19604 case decl_repeat:
19605 return DynamicStrings_InitString ((const char *) "repeat", 6);
19606 break;
19607
19608 case decl_assignment:
19609 return DynamicStrings_InitString ((const char *) "assignment", 10);
19610 break;
19611
19612 case decl_if:
19613 return DynamicStrings_InitString ((const char *) "if", 2);
19614 break;
19615
19616 case decl_elsif:
19617 return DynamicStrings_InitString ((const char *) "elsif", 5);
19618 break;
19619
19620 case decl_constexp:
19621 /* expressions. */
19622 return DynamicStrings_InitString ((const char *) "constexp", 8);
19623 break;
19624
19625 case decl_neg:
19626 return DynamicStrings_InitString ((const char *) "neg", 3);
19627 break;
19628
19629 case decl_cast:
19630 return DynamicStrings_InitString ((const char *) "cast", 4);
19631 break;
19632
19633 case decl_val:
19634 return DynamicStrings_InitString ((const char *) "val", 3);
19635 break;
19636
19637 case decl_plus:
19638 return DynamicStrings_InitString ((const char *) "plus", 4);
19639 break;
19640
19641 case decl_sub:
19642 return DynamicStrings_InitString ((const char *) "sub", 3);
19643 break;
19644
19645 case decl_div:
19646 return DynamicStrings_InitString ((const char *) "div", 3);
19647 break;
19648
19649 case decl_mod:
19650 return DynamicStrings_InitString ((const char *) "mod", 3);
19651 break;
19652
19653 case decl_mult:
19654 return DynamicStrings_InitString ((const char *) "mult", 4);
19655 break;
19656
19657 case decl_divide:
19658 return DynamicStrings_InitString ((const char *) "divide", 6);
19659 break;
19660
19661 case decl_adr:
19662 return DynamicStrings_InitString ((const char *) "adr", 3);
19663 break;
19664
19665 case decl_size:
19666 return DynamicStrings_InitString ((const char *) "size", 4);
19667 break;
19668
19669 case decl_tsize:
19670 return DynamicStrings_InitString ((const char *) "tsize", 5);
19671 break;
19672
19673 case decl_chr:
19674 return DynamicStrings_InitString ((const char *) "chr", 3);
19675 break;
19676
19677 case decl_ord:
19678 return DynamicStrings_InitString ((const char *) "ord", 3);
19679 break;
19680
19681 case decl_float:
19682 return DynamicStrings_InitString ((const char *) "float", 5);
19683 break;
19684
19685 case decl_trunc:
19686 return DynamicStrings_InitString ((const char *) "trunc", 5);
19687 break;
19688
19689 case decl_high:
19690 return DynamicStrings_InitString ((const char *) "high", 4);
19691 break;
19692
19693 case decl_componentref:
19694 return DynamicStrings_InitString ((const char *) "componentref", 12);
19695 break;
19696
19697 case decl_pointerref:
19698 return DynamicStrings_InitString ((const char *) "pointerref", 10);
19699 break;
19700
19701 case decl_arrayref:
19702 return DynamicStrings_InitString ((const char *) "arrayref", 8);
19703 break;
19704
19705 case decl_deref:
19706 return DynamicStrings_InitString ((const char *) "deref", 5);
19707 break;
19708
19709 case decl_equal:
19710 return DynamicStrings_InitString ((const char *) "equal", 5);
19711 break;
19712
19713 case decl_notequal:
19714 return DynamicStrings_InitString ((const char *) "notequal", 8);
19715 break;
19716
19717 case decl_less:
19718 return DynamicStrings_InitString ((const char *) "less", 4);
19719 break;
19720
19721 case decl_greater:
19722 return DynamicStrings_InitString ((const char *) "greater", 7);
19723 break;
19724
19725 case decl_greequal:
19726 return DynamicStrings_InitString ((const char *) "greequal", 8);
19727 break;
19728
19729 case decl_lessequal:
19730 return DynamicStrings_InitString ((const char *) "lessequal", 9);
19731 break;
19732
19733 case decl_lsl:
19734 return DynamicStrings_InitString ((const char *) "lsl", 3);
19735 break;
19736
19737 case decl_lsr:
19738 return DynamicStrings_InitString ((const char *) "lsr", 3);
19739 break;
19740
19741 case decl_lor:
19742 return DynamicStrings_InitString ((const char *) "lor", 3);
19743 break;
19744
19745 case decl_land:
19746 return DynamicStrings_InitString ((const char *) "land", 4);
19747 break;
19748
19749 case decl_lnot:
19750 return DynamicStrings_InitString ((const char *) "lnot", 4);
19751 break;
19752
19753 case decl_lxor:
19754 return DynamicStrings_InitString ((const char *) "lxor", 4);
19755 break;
19756
19757 case decl_and:
19758 return DynamicStrings_InitString ((const char *) "and", 3);
19759 break;
19760
19761 case decl_or:
19762 return DynamicStrings_InitString ((const char *) "or", 2);
19763 break;
19764
19765 case decl_not:
19766 return DynamicStrings_InitString ((const char *) "not", 3);
19767 break;
19768
19769 case decl_identlist:
19770 return DynamicStrings_InitString ((const char *) "identlist", 9);
19771 break;
19772
19773 case decl_vardecl:
19774 return DynamicStrings_InitString ((const char *) "vardecl", 7);
19775 break;
19776
19777
19778 default:
19779 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
19780 __builtin_unreachable ();
19781 }
19782 M2RTS_HALT (-1);
19783 __builtin_unreachable ();
19784 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
19785 __builtin_unreachable ();
19786 }
19787
19788
19789 /*
19790 gen - generate a small string describing node, n.
19791 */
19792
19793 static DynamicStrings_String gen (decl_node n)
19794 {
19795 DynamicStrings_String s;
19796 unsigned int d;
19797
19798 d = (unsigned int ) ((long unsigned int ) (n));
19799 s = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "< %d ", 5), (const unsigned char *) &d, (sizeof (d)-1)); /* use 0x%x once FormatStrings has been released. */
19800 s = DynamicStrings_ConCat (s, genKind (n)); /* use 0x%x once FormatStrings has been released. */
19801 s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) " ", 1));
19802 s = DynamicStrings_ConCat (s, getFQstring (n));
19803 s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) " >", 2));
19804 return s;
19805 /* static analysis guarentees a RETURN statement will be used before here. */
19806 __builtin_unreachable ();
19807 }
19808
19809
19810 /*
19811 dumpQ -
19812 */
19813
19814 static void dumpQ (const char *q_, unsigned int _q_high, alists_alist l)
19815 {
19816 DynamicStrings_String m;
19817 decl_node n;
19818 unsigned int d;
19819 unsigned int h;
19820 unsigned int i;
19821 char q[_q_high+1];
19822
19823 /* make a local copy of each unbounded array. */
19824 memcpy (q, q_, _q_high+1);
19825
19826 m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "Queue ", 6));
19827 m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
19828 m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) q, _q_high));
19829 m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
19830 m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2));
19831 m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
19832 i = 1;
19833 h = alists_noOfItemsInList (l);
19834 while (i <= h)
19835 {
19836 n = static_cast<decl_node> (alists_getItemFromList (l, i));
19837 m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, gen (n)));
19838 i += 1;
19839 }
19840 m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2));
19841 m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
19842 }
19843
19844
19845 /*
19846 dumpLists -
19847 */
19848
19849 static void dumpLists (void)
19850 {
19851 DynamicStrings_String m;
19852
19853 if (mcOptions_getDebugTopological ())
19854 {
19855 m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2));
19856 m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
19857 dumpQ ((const char *) "todo", 4, todoQ);
19858 dumpQ ((const char *) "partial", 7, partialQ);
19859 dumpQ ((const char *) "done", 4, doneQ);
19860 }
19861 }
19862
19863
19864 /*
19865 outputHidden -
19866 */
19867
19868 static void outputHidden (decl_node n)
19869 {
19870 outText (doP, (const char *) "#if !defined (", 14);
19871 doFQNameC (doP, n);
19872 outText (doP, (const char *) "_D)\\n", 5);
19873 outText (doP, (const char *) "# define ", 10);
19874 doFQNameC (doP, n);
19875 outText (doP, (const char *) "_D\\n", 4);
19876 outText (doP, (const char *) " typedef void *", 17);
19877 doFQNameC (doP, n);
19878 outText (doP, (const char *) ";\\n", 3);
19879 outText (doP, (const char *) "#endif\\n\\n", 10);
19880 }
19881
19882
19883 /*
19884 outputHiddenComplete -
19885 */
19886
19887 static void outputHiddenComplete (decl_node n)
19888 {
19889 decl_node t;
19890
19891 mcDebug_assert (decl_isType (n));
19892 t = decl_getType (n);
19893 mcDebug_assert (decl_isPointer (t));
19894 outText (doP, (const char *) "#define ", 8);
19895 doFQNameC (doP, n);
19896 outText (doP, (const char *) "_D\\n", 4);
19897 outText (doP, (const char *) "typedef ", 8);
19898 doTypeNameC (doP, decl_getType (t));
19899 mcPretty_setNeedSpace (doP);
19900 outText (doP, (const char *) "*", 1);
19901 doFQNameC (doP, n);
19902 outText (doP, (const char *) ";\\n", 3);
19903 }
19904
19905
19906 /*
19907 tryPartial -
19908 */
19909
19910 static bool tryPartial (decl_node n, decl_nodeProcedure pt)
19911 {
19912 decl_node q;
19913
19914 if ((n != NULL) && (decl_isType (n)))
19915 {
19916 q = decl_getType (n);
19917 while (decl_isPointer (q))
19918 {
19919 q = decl_getType (q);
19920 }
19921 if (q != NULL)
19922 {
19923 /* avoid gcc warning by using compound statement even if not strictly necessary. */
19924 if ((decl_isRecord (q)) || (decl_isProcType (q)))
19925 {
19926 (*pt.proc) (n);
19927 addTodo (q);
19928 return true;
19929 }
19930 else if (decl_isArray (q))
19931 {
19932 /* avoid dangling else. */
19933 (*pt.proc) (n);
19934 addTodo (q);
19935 return true;
19936 }
19937 }
19938 }
19939 return false;
19940 /* static analysis guarentees a RETURN statement will be used before here. */
19941 __builtin_unreachable ();
19942 }
19943
19944
19945 /*
19946 outputPartialRecordArrayProcType -
19947 */
19948
19949 static void outputPartialRecordArrayProcType (decl_node n, decl_node q, unsigned int indirection)
19950 {
19951 DynamicStrings_String s;
19952
19953 outText (doP, (const char *) "typedef struct", 14);
19954 mcPretty_setNeedSpace (doP);
19955 s = getFQstring (n);
19956 if (decl_isRecord (q))
19957 {
19958 s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_r", 2)));
19959 }
19960 else if (decl_isArray (q))
19961 {
19962 /* avoid dangling else. */
19963 s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_a", 2)));
19964 }
19965 else if (decl_isProcType (q))
19966 {
19967 /* avoid dangling else. */
19968 s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_p", 2)));
19969 }
19970 outTextS (doP, s);
19971 mcPretty_setNeedSpace (doP);
19972 s = DynamicStrings_KillString (s);
19973 while (indirection > 0)
19974 {
19975 outText (doP, (const char *) "*", 1);
19976 indirection -= 1;
19977 }
19978 doFQNameC (doP, n);
19979 outText (doP, (const char *) ";\\n\\n", 5);
19980 }
19981
19982
19983 /*
19984 outputPartial -
19985 */
19986
19987 static void outputPartial (decl_node n)
19988 {
19989 decl_node q;
19990 unsigned int indirection;
19991
19992 q = decl_getType (n);
19993 indirection = 0;
19994 while (decl_isPointer (q))
19995 {
19996 q = decl_getType (q);
19997 indirection += 1;
19998 }
19999 outputPartialRecordArrayProcType (n, q, indirection);
20000 }
20001
20002
20003 /*
20004 tryOutputTodo -
20005 */
20006
20007 static void tryOutputTodo (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure pt)
20008 {
20009 unsigned int i;
20010 unsigned int n;
20011 decl_node d;
20012
20013 i = 1;
20014 n = alists_noOfItemsInList (todoQ);
20015 while (i <= n)
20016 {
20017 d = static_cast<decl_node> (alists_getItemFromList (todoQ, i));
20018 if (tryComplete (d, c, t, v))
20019 {
20020 alists_removeItemFromList (todoQ, reinterpret_cast<void *> (d));
20021 alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (d));
20022 i = 1;
20023 }
20024 else if (tryPartial (d, pt))
20025 {
20026 /* avoid dangling else. */
20027 alists_removeItemFromList (todoQ, reinterpret_cast<void *> (d));
20028 alists_includeItemIntoList (partialQ, reinterpret_cast<void *> (d));
20029 i = 1;
20030 }
20031 else
20032 {
20033 /* avoid dangling else. */
20034 i += 1;
20035 }
20036 n = alists_noOfItemsInList (todoQ);
20037 }
20038 }
20039
20040
20041 /*
20042 tryOutputPartial -
20043 */
20044
20045 static void tryOutputPartial (decl_nodeProcedure t)
20046 {
20047 unsigned int i;
20048 unsigned int n;
20049 decl_node d;
20050
20051 i = 1;
20052 n = alists_noOfItemsInList (partialQ);
20053 while (i <= n)
20054 {
20055 d = static_cast<decl_node> (alists_getItemFromList (partialQ, i));
20056 if (tryCompleteFromPartial (d, t))
20057 {
20058 alists_removeItemFromList (partialQ, reinterpret_cast<void *> (d));
20059 alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (d));
20060 i = 1;
20061 n -= 1;
20062 }
20063 else
20064 {
20065 i += 1;
20066 }
20067 }
20068 }
20069
20070
20071 /*
20072 debugList -
20073 */
20074
20075 static void debugList (const char *a_, unsigned int _a_high, alists_alist l)
20076 {
20077 unsigned int i;
20078 unsigned int h;
20079 decl_node n;
20080 char a[_a_high+1];
20081
20082 /* make a local copy of each unbounded array. */
20083 memcpy (a, a_, _a_high+1);
20084
20085 h = alists_noOfItemsInList (l);
20086 if (h > 0)
20087 {
20088 outText (doP, (const char *) a, _a_high);
20089 outText (doP, (const char *) " still contains node(s)\\n", 25);
20090 i = 1;
20091 do {
20092 n = static_cast<decl_node> (alists_getItemFromList (l, i));
20093 dbg (n);
20094 i += 1;
20095 } while (! (i > h));
20096 }
20097 }
20098
20099
20100 /*
20101 debugLists -
20102 */
20103
20104 static void debugLists (void)
20105 {
20106 if (mcOptions_getDebugTopological ())
20107 {
20108 debugList ((const char *) "todo", 4, todoQ);
20109 debugList ((const char *) "partial", 7, partialQ);
20110 }
20111 }
20112
20113
20114 /*
20115 addEnumConst -
20116 */
20117
20118 static void addEnumConst (decl_node n)
20119 {
20120 DynamicStrings_String s;
20121
20122 if ((decl_isConst (n)) || (decl_isEnumeration (n)))
20123 {
20124 addTodo (n);
20125 }
20126 }
20127
20128
20129 /*
20130 populateTodo -
20131 */
20132
20133 static void populateTodo (decl_nodeProcedure p)
20134 {
20135 decl_node n;
20136 unsigned int i;
20137 unsigned int h;
20138 alists_alist l;
20139
20140 h = alists_noOfItemsInList (todoQ);
20141 i = 1;
20142 while (i <= h)
20143 {
20144 n = static_cast<decl_node> (alists_getItemFromList (todoQ, i));
20145 l = alists_initList ();
20146 visitNode (l, n, p);
20147 alists_killList (&l);
20148 h = alists_noOfItemsInList (todoQ);
20149 i += 1;
20150 }
20151 }
20152
20153
20154 /*
20155 topologicallyOut -
20156 */
20157
20158 static void topologicallyOut (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure tp, decl_nodeProcedure pc, decl_nodeProcedure pt, decl_nodeProcedure pv)
20159 {
20160 unsigned int tol;
20161 unsigned int pal;
20162 unsigned int to;
20163 unsigned int pa;
20164
20165 populateTodo ((decl_nodeProcedure) {(decl_nodeProcedure_t) addEnumConst});
20166 tol = 0;
20167 pal = 0;
20168 to = alists_noOfItemsInList (todoQ);
20169 pa = alists_noOfItemsInList (partialQ);
20170 while ((tol != to) || (pal != pa))
20171 {
20172 dumpLists ();
20173 tryOutputTodo (c, t, v, tp);
20174 dumpLists ();
20175 tryOutputPartial (pt);
20176 tol = to;
20177 pal = pa;
20178 to = alists_noOfItemsInList (todoQ);
20179 pa = alists_noOfItemsInList (partialQ);
20180 }
20181 dumpLists ();
20182 debugLists ();
20183 }
20184
20185
20186 /*
20187 scaffoldStatic -
20188 */
20189
20190 static void scaffoldStatic (mcPretty_pretty p, decl_node n)
20191 {
20192 outText (p, (const char *) "\\n", 2);
20193 doExternCP (p);
20194 outText (p, (const char *) "void", 4);
20195 mcPretty_setNeedSpace (p);
20196 outText (p, (const char *) "_M2_", 4);
20197 doFQNameC (p, n);
20198 outText (p, (const char *) "_init", 5);
20199 mcPretty_setNeedSpace (p);
20200 outText (p, (const char *) "(__attribute__((unused)) int argc", 33);
20201 outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37);
20202 outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40);
20203 p = outKc (p, (const char *) "{\\n", 3);
20204 doStatementsC (p, n->impF.beginStatements);
20205 p = outKc (p, (const char *) "}\\n", 3);
20206 outText (p, (const char *) "\\n", 2);
20207 doExternCP (p);
20208 outText (p, (const char *) "void", 4);
20209 mcPretty_setNeedSpace (p);
20210 outText (p, (const char *) "_M2_", 4);
20211 doFQNameC (p, n);
20212 outText (p, (const char *) "_fini", 5);
20213 mcPretty_setNeedSpace (p);
20214 outText (p, (const char *) "(__attribute__((unused)) int argc", 33);
20215 outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37);
20216 outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40);
20217 p = outKc (p, (const char *) "{\\n", 3);
20218 doStatementsC (p, n->impF.finallyStatements);
20219 p = outKc (p, (const char *) "}\\n", 3);
20220 }
20221
20222
20223 /*
20224 emitCtor -
20225 */
20226
20227 static void emitCtor (mcPretty_pretty p, decl_node n)
20228 {
20229 DynamicStrings_String s;
20230
20231 outText (p, (const char *) "\\n", 2);
20232 outText (p, (const char *) "static void", 11);
20233 mcPretty_setNeedSpace (p);
20234 outText (p, (const char *) "ctorFunction ()\\n", 17);
20235 doFQNameC (p, n);
20236 p = outKc (p, (const char *) "{\\n", 3);
20237 outText (p, (const char *) "M2RTS_RegisterModule (\"", 23);
20238 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
20239 mcPretty_prints (p, s);
20240 outText (p, (const char *) "\",\\n", 4);
20241 outText (p, (const char *) "init, fini, dependencies);\\n", 28);
20242 p = outKc (p, (const char *) "}\\n\\n", 5);
20243 p = outKc (p, (const char *) "struct ", 7);
20244 mcPretty_prints (p, s);
20245 p = outKc (p, (const char *) "_module_m2 { ", 13);
20246 mcPretty_prints (p, s);
20247 p = outKc (p, (const char *) "_module_m2 (); ~", 16);
20248 mcPretty_prints (p, s);
20249 p = outKc (p, (const char *) "_module_m2 (); } global_module_", 31);
20250 mcPretty_prints (p, s);
20251 outText (p, (const char *) ";\\n\\n", 5);
20252 mcPretty_prints (p, s);
20253 p = outKc (p, (const char *) "_module_m2::", 12);
20254 mcPretty_prints (p, s);
20255 p = outKc (p, (const char *) "_module_m2 ()\\n", 15);
20256 p = outKc (p, (const char *) "{\\n", 3);
20257 outText (p, (const char *) "M2RTS_RegisterModule (\"", 23);
20258 mcPretty_prints (p, s);
20259 outText (p, (const char *) "\", init, fini, dependencies);", 29);
20260 p = outKc (p, (const char *) "}\\n", 3);
20261 mcPretty_prints (p, s);
20262 p = outKc (p, (const char *) "_module_m2::~", 13);
20263 mcPretty_prints (p, s);
20264 p = outKc (p, (const char *) "_module_m2 ()\\n", 15);
20265 p = outKc (p, (const char *) "{\\n", 3);
20266 p = outKc (p, (const char *) "}\\n", 3);
20267 s = DynamicStrings_KillString (s);
20268 }
20269
20270
20271 /*
20272 scaffoldDynamic -
20273 */
20274
20275 static void scaffoldDynamic (mcPretty_pretty p, decl_node n)
20276 {
20277 outText (p, (const char *) "\\n", 2);
20278 doExternCP (p);
20279 outText (p, (const char *) "void", 4);
20280 mcPretty_setNeedSpace (p);
20281 outText (p, (const char *) "_M2_", 4);
20282 doFQNameC (p, n);
20283 outText (p, (const char *) "_init", 5);
20284 mcPretty_setNeedSpace (p);
20285 outText (p, (const char *) "(__attribute__((unused)) int argc,", 34);
20286 outText (p, (const char *) " __attribute__((unused)) char *argv[]", 37);
20287 outText (p, (const char *) " __attribute__((unused)) char *envp[])\\n", 40);
20288 p = outKc (p, (const char *) "{\\n", 3);
20289 doStatementsC (p, n->impF.beginStatements);
20290 p = outKc (p, (const char *) "}\\n", 3);
20291 outText (p, (const char *) "\\n", 2);
20292 doExternCP (p);
20293 outText (p, (const char *) "void", 4);
20294 mcPretty_setNeedSpace (p);
20295 outText (p, (const char *) "_M2_", 4);
20296 doFQNameC (p, n);
20297 outText (p, (const char *) "_fini", 5);
20298 mcPretty_setNeedSpace (p);
20299 outText (p, (const char *) "(__attribute__((unused)) int argc,", 34);
20300 outText (p, (const char *) " __attribute__((unused)) char *argv[]", 37);
20301 outText (p, (const char *) " __attribute__((unused)) char *envp[])\\n", 40);
20302 p = outKc (p, (const char *) "{\\n", 3);
20303 doStatementsC (p, n->impF.finallyStatements);
20304 p = outKc (p, (const char *) "}\\n", 3);
20305 emitCtor (p, n);
20306 }
20307
20308
20309 /*
20310 scaffoldMain -
20311 */
20312
20313 static void scaffoldMain (mcPretty_pretty p, decl_node n)
20314 {
20315 DynamicStrings_String s;
20316
20317 outText (p, (const char *) "int\\n", 5);
20318 outText (p, (const char *) "main", 4);
20319 mcPretty_setNeedSpace (p);
20320 outText (p, (const char *) "(int argc, char *argv[], char *envp[])\\n", 40);
20321 p = outKc (p, (const char *) "{\\n", 3);
20322 outText (p, (const char *) "M2RTS_ConstructModules (", 24);
20323 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
20324 mcPretty_prints (p, s);
20325 outText (p, (const char *) ", argc, argv, envp);\\n", 22);
20326 outText (p, (const char *) "M2RTS_DeconstructModules (", 26);
20327 mcPretty_prints (p, s);
20328 outText (p, (const char *) ", argc, argv, envp);\\n", 22);
20329 outText (p, (const char *) "return 0;", 9);
20330 p = outKc (p, (const char *) "}\\n", 3);
20331 s = DynamicStrings_KillString (s);
20332 }
20333
20334
20335 /*
20336 outImpInitC - emit the init/fini functions and main function if required.
20337 */
20338
20339 static void outImpInitC (mcPretty_pretty p, decl_node n)
20340 {
20341 if (mcOptions_getScaffoldDynamic ())
20342 {
20343 scaffoldDynamic (p, n);
20344 }
20345 else
20346 {
20347 scaffoldStatic (p, n);
20348 }
20349 if (mcOptions_getScaffoldMain ())
20350 {
20351 scaffoldMain (p, n);
20352 }
20353 }
20354
20355
20356 /*
20357 runSimplifyTypes -
20358 */
20359
20360 static void runSimplifyTypes (decl_node n)
20361 {
20362 if (decl_isImp (n))
20363 {
20364 simplifyTypes (n->impF.decls);
20365 }
20366 else if (decl_isModule (n))
20367 {
20368 /* avoid dangling else. */
20369 simplifyTypes (n->moduleF.decls);
20370 }
20371 else if (decl_isDef (n))
20372 {
20373 /* avoid dangling else. */
20374 simplifyTypes (n->defF.decls);
20375 }
20376 }
20377
20378
20379 /*
20380 outDefC -
20381 */
20382
20383 static void outDefC (mcPretty_pretty p, decl_node n)
20384 {
20385 DynamicStrings_String s;
20386
20387 mcDebug_assert (decl_isDef (n));
20388 outputFile = mcStream_openFrag (1); /* first fragment. */
20389 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */
20390 mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50);
20391 mcPretty_prints (p, s);
20392 mcPretty_print (p, (const char *) ". */\\n", 7);
20393 mcOptions_writeGPLheader (outputFile);
20394 doCommentC (p, n->defF.com.body);
20395 mcPretty_print (p, (const char *) "\\n\\n#if !defined (_", 19);
20396 mcPretty_prints (p, s);
20397 mcPretty_print (p, (const char *) "_H)\\n", 5);
20398 mcPretty_print (p, (const char *) "# define _", 12);
20399 mcPretty_prints (p, s);
20400 mcPretty_print (p, (const char *) "_H\\n\\n", 6);
20401 keyc_genConfigSystem (p);
20402 mcPretty_print (p, (const char *) "# ifdef __cplusplus\\n", 23);
20403 mcPretty_print (p, (const char *) "extern \"C\" {\\n", 14);
20404 mcPretty_print (p, (const char *) "# endif\\n", 11);
20405 outputFile = mcStream_openFrag (3); /* third fragment. */
20406 doP = p; /* third fragment. */
20407 Indexing_ForeachIndiceInIndexDo (n->defF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC});
20408 mcPretty_print (p, (const char *) "\\n", 2);
20409 mcPretty_print (p, (const char *) "# if defined (_", 17);
20410 mcPretty_prints (p, s);
20411 mcPretty_print (p, (const char *) "_C)\\n", 5);
20412 mcPretty_print (p, (const char *) "# define EXTERN\\n", 22);
20413 mcPretty_print (p, (const char *) "# else\\n", 10);
20414 mcPretty_print (p, (const char *) "# define EXTERN extern\\n", 29);
20415 mcPretty_print (p, (const char *) "# endif\\n\\n", 13);
20416 outDeclsDefC (p, n);
20417 runPrototypeDefC (n);
20418 mcPretty_print (p, (const char *) "# ifdef __cplusplus\\n", 23);
20419 mcPretty_print (p, (const char *) "}\\n", 3);
20420 mcPretty_print (p, (const char *) "# endif\\n", 11);
20421 mcPretty_print (p, (const char *) "\\n", 2);
20422 mcPretty_print (p, (const char *) "# undef EXTERN\\n", 18);
20423 mcPretty_print (p, (const char *) "#endif\\n", 8);
20424 outputFile = mcStream_openFrag (2); /* second fragment. */
20425 keyc_genDefs (p); /* second fragment. */
20426 s = DynamicStrings_KillString (s);
20427 }
20428
20429
20430 /*
20431 runPrototypeExported -
20432 */
20433
20434 static void runPrototypeExported (decl_node n)
20435 {
20436 if (decl_isExported (n))
20437 {
20438 keyc_enterScope (n);
20439 doProcedureHeadingC (n, true);
20440 mcPretty_print (doP, (const char *) ";\\n", 3);
20441 keyc_leaveScope (n);
20442 }
20443 }
20444
20445
20446 /*
20447 runPrototypeDefC -
20448 */
20449
20450 static void runPrototypeDefC (decl_node n)
20451 {
20452 if (decl_isDef (n))
20453 {
20454 Indexing_ForeachIndiceInIndexDo (n->defF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) runPrototypeExported});
20455 }
20456 }
20457
20458
20459 /*
20460 outImpC -
20461 */
20462
20463 static void outImpC (mcPretty_pretty p, decl_node n)
20464 {
20465 DynamicStrings_String s;
20466 decl_node defModule;
20467
20468 mcDebug_assert (decl_isImp (n));
20469 outputFile = mcStream_openFrag (1); /* first fragment. */
20470 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */
20471 mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50);
20472 mcPretty_prints (p, s);
20473 mcPretty_print (p, (const char *) ". */\\n", 7);
20474 mcOptions_writeGPLheader (outputFile);
20475 doCommentC (p, n->impF.com.body);
20476 outText (p, (const char *) "\\n", 2);
20477 outputFile = mcStream_openFrag (3); /* third fragment. */
20478 if (mcOptions_getExtendedOpaque ()) /* third fragment. */
20479 {
20480 doP = p;
20481 /* ForeachIndiceInIndexDo (n^.impF.importedModules, doIncludeC) ; */
20482 includeExternals (n);
20483 foreachModuleDo (n, (symbolKey_performOperation) {(symbolKey_performOperation_t) runSimplifyTypes});
20484 libc_printf ((const char *) "/* --extended-opaque seen therefore no #include will be used and everything will be declared in full. */\\n", 108);
20485 decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runIncludeDefConstType});
20486 includeDefVarProcedure (n);
20487 outDeclsImpC (p, n->impF.decls);
20488 decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runPrototypeDefC});
20489 }
20490 else
20491 {
20492 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
20493 /* we don't want to include the .h file for this implementation module. */
20494 mcPretty_print (p, (const char *) "#define _", 9);
20495 mcPretty_prints (p, s);
20496 mcPretty_print (p, (const char *) "_H\\n", 4);
20497 mcPretty_print (p, (const char *) "#define _", 9);
20498 mcPretty_prints (p, s);
20499 mcPretty_print (p, (const char *) "_C\\n\\n", 6);
20500 s = DynamicStrings_KillString (s);
20501 doP = p;
20502 Indexing_ForeachIndiceInIndexDo (n->impF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC});
20503 mcPretty_print (p, (const char *) "\\n", 2);
20504 includeDefConstType (n);
20505 includeDefVarProcedure (n);
20506 outDeclsImpC (p, n->impF.decls);
20507 defModule = decl_lookupDef (decl_getSymName (n));
20508 if (defModule != NULL)
20509 {
20510 runPrototypeDefC (defModule);
20511 }
20512 }
20513 Indexing_ForeachIndiceInIndexDo (n->impF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC});
20514 outProceduresC (p, n->impF.decls);
20515 outImpInitC (p, n);
20516 outputFile = mcStream_openFrag (2); /* second fragment. */
20517 keyc_genConfigSystem (p); /* second fragment. */
20518 keyc_genDefs (p);
20519 }
20520
20521
20522 /*
20523 outDeclsModuleC -
20524 */
20525
20526 static void outDeclsModuleC (mcPretty_pretty p, decl_scopeT s)
20527 {
20528 simplifyTypes (s);
20529 includeConstType (s);
20530 doP = p;
20531 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
20532 /* try and output types, constants before variables and procedures. */
20533 includeVarProcedure (s);
20534 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
20535 Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC});
20536 }
20537
20538
20539 /*
20540 outModuleInitC -
20541 */
20542
20543 static void outModuleInitC (mcPretty_pretty p, decl_node n)
20544 {
20545 outText (p, (const char *) "\\n", 2);
20546 doExternCP (p);
20547 outText (p, (const char *) "void", 4);
20548 mcPretty_setNeedSpace (p);
20549 outText (p, (const char *) "_M2_", 4);
20550 doFQNameC (p, n);
20551 outText (p, (const char *) "_init", 5);
20552 mcPretty_setNeedSpace (p);
20553 outText (p, (const char *) "(__attribute__((unused)) int argc", 33);
20554 outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37);
20555 outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40);
20556 p = outKc (p, (const char *) "{\\n", 3);
20557 doStatementsC (p, n->moduleF.beginStatements);
20558 p = outKc (p, (const char *) "}\\n", 3);
20559 outText (p, (const char *) "\\n", 2);
20560 doExternCP (p);
20561 outText (p, (const char *) "void", 4);
20562 mcPretty_setNeedSpace (p);
20563 outText (p, (const char *) "_M2_", 4);
20564 doFQNameC (p, n);
20565 outText (p, (const char *) "_fini", 5);
20566 mcPretty_setNeedSpace (p);
20567 outText (p, (const char *) "(__attribute__((unused)) int argc", 33);
20568 outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37);
20569 outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40);
20570 p = outKc (p, (const char *) "{\\n", 3);
20571 doStatementsC (p, n->moduleF.finallyStatements);
20572 p = outKc (p, (const char *) "}\\n", 3);
20573 }
20574
20575
20576 /*
20577 outModuleC -
20578 */
20579
20580 static void outModuleC (mcPretty_pretty p, decl_node n)
20581 {
20582 DynamicStrings_String s;
20583
20584 mcDebug_assert (decl_isModule (n));
20585 outputFile = mcStream_openFrag (1); /* first fragment. */
20586 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */
20587 mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50);
20588 mcPretty_prints (p, s);
20589 mcPretty_print (p, (const char *) ". */\\n", 7);
20590 mcOptions_writeGPLheader (outputFile);
20591 doCommentC (p, n->moduleF.com.body);
20592 outText (p, (const char *) "\\n", 2);
20593 outputFile = mcStream_openFrag (3); /* third fragment. */
20594 if (mcOptions_getExtendedOpaque ()) /* third fragment. */
20595 {
20596 doP = p;
20597 includeExternals (n);
20598 foreachModuleDo (n, (symbolKey_performOperation) {(symbolKey_performOperation_t) runSimplifyTypes});
20599 libc_printf ((const char *) "/* --extended-opaque seen therefore no #include will be used and everything will be declared in full. */\\n", 108);
20600 decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runIncludeDefConstType});
20601 outDeclsModuleC (p, n->moduleF.decls);
20602 decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runPrototypeDefC});
20603 }
20604 else
20605 {
20606 doP = p;
20607 Indexing_ForeachIndiceInIndexDo (n->moduleF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC});
20608 mcPretty_print (p, (const char *) "\\n", 2);
20609 outDeclsModuleC (p, n->moduleF.decls);
20610 }
20611 Indexing_ForeachIndiceInIndexDo (n->moduleF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC});
20612 outProceduresC (p, n->moduleF.decls);
20613 outModuleInitC (p, n);
20614 outputFile = mcStream_openFrag (2); /* second fragment. */
20615 keyc_genConfigSystem (p); /* second fragment. */
20616 keyc_genDefs (p);
20617 }
20618
20619
20620 /*
20621 outC -
20622 */
20623
20624 static void outC (mcPretty_pretty p, decl_node n)
20625 {
20626 keyc_enterScope (n);
20627 if (decl_isDef (n))
20628 {
20629 outDefC (p, n);
20630 }
20631 else if (decl_isImp (n))
20632 {
20633 /* avoid dangling else. */
20634 outImpC (p, n);
20635 }
20636 else if (decl_isModule (n))
20637 {
20638 /* avoid dangling else. */
20639 outModuleC (p, n);
20640 }
20641 else
20642 {
20643 /* avoid dangling else. */
20644 M2RTS_HALT (-1);
20645 __builtin_unreachable ();
20646 }
20647 keyc_leaveScope (n);
20648 }
20649
20650
20651 /*
20652 doIncludeM2 - include modules in module, n.
20653 */
20654
20655 static void doIncludeM2 (decl_node n)
20656 {
20657 DynamicStrings_String s;
20658
20659 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
20660 mcPretty_print (doP, (const char *) "IMPORT ", 7);
20661 mcPretty_prints (doP, s);
20662 mcPretty_print (doP, (const char *) " ;\\n", 4);
20663 s = DynamicStrings_KillString (s);
20664 if (decl_isDef (n))
20665 {
20666 symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone});
20667 }
20668 else if (decl_isImp (n))
20669 {
20670 /* avoid dangling else. */
20671 symbolKey_foreachNodeDo (n->impF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone});
20672 }
20673 else if (decl_isModule (n))
20674 {
20675 /* avoid dangling else. */
20676 symbolKey_foreachNodeDo (n->moduleF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone});
20677 }
20678 }
20679
20680
20681 /*
20682 doConstM2 -
20683 */
20684
20685 static void doConstM2 (decl_node n)
20686 {
20687 mcPretty_print (doP, (const char *) "CONST\\n", 7);
20688 doFQNameC (doP, n);
20689 mcPretty_setNeedSpace (doP);
20690 doExprC (doP, n->constF.value);
20691 mcPretty_print (doP, (const char *) "\\n", 2);
20692 }
20693
20694
20695 /*
20696 doProcTypeM2 -
20697 */
20698
20699 static void doProcTypeM2 (mcPretty_pretty p, decl_node n)
20700 {
20701 outText (p, (const char *) "proc type to do..", 17);
20702 }
20703
20704
20705 /*
20706 doRecordFieldM2 -
20707 */
20708
20709 static void doRecordFieldM2 (mcPretty_pretty p, decl_node f)
20710 {
20711 doNameM2 (p, f);
20712 outText (p, (const char *) ":", 1);
20713 mcPretty_setNeedSpace (p);
20714 doTypeM2 (p, decl_getType (f));
20715 mcPretty_setNeedSpace (p);
20716 }
20717
20718
20719 /*
20720 doVarientFieldM2 -
20721 */
20722
20723 static void doVarientFieldM2 (mcPretty_pretty p, decl_node n)
20724 {
20725 unsigned int i;
20726 unsigned int t;
20727 decl_node q;
20728
20729 mcDebug_assert (decl_isVarientField (n));
20730 doNameM2 (p, n);
20731 outText (p, (const char *) ":", 1);
20732 mcPretty_setNeedSpace (p);
20733 i = Indexing_LowIndice (n->varientfieldF.listOfSons);
20734 t = Indexing_HighIndice (n->varientfieldF.listOfSons);
20735 while (i <= t)
20736 {
20737 q = static_cast<decl_node> (Indexing_GetIndice (n->varientfieldF.listOfSons, i));
20738 if (decl_isRecordField (q))
20739 {
20740 doRecordFieldM2 (p, q);
20741 outText (p, (const char *) ";\\n", 3);
20742 }
20743 else if (decl_isVarient (q))
20744 {
20745 /* avoid dangling else. */
20746 doVarientM2 (p, q);
20747 outText (p, (const char *) ";\\n", 3);
20748 }
20749 else
20750 {
20751 /* avoid dangling else. */
20752 M2RTS_HALT (-1);
20753 __builtin_unreachable ();
20754 }
20755 i += 1;
20756 }
20757 }
20758
20759
20760 /*
20761 doVarientM2 -
20762 */
20763
20764 static void doVarientM2 (mcPretty_pretty p, decl_node n)
20765 {
20766 unsigned int i;
20767 unsigned int t;
20768 decl_node q;
20769
20770 mcDebug_assert (decl_isVarient (n));
20771 outText (p, (const char *) "CASE", 4);
20772 mcPretty_setNeedSpace (p);
20773 if (n->varientF.tag != NULL)
20774 {
20775 /* avoid gcc warning by using compound statement even if not strictly necessary. */
20776 if (decl_isRecordField (n->varientF.tag))
20777 {
20778 doRecordFieldM2 (p, n->varientF.tag);
20779 }
20780 else if (decl_isVarientField (n->varientF.tag))
20781 {
20782 /* avoid dangling else. */
20783 doVarientFieldM2 (p, n->varientF.tag);
20784 }
20785 else
20786 {
20787 /* avoid dangling else. */
20788 M2RTS_HALT (-1);
20789 __builtin_unreachable ();
20790 }
20791 }
20792 mcPretty_setNeedSpace (p);
20793 outText (p, (const char *) "OF\\n", 4);
20794 i = Indexing_LowIndice (n->varientF.listOfSons);
20795 t = Indexing_HighIndice (n->varientF.listOfSons);
20796 while (i <= t)
20797 {
20798 q = static_cast<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
20799 if (decl_isRecordField (q))
20800 {
20801 /* avoid dangling else. */
20802 if (! q->recordfieldF.tag)
20803 {
20804 doRecordFieldM2 (p, q);
20805 outText (p, (const char *) ";\\n", 3);
20806 }
20807 }
20808 else if (decl_isVarientField (q))
20809 {
20810 /* avoid dangling else. */
20811 doVarientFieldM2 (p, q);
20812 }
20813 else
20814 {
20815 /* avoid dangling else. */
20816 M2RTS_HALT (-1);
20817 __builtin_unreachable ();
20818 }
20819 i += 1;
20820 }
20821 outText (p, (const char *) "END", 3);
20822 mcPretty_setNeedSpace (p);
20823 }
20824
20825
20826 /*
20827 doRecordM2 -
20828 */
20829
20830 static void doRecordM2 (mcPretty_pretty p, decl_node n)
20831 {
20832 unsigned int i;
20833 unsigned int h;
20834 decl_node f;
20835
20836 mcDebug_assert (decl_isRecord (n));
20837 p = outKm2 (p, (const char *) "RECORD", 6);
20838 i = Indexing_LowIndice (n->recordF.listOfSons);
20839 h = Indexing_HighIndice (n->recordF.listOfSons);
20840 outText (p, (const char *) "\\n", 2);
20841 while (i <= h)
20842 {
20843 f = static_cast<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
20844 if (decl_isRecordField (f))
20845 {
20846 /* avoid dangling else. */
20847 if (! f->recordfieldF.tag)
20848 {
20849 doRecordFieldM2 (p, f);
20850 outText (p, (const char *) ";\\n", 3);
20851 }
20852 }
20853 else if (decl_isVarient (f))
20854 {
20855 /* avoid dangling else. */
20856 doVarientM2 (p, f);
20857 outText (p, (const char *) ";\\n", 3);
20858 }
20859 else if (decl_isVarientField (f))
20860 {
20861 /* avoid dangling else. */
20862 doVarientFieldM2 (p, f);
20863 }
20864 i += 1;
20865 }
20866 p = outKm2 (p, (const char *) "END", 3);
20867 mcPretty_setNeedSpace (p);
20868 }
20869
20870
20871 /*
20872 doPointerM2 -
20873 */
20874
20875 static void doPointerM2 (mcPretty_pretty p, decl_node n)
20876 {
20877 outText (p, (const char *) "POINTER TO", 10);
20878 mcPretty_setNeedSpace (doP);
20879 doTypeM2 (p, decl_getType (n));
20880 mcPretty_setNeedSpace (p);
20881 outText (p, (const char *) ";\\n", 3);
20882 }
20883
20884
20885 /*
20886 doTypeAliasM2 -
20887 */
20888
20889 static void doTypeAliasM2 (mcPretty_pretty p, decl_node n)
20890 {
20891 doTypeNameC (p, n);
20892 mcPretty_setNeedSpace (p);
20893 outText (doP, (const char *) "=", 1);
20894 mcPretty_setNeedSpace (p);
20895 doTypeM2 (p, decl_getType (n));
20896 mcPretty_setNeedSpace (p);
20897 outText (p, (const char *) "\\n", 2);
20898 }
20899
20900
20901 /*
20902 doEnumerationM2 -
20903 */
20904
20905 static void doEnumerationM2 (mcPretty_pretty p, decl_node n)
20906 {
20907 unsigned int i;
20908 unsigned int h;
20909 decl_node s;
20910 DynamicStrings_String t;
20911
20912 outText (p, (const char *) "(", 1);
20913 i = Indexing_LowIndice (n->enumerationF.listOfSons);
20914 h = Indexing_HighIndice (n->enumerationF.listOfSons);
20915 while (i <= h)
20916 {
20917 s = static_cast<decl_node> (Indexing_GetIndice (n->enumerationF.listOfSons, i));
20918 doFQNameC (p, s);
20919 if (i < h)
20920 {
20921 outText (p, (const char *) ",", 1);
20922 mcPretty_setNeedSpace (p);
20923 }
20924 i += 1;
20925 }
20926 outText (p, (const char *) ")", 1);
20927 }
20928
20929
20930 /*
20931 doBaseM2 -
20932 */
20933
20934 static void doBaseM2 (mcPretty_pretty p, decl_node n)
20935 {
20936 switch (n->kind)
20937 {
20938 case decl_char:
20939 case decl_cardinal:
20940 case decl_longcard:
20941 case decl_shortcard:
20942 case decl_integer:
20943 case decl_longint:
20944 case decl_shortint:
20945 case decl_complex:
20946 case decl_longcomplex:
20947 case decl_shortcomplex:
20948 case decl_real:
20949 case decl_longreal:
20950 case decl_shortreal:
20951 case decl_bitset:
20952 case decl_boolean:
20953 case decl_proc:
20954 doNameM2 (p, n);
20955 break;
20956
20957
20958 default:
20959 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
20960 __builtin_unreachable ();
20961 }
20962 mcPretty_setNeedSpace (p);
20963 }
20964
20965
20966 /*
20967 doSystemM2 -
20968 */
20969
20970 static void doSystemM2 (mcPretty_pretty p, decl_node n)
20971 {
20972 switch (n->kind)
20973 {
20974 case decl_address:
20975 case decl_loc:
20976 case decl_byte:
20977 case decl_word:
20978 case decl_csizet:
20979 case decl_cssizet:
20980 doNameM2 (p, n);
20981 break;
20982
20983
20984 default:
20985 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
20986 __builtin_unreachable ();
20987 }
20988 }
20989
20990
20991 /*
20992 doTypeM2 -
20993 */
20994
20995 static void doTypeM2 (mcPretty_pretty p, decl_node n)
20996 {
20997 if (isBase (n))
20998 {
20999 doBaseM2 (p, n);
21000 }
21001 else if (isSystem (n))
21002 {
21003 /* avoid dangling else. */
21004 doSystemM2 (p, n);
21005 }
21006 else if (decl_isType (n))
21007 {
21008 /* avoid dangling else. */
21009 doTypeAliasM2 (p, n);
21010 }
21011 else if (decl_isProcType (n))
21012 {
21013 /* avoid dangling else. */
21014 doProcTypeM2 (p, n);
21015 }
21016 else if (decl_isPointer (n))
21017 {
21018 /* avoid dangling else. */
21019 doPointerM2 (p, n);
21020 }
21021 else if (decl_isEnumeration (n))
21022 {
21023 /* avoid dangling else. */
21024 doEnumerationM2 (p, n);
21025 }
21026 else if (decl_isRecord (n))
21027 {
21028 /* avoid dangling else. */
21029 doRecordM2 (p, n);
21030 }
21031 }
21032
21033
21034 /*
21035 doTypesM2 -
21036 */
21037
21038 static void doTypesM2 (decl_node n)
21039 {
21040 decl_node m;
21041
21042 outText (doP, (const char *) "TYPE\\n", 6);
21043 doTypeM2 (doP, n);
21044 }
21045
21046
21047 /*
21048 doVarM2 -
21049 */
21050
21051 static void doVarM2 (decl_node n)
21052 {
21053 mcDebug_assert (decl_isVar (n));
21054 doNameC (doP, n);
21055 outText (doP, (const char *) ":", 1);
21056 mcPretty_setNeedSpace (doP);
21057 doTypeM2 (doP, decl_getType (n));
21058 mcPretty_setNeedSpace (doP);
21059 outText (doP, (const char *) ";\\n", 3);
21060 }
21061
21062
21063 /*
21064 doVarsM2 -
21065 */
21066
21067 static void doVarsM2 (decl_node n)
21068 {
21069 decl_node m;
21070
21071 outText (doP, (const char *) "VAR\\n", 5);
21072 doVarM2 (n);
21073 }
21074
21075
21076 /*
21077 doTypeNameM2 -
21078 */
21079
21080 static void doTypeNameM2 (mcPretty_pretty p, decl_node n)
21081 {
21082 doNameM2 (p, n);
21083 }
21084
21085
21086 /*
21087 doParamM2 -
21088 */
21089
21090 static void doParamM2 (mcPretty_pretty p, decl_node n)
21091 {
21092 decl_node ptype;
21093 nameKey_Name i;
21094 unsigned int c;
21095 unsigned int t;
21096 wlists_wlist l;
21097
21098 mcDebug_assert (decl_isParam (n));
21099 ptype = decl_getType (n);
21100 if (n->paramF.namelist == NULL)
21101 {
21102 doTypeNameM2 (p, ptype);
21103 }
21104 else
21105 {
21106 mcDebug_assert (isIdentList (n->paramF.namelist));
21107 l = n->paramF.namelist->identlistF.names;
21108 if (l == NULL)
21109 {
21110 doTypeNameM2 (p, ptype);
21111 }
21112 else
21113 {
21114 t = wlists_noOfItemsInList (l);
21115 c = 1;
21116 while (c <= t)
21117 {
21118 i = static_cast<nameKey_Name> (wlists_getItemFromList (l, c));
21119 mcPretty_setNeedSpace (p);
21120 doNamesC (p, i);
21121 if (c < t)
21122 {
21123 outText (p, (const char *) ",", 1);
21124 mcPretty_setNeedSpace (p);
21125 }
21126 c += 1;
21127 }
21128 outText (p, (const char *) ":", 1);
21129 mcPretty_setNeedSpace (p);
21130 doTypeNameM2 (p, ptype);
21131 }
21132 }
21133 }
21134
21135
21136 /*
21137 doVarParamM2 -
21138 */
21139
21140 static void doVarParamM2 (mcPretty_pretty p, decl_node n)
21141 {
21142 decl_node ptype;
21143 nameKey_Name i;
21144 unsigned int c;
21145 unsigned int t;
21146 wlists_wlist l;
21147
21148 mcDebug_assert (decl_isVarParam (n));
21149 outText (p, (const char *) "VAR", 3);
21150 mcPretty_setNeedSpace (p);
21151 ptype = decl_getType (n);
21152 if (n->varparamF.namelist == NULL)
21153 {
21154 doTypeNameM2 (p, ptype);
21155 }
21156 else
21157 {
21158 mcDebug_assert (isIdentList (n->varparamF.namelist));
21159 l = n->varparamF.namelist->identlistF.names;
21160 if (l == NULL)
21161 {
21162 doTypeNameM2 (p, ptype);
21163 }
21164 else
21165 {
21166 t = wlists_noOfItemsInList (l);
21167 c = 1;
21168 while (c <= t)
21169 {
21170 i = static_cast<nameKey_Name> (wlists_getItemFromList (l, c));
21171 mcPretty_setNeedSpace (p);
21172 doNamesC (p, i);
21173 if (c < t)
21174 {
21175 outText (p, (const char *) ",", 1);
21176 mcPretty_setNeedSpace (p);
21177 }
21178 c += 1;
21179 }
21180 outText (p, (const char *) ":", 1);
21181 mcPretty_setNeedSpace (p);
21182 doTypeNameM2 (p, ptype);
21183 }
21184 }
21185 }
21186
21187
21188 /*
21189 doParameterM2 -
21190 */
21191
21192 static void doParameterM2 (mcPretty_pretty p, decl_node n)
21193 {
21194 if (decl_isParam (n))
21195 {
21196 doParamM2 (p, n);
21197 }
21198 else if (decl_isVarParam (n))
21199 {
21200 /* avoid dangling else. */
21201 doVarParamM2 (p, n);
21202 }
21203 else if (decl_isVarargs (n))
21204 {
21205 /* avoid dangling else. */
21206 mcPretty_print (p, (const char *) "...", 3);
21207 }
21208 }
21209
21210
21211 /*
21212 doPrototypeM2 -
21213 */
21214
21215 static void doPrototypeM2 (decl_node n)
21216 {
21217 unsigned int i;
21218 unsigned int h;
21219 decl_node p;
21220
21221 mcDebug_assert (decl_isProcedure (n));
21222 mcPretty_noSpace (doP);
21223 doNameM2 (doP, n);
21224 mcPretty_setNeedSpace (doP);
21225 outText (doP, (const char *) "(", 1);
21226 i = Indexing_LowIndice (n->procedureF.parameters);
21227 h = Indexing_HighIndice (n->procedureF.parameters);
21228 while (i <= h)
21229 {
21230 p = static_cast<decl_node> (Indexing_GetIndice (n->procedureF.parameters, i));
21231 doParameterM2 (doP, p);
21232 mcPretty_noSpace (doP);
21233 if (i < h)
21234 {
21235 mcPretty_print (doP, (const char *) ";", 1);
21236 mcPretty_setNeedSpace (doP);
21237 }
21238 i += 1;
21239 }
21240 outText (doP, (const char *) ")", 1);
21241 if (n->procedureF.returnType != NULL)
21242 {
21243 mcPretty_setNeedSpace (doP);
21244 outText (doP, (const char *) ":", 1);
21245 doTypeM2 (doP, n->procedureF.returnType);
21246 mcPretty_setNeedSpace (doP);
21247 }
21248 outText (doP, (const char *) ";\\n", 3);
21249 }
21250
21251
21252 /*
21253 outputPartialM2 - just writes out record, array, and proctypes.
21254 No need for forward declarations in Modula-2
21255 but we need to keep topological sort happy.
21256 So when asked to output partial we emit the
21257 full type for these types and then do nothing
21258 when trying to complete partial to full.
21259 */
21260
21261 static void outputPartialM2 (decl_node n)
21262 {
21263 decl_node q;
21264
21265 q = decl_getType (n);
21266 if (decl_isRecord (q))
21267 {
21268 doTypeM2 (doP, n);
21269 }
21270 else if (decl_isArray (q))
21271 {
21272 /* avoid dangling else. */
21273 doTypeM2 (doP, n);
21274 }
21275 else if (decl_isProcType (q))
21276 {
21277 /* avoid dangling else. */
21278 doTypeM2 (doP, n);
21279 }
21280 }
21281
21282
21283 /*
21284 outDeclsDefM2 -
21285 */
21286
21287 static void outDeclsDefM2 (mcPretty_pretty p, decl_scopeT s)
21288 {
21289 simplifyTypes (s);
21290 includeConstType (s);
21291 doP = p;
21292 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarsM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing});
21293 includeVarProcedure (s);
21294 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarsM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing});
21295 Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeM2});
21296 }
21297
21298
21299 /*
21300 outDefM2 -
21301 */
21302
21303 static void outDefM2 (mcPretty_pretty p, decl_node n)
21304 {
21305 DynamicStrings_String s;
21306
21307 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSource (n)));
21308 mcPretty_print (p, (const char *) "(* automatically created by mc from ", 36);
21309 mcPretty_prints (p, s);
21310 mcPretty_print (p, (const char *) ". *)\\n\\n", 9);
21311 s = DynamicStrings_KillString (s);
21312 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
21313 mcPretty_print (p, (const char *) "DEFINITION MODULE ", 18);
21314 mcPretty_prints (p, s);
21315 mcPretty_print (p, (const char *) " ;\\n\\n", 6);
21316 doP = p;
21317 Indexing_ForeachIndiceInIndexDo (n->defF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeM2});
21318 mcPretty_print (p, (const char *) "\\n", 2);
21319 outDeclsDefM2 (p, n->defF.decls);
21320 mcPretty_print (p, (const char *) "\\n", 2);
21321 mcPretty_print (p, (const char *) "END ", 4);
21322 mcPretty_prints (p, s);
21323 mcPretty_print (p, (const char *) ".\\n", 3);
21324 s = DynamicStrings_KillString (s);
21325 }
21326
21327
21328 /*
21329 outDeclsImpM2 -
21330 */
21331
21332 static void outDeclsImpM2 (mcPretty_pretty p, decl_scopeT s)
21333 {
21334 simplifyTypes (s);
21335 includeConstType (s);
21336 doP = p;
21337 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing});
21338 includeVarProcedure (s);
21339 topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarsM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing});
21340 outText (p, (const char *) "\\n", 2);
21341 Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC});
21342 }
21343
21344
21345 /*
21346 outImpM2 -
21347 */
21348
21349 static void outImpM2 (mcPretty_pretty p, decl_node n)
21350 {
21351 DynamicStrings_String s;
21352
21353 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSource (n)));
21354 mcPretty_print (p, (const char *) "(* automatically created by mc from ", 36);
21355 mcPretty_prints (p, s);
21356 mcPretty_print (p, (const char *) ". *)\\n\\n", 9);
21357 mcPretty_print (p, (const char *) "IMPLEMENTATION MODULE ", 22);
21358 mcPretty_prints (p, s);
21359 mcPretty_print (p, (const char *) " ;\\n\\n", 6);
21360 doP = p;
21361 Indexing_ForeachIndiceInIndexDo (n->impF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeM2});
21362 mcPretty_print (p, (const char *) "\\n", 2);
21363 includeDefConstType (n);
21364 outDeclsImpM2 (p, n->impF.decls);
21365 mcPretty_print (p, (const char *) "\\n", 2);
21366 mcPretty_print (p, (const char *) "END ", 4);
21367 mcPretty_prints (p, s);
21368 mcPretty_print (p, (const char *) ".\\n", 3);
21369 s = DynamicStrings_KillString (s);
21370 }
21371
21372
21373 /*
21374 outModuleM2 -
21375 */
21376
21377 static void outModuleM2 (mcPretty_pretty p, decl_node n)
21378 {
21379 }
21380
21381
21382 /*
21383 outM2 -
21384 */
21385
21386 static void outM2 (mcPretty_pretty p, decl_node n)
21387 {
21388 if (decl_isDef (n))
21389 {
21390 outDefM2 (p, n);
21391 }
21392 else if (decl_isImp (n))
21393 {
21394 /* avoid dangling else. */
21395 outImpM2 (p, n);
21396 }
21397 else if (decl_isModule (n))
21398 {
21399 /* avoid dangling else. */
21400 outModuleM2 (p, n);
21401 }
21402 else
21403 {
21404 /* avoid dangling else. */
21405 M2RTS_HALT (-1);
21406 __builtin_unreachable ();
21407 }
21408 }
21409
21410
21411 /*
21412 addDone - adds node, n, to the doneQ.
21413 */
21414
21415 static void addDone (decl_node n)
21416 {
21417 alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (n));
21418 }
21419
21420
21421 /*
21422 addDoneDef - adds node, n, to the doneQ providing
21423 it is not an opaque of the main module we are compiling.
21424 */
21425
21426 static void addDoneDef (decl_node n)
21427 {
21428 if (decl_isDef (n))
21429 {
21430 addDone (n);
21431 return ;
21432 }
21433 if ((! (decl_isDef (n))) && ((decl_lookupImp (decl_getSymName (decl_getScope (n)))) == (decl_getMainModule ())))
21434 {
21435 mcMetaError_metaError1 ((const char *) "cyclic dependancy found between another module using {%1ad} from the definition module of the implementation main being compiled, use the --extended-opaque option to compile", 173, (const unsigned char *) &n, (sizeof (n)-1));
21436 mcError_flushErrors ();
21437 mcError_errorAbort0 ((const char *) "terminating compilation", 23);
21438 }
21439 else
21440 {
21441 addDone (n);
21442 }
21443 }
21444
21445
21446 /*
21447 dbgAdd -
21448 */
21449
21450 static decl_node dbgAdd (alists_alist l, decl_node n)
21451 {
21452 if (n != NULL)
21453 {
21454 alists_includeItemIntoList (l, reinterpret_cast<void *> (n));
21455 }
21456 return n;
21457 /* static analysis guarentees a RETURN statement will be used before here. */
21458 __builtin_unreachable ();
21459 }
21460
21461
21462 /*
21463 dbgType -
21464 */
21465
21466 static void dbgType (alists_alist l, decl_node n)
21467 {
21468 decl_node t;
21469
21470 t = dbgAdd (l, decl_getType (n));
21471 out1 ((const char *) "<%s type", 8, n);
21472 if (t == NULL)
21473 {
21474 out0 ((const char *) ", type = NIL\\n", 14);
21475 }
21476 else
21477 {
21478 out1 ((const char *) ", type = %s>\\n", 14, t);
21479 }
21480 }
21481
21482
21483 /*
21484 dbgPointer -
21485 */
21486
21487 static void dbgPointer (alists_alist l, decl_node n)
21488 {
21489 decl_node t;
21490
21491 t = dbgAdd (l, decl_getType (n));
21492 out1 ((const char *) "<%s pointer", 11, n);
21493 out1 ((const char *) " to %s>\\n", 9, t);
21494 }
21495
21496
21497 /*
21498 dbgRecord -
21499 */
21500
21501 static void dbgRecord (alists_alist l, decl_node n)
21502 {
21503 unsigned int i;
21504 unsigned int t;
21505 decl_node q;
21506
21507 out1 ((const char *) "<%s record:\\n", 13, n);
21508 i = Indexing_LowIndice (n->recordF.listOfSons);
21509 t = Indexing_HighIndice (n->recordF.listOfSons);
21510 while (i <= t)
21511 {
21512 q = static_cast<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
21513 if (decl_isRecordField (q))
21514 {
21515 out1 ((const char *) " <recordfield %s", 16, q);
21516 }
21517 else if (decl_isVarientField (q))
21518 {
21519 /* avoid dangling else. */
21520 out1 ((const char *) " <varientfield %s", 17, q);
21521 }
21522 else if (decl_isVarient (q))
21523 {
21524 /* avoid dangling else. */
21525 out1 ((const char *) " <varient %s", 12, q);
21526 }
21527 else
21528 {
21529 /* avoid dangling else. */
21530 M2RTS_HALT (-1);
21531 __builtin_unreachable ();
21532 }
21533 q = dbgAdd (l, decl_getType (q));
21534 out1 ((const char *) ": %s>\\n", 7, q);
21535 i += 1;
21536 }
21537 outText (doP, (const char *) ">\\n", 3);
21538 }
21539
21540
21541 /*
21542 dbgVarient -
21543 */
21544
21545 static void dbgVarient (alists_alist l, decl_node n)
21546 {
21547 unsigned int i;
21548 unsigned int t;
21549 decl_node q;
21550
21551 out1 ((const char *) "<%s varient: ", 13, n);
21552 out1 ((const char *) "tag %s", 6, n->varientF.tag);
21553 q = decl_getType (n->varientF.tag);
21554 if (q == NULL)
21555 {
21556 outText (doP, (const char *) "\\n", 2);
21557 }
21558 else
21559 {
21560 out1 ((const char *) ": %s\\n", 6, q);
21561 q = dbgAdd (l, q);
21562 }
21563 i = Indexing_LowIndice (n->varientF.listOfSons);
21564 t = Indexing_HighIndice (n->varientF.listOfSons);
21565 while (i <= t)
21566 {
21567 q = static_cast<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
21568 if (decl_isRecordField (q))
21569 {
21570 out1 ((const char *) " <recordfield %s", 16, q);
21571 }
21572 else if (decl_isVarientField (q))
21573 {
21574 /* avoid dangling else. */
21575 out1 ((const char *) " <varientfield %s", 17, q);
21576 }
21577 else if (decl_isVarient (q))
21578 {
21579 /* avoid dangling else. */
21580 out1 ((const char *) " <varient %s", 12, q);
21581 }
21582 else
21583 {
21584 /* avoid dangling else. */
21585 M2RTS_HALT (-1);
21586 __builtin_unreachable ();
21587 }
21588 q = dbgAdd (l, decl_getType (q));
21589 out1 ((const char *) ": %s>\\n", 7, q);
21590 i += 1;
21591 }
21592 outText (doP, (const char *) ">\\n", 3);
21593 }
21594
21595
21596 /*
21597 dbgEnumeration -
21598 */
21599
21600 static void dbgEnumeration (alists_alist l, decl_node n)
21601 {
21602 decl_node e;
21603 unsigned int i;
21604 unsigned int h;
21605
21606 outText (doP, (const char *) "< enumeration ", 14);
21607 i = Indexing_LowIndice (n->enumerationF.listOfSons);
21608 h = Indexing_HighIndice (n->enumerationF.listOfSons);
21609 while (i <= h)
21610 {
21611 e = static_cast<decl_node> (Indexing_GetIndice (n->enumerationF.listOfSons, i));
21612 out1 ((const char *) "%s, ", 4, e);
21613 i += 1;
21614 }
21615 outText (doP, (const char *) ">\\n", 3);
21616 }
21617
21618
21619 /*
21620 dbgVar -
21621 */
21622
21623 static void dbgVar (alists_alist l, decl_node n)
21624 {
21625 decl_node t;
21626
21627 t = dbgAdd (l, decl_getType (n));
21628 out1 ((const char *) "<%s var", 7, n);
21629 out1 ((const char *) ", type = %s>\\n", 14, t);
21630 }
21631
21632
21633 /*
21634 dbgSubrange -
21635 */
21636
21637 static void dbgSubrange (alists_alist l, decl_node n)
21638 {
21639 if (n->subrangeF.low == NULL)
21640 {
21641 out1 ((const char *) "%s", 2, n->subrangeF.type);
21642 }
21643 else
21644 {
21645 out1 ((const char *) "[%s", 3, n->subrangeF.low);
21646 out1 ((const char *) "..%s]", 5, n->subrangeF.high);
21647 }
21648 }
21649
21650
21651 /*
21652 dbgArray -
21653 */
21654
21655 static void dbgArray (alists_alist l, decl_node n)
21656 {
21657 decl_node t;
21658
21659 t = dbgAdd (l, decl_getType (n));
21660 out1 ((const char *) "<%s array ", 10, n);
21661 if (n->arrayF.subr != NULL)
21662 {
21663 dbgSubrange (l, n->arrayF.subr);
21664 }
21665 out1 ((const char *) " of %s>\\n", 9, t);
21666 }
21667
21668
21669 /*
21670 doDbg -
21671 */
21672
21673 static void doDbg (alists_alist l, decl_node n)
21674 {
21675 if (n == NULL)
21676 {} /* empty. */
21677 else if (decl_isSubrange (n))
21678 {
21679 /* avoid dangling else. */
21680 dbgSubrange (l, n);
21681 }
21682 else if (decl_isType (n))
21683 {
21684 /* avoid dangling else. */
21685 dbgType (l, n);
21686 }
21687 else if (decl_isRecord (n))
21688 {
21689 /* avoid dangling else. */
21690 dbgRecord (l, n);
21691 }
21692 else if (decl_isVarient (n))
21693 {
21694 /* avoid dangling else. */
21695 dbgVarient (l, n);
21696 }
21697 else if (decl_isEnumeration (n))
21698 {
21699 /* avoid dangling else. */
21700 dbgEnumeration (l, n);
21701 }
21702 else if (decl_isPointer (n))
21703 {
21704 /* avoid dangling else. */
21705 dbgPointer (l, n);
21706 }
21707 else if (decl_isArray (n))
21708 {
21709 /* avoid dangling else. */
21710 dbgArray (l, n);
21711 }
21712 else if (decl_isVar (n))
21713 {
21714 /* avoid dangling else. */
21715 dbgVar (l, n);
21716 }
21717 }
21718
21719
21720 /*
21721 dbg -
21722 */
21723
21724 static void dbg (decl_node n)
21725 {
21726 alists_alist l;
21727 mcPretty_pretty o;
21728 FIO_File f;
21729 DynamicStrings_String s;
21730 unsigned int i;
21731
21732 o = doP;
21733 f = outputFile;
21734 outputFile = FIO_StdOut;
21735 doP = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln});
21736 l = alists_initList ();
21737 alists_includeItemIntoList (l, reinterpret_cast<void *> (n));
21738 i = 1;
21739 out1 ((const char *) "dbg (%s)\\n", 10, n);
21740 do {
21741 n = static_cast<decl_node> (alists_getItemFromList (l, i));
21742 doDbg (l, n);
21743 i += 1;
21744 } while (! (i > (alists_noOfItemsInList (l))));
21745 doP = o;
21746 outputFile = f;
21747 }
21748
21749
21750 /*
21751 addGenericBody - adds comment node to funccall, return, assignment
21752 nodes.
21753 */
21754
21755 static void addGenericBody (decl_node n, decl_node c)
21756 {
21757 switch (n->kind)
21758 {
21759 case decl_unreachable:
21760 case decl_throw:
21761 case decl_halt:
21762 case decl_new:
21763 case decl_dispose:
21764 case decl_inc:
21765 case decl_dec:
21766 case decl_incl:
21767 case decl_excl:
21768 n->intrinsicF.intrinsicComment.body = c;
21769 break;
21770
21771 case decl_funccall:
21772 n->funccallF.funccallComment.body = c;
21773 break;
21774
21775 case decl_return:
21776 n->returnF.returnComment.body = c;
21777 break;
21778
21779 case decl_assignment:
21780 n->assignmentF.assignComment.body = c;
21781 break;
21782
21783 case decl_module:
21784 n->moduleF.com.body = c;
21785 break;
21786
21787 case decl_def:
21788 n->defF.com.body = c;
21789 break;
21790
21791 case decl_imp:
21792 n->impF.com.body = c;
21793 break;
21794
21795
21796 default:
21797 break;
21798 }
21799 }
21800
21801
21802 /*
21803 addGenericAfter - adds comment node to funccall, return, assignment
21804 nodes.
21805 */
21806
21807 static void addGenericAfter (decl_node n, decl_node c)
21808 {
21809 switch (n->kind)
21810 {
21811 case decl_unreachable:
21812 case decl_throw:
21813 case decl_halt:
21814 case decl_new:
21815 case decl_dispose:
21816 case decl_inc:
21817 case decl_dec:
21818 case decl_incl:
21819 case decl_excl:
21820 n->intrinsicF.intrinsicComment.after = c;
21821 break;
21822
21823 case decl_funccall:
21824 n->funccallF.funccallComment.after = c;
21825 break;
21826
21827 case decl_return:
21828 n->returnF.returnComment.after = c;
21829 break;
21830
21831 case decl_assignment:
21832 n->assignmentF.assignComment.after = c;
21833 break;
21834
21835 case decl_module:
21836 n->moduleF.com.after = c;
21837 break;
21838
21839 case decl_def:
21840 n->defF.com.after = c;
21841 break;
21842
21843 case decl_imp:
21844 n->impF.com.after = c;
21845 break;
21846
21847
21848 default:
21849 break;
21850 }
21851 }
21852
21853
21854 /*
21855 isAssignment -
21856 */
21857
21858 static bool isAssignment (decl_node n)
21859 {
21860 return n->kind == decl_assignment;
21861 /* static analysis guarentees a RETURN statement will be used before here. */
21862 __builtin_unreachable ();
21863 }
21864
21865
21866 /*
21867 isComment - returns TRUE if node, n, is a comment.
21868 */
21869
21870 static bool isComment (decl_node n)
21871 {
21872 mcDebug_assert (n != NULL);
21873 return n->kind == decl_comment;
21874 /* static analysis guarentees a RETURN statement will be used before here. */
21875 __builtin_unreachable ();
21876 }
21877
21878
21879 /*
21880 initPair - initialise the commentPair, c.
21881 */
21882
21883 static void initPair (decl_commentPair *c)
21884 {
21885 (*c).after = NULL;
21886 (*c).body = NULL;
21887 }
21888
21889
21890 /*
21891 dupExplist -
21892 */
21893
21894 static decl_node dupExplist (decl_node n)
21895 {
21896 decl_node m;
21897 unsigned int i;
21898
21899 mcDebug_assert (decl_isExpList (n));
21900 m = decl_makeExpList ();
21901 i = Indexing_LowIndice (n->explistF.exp);
21902 while (i <= (Indexing_HighIndice (n->explistF.exp)))
21903 {
21904 decl_putExpList (m, decl_dupExpr (reinterpret_cast<decl_node> (Indexing_GetIndice (n->explistF.exp, i))));
21905 i += 1;
21906 }
21907 return m;
21908 /* static analysis guarentees a RETURN statement will be used before here. */
21909 __builtin_unreachable ();
21910 }
21911
21912
21913 /*
21914 dupArrayref -
21915 */
21916
21917 static decl_node dupArrayref (decl_node n)
21918 {
21919 mcDebug_assert (isArrayRef (n));
21920 return decl_makeArrayRef (decl_dupExpr (n->arrayrefF.array), decl_dupExpr (n->arrayrefF.index));
21921 /* static analysis guarentees a RETURN statement will be used before here. */
21922 __builtin_unreachable ();
21923 }
21924
21925
21926 /*
21927 dupPointerref -
21928 */
21929
21930 static decl_node dupPointerref (decl_node n)
21931 {
21932 mcDebug_assert (decl_isPointerRef (n));
21933 return decl_makePointerRef (decl_dupExpr (n->pointerrefF.ptr), decl_dupExpr (n->pointerrefF.field));
21934 /* static analysis guarentees a RETURN statement will be used before here. */
21935 __builtin_unreachable ();
21936 }
21937
21938
21939 /*
21940 dupComponentref -
21941 */
21942
21943 static decl_node dupComponentref (decl_node n)
21944 {
21945 mcDebug_assert (isComponentRef (n));
21946 return doMakeComponentRef (decl_dupExpr (n->componentrefF.rec), decl_dupExpr (n->componentrefF.field));
21947 /* static analysis guarentees a RETURN statement will be used before here. */
21948 __builtin_unreachable ();
21949 }
21950
21951
21952 /*
21953 dupBinary -
21954 */
21955
21956 static decl_node dupBinary (decl_node n)
21957 {
21958 /* assert (isBinary (n)) ; */
21959 return makeBinary (n->kind, decl_dupExpr (n->binaryF.left), decl_dupExpr (n->binaryF.right), n->binaryF.resultType);
21960 /* static analysis guarentees a RETURN statement will be used before here. */
21961 __builtin_unreachable ();
21962 }
21963
21964
21965 /*
21966 dupUnary -
21967 */
21968
21969 static decl_node dupUnary (decl_node n)
21970 {
21971 /* assert (isUnary (n)) ; */
21972 return makeUnary (n->kind, decl_dupExpr (n->unaryF.arg), n->unaryF.resultType);
21973 /* static analysis guarentees a RETURN statement will be used before here. */
21974 __builtin_unreachable ();
21975 }
21976
21977
21978 /*
21979 dupFunccall -
21980 */
21981
21982 static decl_node dupFunccall (decl_node n)
21983 {
21984 decl_node m;
21985
21986 mcDebug_assert (isFuncCall (n));
21987 m = decl_makeFuncCall (decl_dupExpr (n->funccallF.function), decl_dupExpr (n->funccallF.args));
21988 m->funccallF.type = n->funccallF.type;
21989 return m;
21990 /* static analysis guarentees a RETURN statement will be used before here. */
21991 __builtin_unreachable ();
21992 }
21993
21994
21995 /*
21996 dupSetValue -
21997 */
21998
21999 static decl_node dupSetValue (decl_node n)
22000 {
22001 decl_node m;
22002 unsigned int i;
22003
22004 m = newNode (decl_setvalue);
22005 m->setvalueF.type = n->setvalueF.type;
22006 i = Indexing_LowIndice (n->setvalueF.values);
22007 while (i <= (Indexing_HighIndice (n->setvalueF.values)))
22008 {
22009 m = decl_putSetValue (m, decl_dupExpr (reinterpret_cast<decl_node> (Indexing_GetIndice (n->setvalueF.values, i))));
22010 i += 1;
22011 }
22012 return m;
22013 /* static analysis guarentees a RETURN statement will be used before here. */
22014 __builtin_unreachable ();
22015 }
22016
22017
22018 /*
22019 doDupExpr -
22020 */
22021
22022 static decl_node doDupExpr (decl_node n)
22023 {
22024 mcDebug_assert (n != NULL);
22025 switch (n->kind)
22026 {
22027 case decl_explist:
22028 return dupExplist (n);
22029 break;
22030
22031 case decl_exit:
22032 case decl_return:
22033 case decl_stmtseq:
22034 case decl_comment:
22035 M2RTS_HALT (-1); /* should not be duplicating code. */
22036 __builtin_unreachable ();
22037 break;
22038
22039 case decl_length:
22040 M2RTS_HALT (-1); /* length should have been converted into unary. */
22041 __builtin_unreachable ();
22042 break;
22043
22044 case decl_nil:
22045 case decl_true:
22046 case decl_false:
22047 case decl_address:
22048 case decl_loc:
22049 case decl_byte:
22050 case decl_word:
22051 case decl_csizet:
22052 case decl_cssizet:
22053 case decl_boolean:
22054 case decl_proc:
22055 case decl_char:
22056 case decl_integer:
22057 case decl_cardinal:
22058 case decl_longcard:
22059 case decl_shortcard:
22060 case decl_longint:
22061 case decl_shortint:
22062 case decl_real:
22063 case decl_longreal:
22064 case decl_shortreal:
22065 case decl_bitset:
22066 case decl_ztype:
22067 case decl_rtype:
22068 case decl_complex:
22069 case decl_longcomplex:
22070 case decl_shortcomplex:
22071 /* base types. */
22072 return n;
22073 break;
22074
22075 case decl_type:
22076 case decl_record:
22077 case decl_varient:
22078 case decl_var:
22079 case decl_enumeration:
22080 case decl_subrange:
22081 case decl_subscript:
22082 case decl_array:
22083 case decl_string:
22084 case decl_const:
22085 case decl_literal:
22086 case decl_varparam:
22087 case decl_param:
22088 case decl_varargs:
22089 case decl_optarg:
22090 case decl_pointer:
22091 case decl_recordfield:
22092 case decl_varientfield:
22093 case decl_enumerationfield:
22094 case decl_set:
22095 case decl_proctype:
22096 /* language features and compound type attributes. */
22097 return n;
22098 break;
22099
22100 case decl_procedure:
22101 case decl_def:
22102 case decl_imp:
22103 case decl_module:
22104 /* blocks. */
22105 return n;
22106 break;
22107
22108 case decl_loop:
22109 case decl_while:
22110 case decl_for:
22111 case decl_repeat:
22112 case decl_case:
22113 case decl_caselabellist:
22114 case decl_caselist:
22115 case decl_range:
22116 case decl_if:
22117 case decl_elsif:
22118 case decl_assignment:
22119 /* statements. */
22120 return n;
22121 break;
22122
22123 case decl_arrayref:
22124 /* expressions. */
22125 return dupArrayref (n);
22126 break;
22127
22128 case decl_pointerref:
22129 return dupPointerref (n);
22130 break;
22131
22132 case decl_componentref:
22133 return dupComponentref (n);
22134 break;
22135
22136 case decl_cmplx:
22137 case decl_and:
22138 case decl_or:
22139 case decl_equal:
22140 case decl_notequal:
22141 case decl_less:
22142 case decl_greater:
22143 case decl_greequal:
22144 case decl_lessequal:
22145 case decl_cast:
22146 case decl_val:
22147 case decl_plus:
22148 case decl_sub:
22149 case decl_div:
22150 case decl_mod:
22151 case decl_mult:
22152 case decl_divide:
22153 case decl_in:
22154 return dupBinary (n);
22155 break;
22156
22157 case decl_re:
22158 case decl_im:
22159 case decl_constexp:
22160 case decl_deref:
22161 case decl_abs:
22162 case decl_chr:
22163 case decl_cap:
22164 case decl_high:
22165 case decl_float:
22166 case decl_trunc:
22167 case decl_ord:
22168 case decl_not:
22169 case decl_neg:
22170 case decl_adr:
22171 case decl_size:
22172 case decl_tsize:
22173 case decl_min:
22174 case decl_max:
22175 return dupUnary (n);
22176 break;
22177
22178 case decl_identlist:
22179 return n;
22180 break;
22181
22182 case decl_vardecl:
22183 return n;
22184 break;
22185
22186 case decl_funccall:
22187 return dupFunccall (n);
22188 break;
22189
22190 case decl_setvalue:
22191 return dupSetValue (n);
22192 break;
22193
22194
22195 default:
22196 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
22197 __builtin_unreachable ();
22198 }
22199 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
22200 __builtin_unreachable ();
22201 }
22202
22203
22204 /*
22205 makeSystem -
22206 */
22207
22208 static void makeSystem (void)
22209 {
22210 systemN = decl_lookupDef (nameKey_makeKey ((const char *) "SYSTEM", 6));
22211 addressN = makeBase (decl_address);
22212 locN = makeBase (decl_loc);
22213 byteN = makeBase (decl_byte);
22214 wordN = makeBase (decl_word);
22215 csizetN = makeBase (decl_csizet);
22216 cssizetN = makeBase (decl_cssizet);
22217 adrN = makeBase (decl_adr);
22218 tsizeN = makeBase (decl_tsize);
22219 throwN = makeBase (decl_throw);
22220 decl_enterScope (systemN);
22221 addressN = addToScope (addressN);
22222 locN = addToScope (locN);
22223 byteN = addToScope (byteN);
22224 wordN = addToScope (wordN);
22225 csizetN = addToScope (csizetN);
22226 cssizetN = addToScope (cssizetN);
22227 adrN = addToScope (adrN);
22228 tsizeN = addToScope (tsizeN);
22229 throwN = addToScope (throwN);
22230 mcDebug_assert (sizeN != NULL); /* assumed to be built already. */
22231 sizeN = addToScope (sizeN); /* also export size from system. */
22232 decl_leaveScope (); /* also export size from system. */
22233 addDone (addressN);
22234 addDone (locN);
22235 addDone (byteN);
22236 addDone (wordN);
22237 addDone (csizetN);
22238 addDone (cssizetN);
22239 }
22240
22241
22242 /*
22243 makeM2rts -
22244 */
22245
22246 static void makeM2rts (void)
22247 {
22248 m2rtsN = decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5));
22249 }
22250
22251
22252 /*
22253 makeBitnum -
22254 */
22255
22256 static decl_node makeBitnum (void)
22257 {
22258 decl_node b;
22259
22260 b = newNode (decl_subrange);
22261 b->subrangeF.type = NULL;
22262 b->subrangeF.scope = NULL;
22263 b->subrangeF.low = lookupConst (b, nameKey_makeKey ((const char *) "0", 1));
22264 b->subrangeF.high = lookupConst (b, nameKey_makeKey ((const char *) "31", 2));
22265 return b;
22266 /* static analysis guarentees a RETURN statement will be used before here. */
22267 __builtin_unreachable ();
22268 }
22269
22270
22271 /*
22272 makeBaseSymbols -
22273 */
22274
22275 static void makeBaseSymbols (void)
22276 {
22277 baseSymbols = symbolKey_initTree ();
22278 booleanN = makeBase (decl_boolean);
22279 charN = makeBase (decl_char);
22280 procN = makeBase (decl_proc);
22281 cardinalN = makeBase (decl_cardinal);
22282 longcardN = makeBase (decl_longcard);
22283 shortcardN = makeBase (decl_shortcard);
22284 integerN = makeBase (decl_integer);
22285 longintN = makeBase (decl_longint);
22286 shortintN = makeBase (decl_shortint);
22287 bitsetN = makeBase (decl_bitset);
22288 bitnumN = makeBitnum ();
22289 ztypeN = makeBase (decl_ztype);
22290 rtypeN = makeBase (decl_rtype);
22291 complexN = makeBase (decl_complex);
22292 longcomplexN = makeBase (decl_longcomplex);
22293 shortcomplexN = makeBase (decl_shortcomplex);
22294 realN = makeBase (decl_real);
22295 longrealN = makeBase (decl_longreal);
22296 shortrealN = makeBase (decl_shortreal);
22297 nilN = makeBase (decl_nil);
22298 trueN = makeBase (decl_true);
22299 falseN = makeBase (decl_false);
22300 sizeN = makeBase (decl_size);
22301 minN = makeBase (decl_min);
22302 maxN = makeBase (decl_max);
22303 floatN = makeBase (decl_float);
22304 truncN = makeBase (decl_trunc);
22305 ordN = makeBase (decl_ord);
22306 valN = makeBase (decl_val);
22307 chrN = makeBase (decl_chr);
22308 capN = makeBase (decl_cap);
22309 absN = makeBase (decl_abs);
22310 newN = makeBase (decl_new);
22311 disposeN = makeBase (decl_dispose);
22312 lengthN = makeBase (decl_length);
22313 incN = makeBase (decl_inc);
22314 decN = makeBase (decl_dec);
22315 inclN = makeBase (decl_incl);
22316 exclN = makeBase (decl_excl);
22317 highN = makeBase (decl_high);
22318 imN = makeBase (decl_im);
22319 reN = makeBase (decl_re);
22320 cmplxN = makeBase (decl_cmplx);
22321 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "BOOLEAN", 7), reinterpret_cast<void *> (booleanN));
22322 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "PROC", 4), reinterpret_cast<void *> (procN));
22323 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CHAR", 4), reinterpret_cast<void *> (charN));
22324 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CARDINAL", 8), reinterpret_cast<void *> (cardinalN));
22325 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTCARD", 9), reinterpret_cast<void *> (shortcardN));
22326 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGCARD", 8), reinterpret_cast<void *> (longcardN));
22327 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INTEGER", 7), reinterpret_cast<void *> (integerN));
22328 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGINT", 7), reinterpret_cast<void *> (longintN));
22329 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTINT", 8), reinterpret_cast<void *> (shortintN));
22330 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "BITSET", 6), reinterpret_cast<void *> (bitsetN));
22331 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "REAL", 4), reinterpret_cast<void *> (realN));
22332 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTREAL", 9), reinterpret_cast<void *> (shortrealN));
22333 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGREAL", 8), reinterpret_cast<void *> (longrealN));
22334 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "COMPLEX", 7), reinterpret_cast<void *> (complexN));
22335 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGCOMPLEX", 11), reinterpret_cast<void *> (longcomplexN));
22336 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTCOMPLEX", 12), reinterpret_cast<void *> (shortcomplexN));
22337 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "NIL", 3), reinterpret_cast<void *> (nilN));
22338 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "TRUE", 4), reinterpret_cast<void *> (trueN));
22339 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "FALSE", 5), reinterpret_cast<void *> (falseN));
22340 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SIZE", 4), reinterpret_cast<void *> (sizeN));
22341 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "MIN", 3), reinterpret_cast<void *> (minN));
22342 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "MAX", 3), reinterpret_cast<void *> (maxN));
22343 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "FLOAT", 5), reinterpret_cast<void *> (floatN));
22344 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "TRUNC", 5), reinterpret_cast<void *> (truncN));
22345 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "ORD", 3), reinterpret_cast<void *> (ordN));
22346 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "VAL", 3), reinterpret_cast<void *> (valN));
22347 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CHR", 3), reinterpret_cast<void *> (chrN));
22348 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CAP", 3), reinterpret_cast<void *> (capN));
22349 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "ABS", 3), reinterpret_cast<void *> (absN));
22350 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "NEW", 3), reinterpret_cast<void *> (newN));
22351 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "DISPOSE", 7), reinterpret_cast<void *> (disposeN));
22352 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LENGTH", 6), reinterpret_cast<void *> (lengthN));
22353 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INC", 3), reinterpret_cast<void *> (incN));
22354 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "DEC", 3), reinterpret_cast<void *> (decN));
22355 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INCL", 4), reinterpret_cast<void *> (inclN));
22356 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "EXCL", 4), reinterpret_cast<void *> (exclN));
22357 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "HIGH", 4), reinterpret_cast<void *> (highN));
22358 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CMPLX", 5), reinterpret_cast<void *> (cmplxN));
22359 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "RE", 2), reinterpret_cast<void *> (reN));
22360 symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "IM", 2), reinterpret_cast<void *> (imN));
22361 addDone (booleanN);
22362 addDone (charN);
22363 addDone (cardinalN);
22364 addDone (longcardN);
22365 addDone (shortcardN);
22366 addDone (integerN);
22367 addDone (longintN);
22368 addDone (shortintN);
22369 addDone (bitsetN);
22370 addDone (bitnumN);
22371 addDone (ztypeN);
22372 addDone (rtypeN);
22373 addDone (realN);
22374 addDone (longrealN);
22375 addDone (shortrealN);
22376 addDone (complexN);
22377 addDone (longcomplexN);
22378 addDone (shortcomplexN);
22379 addDone (procN);
22380 addDone (nilN);
22381 addDone (trueN);
22382 addDone (falseN);
22383 }
22384
22385
22386 /*
22387 makeBuiltins -
22388 */
22389
22390 static void makeBuiltins (void)
22391 {
22392 bitsperunitN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "8", 1));
22393 bitsperwordN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "32", 2));
22394 bitspercharN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "8", 1));
22395 unitsperwordN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "4", 1));
22396 addDone (bitsperunitN);
22397 addDone (bitsperwordN);
22398 addDone (bitspercharN);
22399 addDone (unitsperwordN);
22400 }
22401
22402
22403 /*
22404 init -
22405 */
22406
22407 static void init (void)
22408 {
22409 lang = decl_ansiC;
22410 outputFile = FIO_StdOut;
22411 doP = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln});
22412 todoQ = alists_initList ();
22413 partialQ = alists_initList ();
22414 doneQ = alists_initList ();
22415 modUniverse = symbolKey_initTree ();
22416 defUniverse = symbolKey_initTree ();
22417 modUniverseI = Indexing_InitIndex (1);
22418 defUniverseI = Indexing_InitIndex (1);
22419 scopeStack = Indexing_InitIndex (1);
22420 makeBaseSymbols ();
22421 makeSystem ();
22422 makeBuiltins ();
22423 makeM2rts ();
22424 outputState = decl_punct;
22425 tempCount = 0;
22426 mustVisitScope = false;
22427 }
22428
22429
22430 /*
22431 getDeclaredMod - returns the token number associated with the nodes declaration
22432 in the implementation or program module.
22433 */
22434
22435 extern "C" unsigned int decl_getDeclaredMod (decl_node n)
22436 {
22437 return n->at.modDeclared;
22438 /* static analysis guarentees a RETURN statement will be used before here. */
22439 __builtin_unreachable ();
22440 }
22441
22442
22443 /*
22444 getDeclaredDef - returns the token number associated with the nodes declaration
22445 in the definition module.
22446 */
22447
22448 extern "C" unsigned int decl_getDeclaredDef (decl_node n)
22449 {
22450 return n->at.defDeclared;
22451 /* static analysis guarentees a RETURN statement will be used before here. */
22452 __builtin_unreachable ();
22453 }
22454
22455
22456 /*
22457 getFirstUsed - returns the token number associated with the first use of
22458 node, n.
22459 */
22460
22461 extern "C" unsigned int decl_getFirstUsed (decl_node n)
22462 {
22463 return n->at.firstUsed;
22464 /* static analysis guarentees a RETURN statement will be used before here. */
22465 __builtin_unreachable ();
22466 }
22467
22468
22469 /*
22470 isDef - return TRUE if node, n, is a definition module.
22471 */
22472
22473 extern "C" bool decl_isDef (decl_node n)
22474 {
22475 mcDebug_assert (n != NULL);
22476 return n->kind == decl_def;
22477 /* static analysis guarentees a RETURN statement will be used before here. */
22478 __builtin_unreachable ();
22479 }
22480
22481
22482 /*
22483 isImp - return TRUE if node, n, is an implementation module.
22484 */
22485
22486 extern "C" bool decl_isImp (decl_node n)
22487 {
22488 mcDebug_assert (n != NULL);
22489 return n->kind == decl_imp;
22490 /* static analysis guarentees a RETURN statement will be used before here. */
22491 __builtin_unreachable ();
22492 }
22493
22494
22495 /*
22496 isImpOrModule - returns TRUE if, n, is a program module or implementation module.
22497 */
22498
22499 extern "C" bool decl_isImpOrModule (decl_node n)
22500 {
22501 return (decl_isImp (n)) || (decl_isModule (n));
22502 /* static analysis guarentees a RETURN statement will be used before here. */
22503 __builtin_unreachable ();
22504 }
22505
22506
22507 /*
22508 isVisited - returns TRUE if the node was visited.
22509 */
22510
22511 extern "C" bool decl_isVisited (decl_node n)
22512 {
22513 switch (n->kind)
22514 {
22515 case decl_def:
22516 return n->defF.visited;
22517 break;
22518
22519 case decl_imp:
22520 return n->impF.visited;
22521 break;
22522
22523 case decl_module:
22524 return n->moduleF.visited;
22525 break;
22526
22527
22528 default:
22529 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
22530 __builtin_unreachable ();
22531 }
22532 /* static analysis guarentees a RETURN statement will be used before here. */
22533 __builtin_unreachable ();
22534 }
22535
22536
22537 /*
22538 unsetVisited - unset the visited flag on a def/imp/module node.
22539 */
22540
22541 extern "C" void decl_unsetVisited (decl_node n)
22542 {
22543 switch (n->kind)
22544 {
22545 case decl_def:
22546 n->defF.visited = false;
22547 break;
22548
22549 case decl_imp:
22550 n->impF.visited = false;
22551 break;
22552
22553 case decl_module:
22554 n->moduleF.visited = false;
22555 break;
22556
22557
22558 default:
22559 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
22560 __builtin_unreachable ();
22561 }
22562 }
22563
22564
22565 /*
22566 setVisited - set the visited flag on a def/imp/module node.
22567 */
22568
22569 extern "C" void decl_setVisited (decl_node n)
22570 {
22571 switch (n->kind)
22572 {
22573 case decl_def:
22574 n->defF.visited = true;
22575 break;
22576
22577 case decl_imp:
22578 n->impF.visited = true;
22579 break;
22580
22581 case decl_module:
22582 n->moduleF.visited = true;
22583 break;
22584
22585
22586 default:
22587 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
22588 __builtin_unreachable ();
22589 }
22590 }
22591
22592
22593 /*
22594 setEnumsComplete - sets the field inside the def or imp or module, n.
22595 */
22596
22597 extern "C" void decl_setEnumsComplete (decl_node n)
22598 {
22599 switch (n->kind)
22600 {
22601 case decl_def:
22602 n->defF.enumsComplete = true;
22603 break;
22604
22605 case decl_imp:
22606 n->impF.enumsComplete = true;
22607 break;
22608
22609 case decl_module:
22610 n->moduleF.enumsComplete = true;
22611 break;
22612
22613
22614 default:
22615 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
22616 __builtin_unreachable ();
22617 }
22618 }
22619
22620
22621 /*
22622 getEnumsComplete - gets the field from the def or imp or module, n.
22623 */
22624
22625 extern "C" bool decl_getEnumsComplete (decl_node n)
22626 {
22627 switch (n->kind)
22628 {
22629 case decl_def:
22630 return n->defF.enumsComplete;
22631 break;
22632
22633 case decl_imp:
22634 return n->impF.enumsComplete;
22635 break;
22636
22637 case decl_module:
22638 return n->moduleF.enumsComplete;
22639 break;
22640
22641
22642 default:
22643 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
22644 __builtin_unreachable ();
22645 }
22646 /* static analysis guarentees a RETURN statement will be used before here. */
22647 __builtin_unreachable ();
22648 }
22649
22650
22651 /*
22652 resetEnumPos - resets the index into the saved list of enums inside
22653 module, n.
22654 */
22655
22656 extern "C" void decl_resetEnumPos (decl_node n)
22657 {
22658 mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n)));
22659 if (decl_isDef (n))
22660 {
22661 n->defF.enumFixup.count = 0;
22662 }
22663 else if (decl_isImp (n))
22664 {
22665 /* avoid dangling else. */
22666 n->impF.enumFixup.count = 0;
22667 }
22668 else if (decl_isModule (n))
22669 {
22670 /* avoid dangling else. */
22671 n->moduleF.enumFixup.count = 0;
22672 }
22673 }
22674
22675
22676 /*
22677 getNextEnum - returns the next enumeration node.
22678 */
22679
22680 extern "C" decl_node decl_getNextEnum (void)
22681 {
22682 decl_node n;
22683
22684 n = NULL;
22685 mcDebug_assert (((decl_isDef (currentModule)) || (decl_isImp (currentModule))) || (decl_isModule (currentModule)));
22686 if (decl_isDef (currentModule))
22687 {
22688 n = getNextFixup (&currentModule->defF.enumFixup);
22689 }
22690 else if (decl_isImp (currentModule))
22691 {
22692 /* avoid dangling else. */
22693 n = getNextFixup (&currentModule->impF.enumFixup);
22694 }
22695 else if (decl_isModule (currentModule))
22696 {
22697 /* avoid dangling else. */
22698 n = getNextFixup (&currentModule->moduleF.enumFixup);
22699 }
22700 mcDebug_assert (n != NULL);
22701 mcDebug_assert ((decl_isEnumeration (n)) || (decl_isEnumerationField (n)));
22702 return n;
22703 /* static analysis guarentees a RETURN statement will be used before here. */
22704 __builtin_unreachable ();
22705 }
22706
22707
22708 /*
22709 isModule - return TRUE if node, n, is a program module.
22710 */
22711
22712 extern "C" bool decl_isModule (decl_node n)
22713 {
22714 mcDebug_assert (n != NULL);
22715 return n->kind == decl_module;
22716 /* static analysis guarentees a RETURN statement will be used before here. */
22717 __builtin_unreachable ();
22718 }
22719
22720
22721 /*
22722 isMainModule - return TRUE if node, n, is the main module specified
22723 by the source file. This might be a definition,
22724 implementation or program module.
22725 */
22726
22727 extern "C" bool decl_isMainModule (decl_node n)
22728 {
22729 mcDebug_assert (n != NULL);
22730 return n == mainModule;
22731 /* static analysis guarentees a RETURN statement will be used before here. */
22732 __builtin_unreachable ();
22733 }
22734
22735
22736 /*
22737 setMainModule - sets node, n, as the main module to be compiled.
22738 */
22739
22740 extern "C" void decl_setMainModule (decl_node n)
22741 {
22742 mcDebug_assert (n != NULL);
22743 mainModule = n;
22744 }
22745
22746
22747 /*
22748 setCurrentModule - sets node, n, as the current module being compiled.
22749 */
22750
22751 extern "C" void decl_setCurrentModule (decl_node n)
22752 {
22753 mcDebug_assert (n != NULL);
22754 currentModule = n;
22755 }
22756
22757
22758 /*
22759 lookupDef - returns a definition module node named, n.
22760 */
22761
22762 extern "C" decl_node decl_lookupDef (nameKey_Name n)
22763 {
22764 decl_node d;
22765
22766 d = static_cast<decl_node> (symbolKey_getSymKey (defUniverse, n));
22767 if (d == NULL)
22768 {
22769 d = makeDef (n);
22770 symbolKey_putSymKey (defUniverse, n, reinterpret_cast<void *> (d));
22771 Indexing_IncludeIndiceIntoIndex (defUniverseI, reinterpret_cast<void *> (d));
22772 }
22773 return d;
22774 /* static analysis guarentees a RETURN statement will be used before here. */
22775 __builtin_unreachable ();
22776 }
22777
22778
22779 /*
22780 lookupImp - returns an implementation module node named, n.
22781 */
22782
22783 extern "C" decl_node decl_lookupImp (nameKey_Name n)
22784 {
22785 decl_node m;
22786
22787 m = static_cast<decl_node> (symbolKey_getSymKey (modUniverse, n));
22788 if (m == NULL)
22789 {
22790 m = makeImp (n);
22791 symbolKey_putSymKey (modUniverse, n, reinterpret_cast<void *> (m));
22792 Indexing_IncludeIndiceIntoIndex (modUniverseI, reinterpret_cast<void *> (m));
22793 }
22794 mcDebug_assert (! (decl_isModule (m)));
22795 return m;
22796 /* static analysis guarentees a RETURN statement will be used before here. */
22797 __builtin_unreachable ();
22798 }
22799
22800
22801 /*
22802 lookupModule - returns a module node named, n.
22803 */
22804
22805 extern "C" decl_node decl_lookupModule (nameKey_Name n)
22806 {
22807 decl_node m;
22808
22809 m = static_cast<decl_node> (symbolKey_getSymKey (modUniverse, n));
22810 if (m == NULL)
22811 {
22812 m = makeModule (n);
22813 symbolKey_putSymKey (modUniverse, n, reinterpret_cast<void *> (m));
22814 Indexing_IncludeIndiceIntoIndex (modUniverseI, reinterpret_cast<void *> (m));
22815 }
22816 mcDebug_assert (! (decl_isImp (m)));
22817 return m;
22818 /* static analysis guarentees a RETURN statement will be used before here. */
22819 __builtin_unreachable ();
22820 }
22821
22822
22823 /*
22824 putDefForC - the definition module was defined FOR "C".
22825 */
22826
22827 extern "C" void decl_putDefForC (decl_node n)
22828 {
22829 mcDebug_assert (decl_isDef (n));
22830 n->defF.forC = true;
22831 }
22832
22833
22834 /*
22835 lookupInScope - looks up a symbol named, n, from, scope.
22836 */
22837
22838 extern "C" decl_node decl_lookupInScope (decl_node scope, nameKey_Name n)
22839 {
22840 switch (scope->kind)
22841 {
22842 case decl_def:
22843 return static_cast<decl_node> (symbolKey_getSymKey (scope->defF.decls.symbols, n));
22844 break;
22845
22846 case decl_module:
22847 return static_cast<decl_node> (symbolKey_getSymKey (scope->moduleF.decls.symbols, n));
22848 break;
22849
22850 case decl_imp:
22851 return static_cast<decl_node> (symbolKey_getSymKey (scope->impF.decls.symbols, n));
22852 break;
22853
22854 case decl_procedure:
22855 return static_cast<decl_node> (symbolKey_getSymKey (scope->procedureF.decls.symbols, n));
22856 break;
22857
22858 case decl_record:
22859 return static_cast<decl_node> (symbolKey_getSymKey (scope->recordF.localSymbols, n));
22860 break;
22861
22862
22863 default:
22864 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
22865 __builtin_unreachable ();
22866 }
22867 /* static analysis guarentees a RETURN statement will be used before here. */
22868 __builtin_unreachable ();
22869 }
22870
22871
22872 /*
22873 isConst - returns TRUE if node, n, is a const.
22874 */
22875
22876 extern "C" bool decl_isConst (decl_node n)
22877 {
22878 mcDebug_assert (n != NULL);
22879 return n->kind == decl_const;
22880 /* static analysis guarentees a RETURN statement will be used before here. */
22881 __builtin_unreachable ();
22882 }
22883
22884
22885 /*
22886 isType - returns TRUE if node, n, is a type.
22887 */
22888
22889 extern "C" bool decl_isType (decl_node n)
22890 {
22891 mcDebug_assert (n != NULL);
22892 return n->kind == decl_type;
22893 /* static analysis guarentees a RETURN statement will be used before here. */
22894 __builtin_unreachable ();
22895 }
22896
22897
22898 /*
22899 putType - places, exp, as the type alias to des.
22900 TYPE des = exp ;
22901 */
22902
22903 extern "C" void decl_putType (decl_node des, decl_node exp)
22904 {
22905 mcDebug_assert (des != NULL);
22906 mcDebug_assert (decl_isType (des));
22907 des->typeF.type = exp;
22908 }
22909
22910
22911 /*
22912 getType - returns the type associated with node, n.
22913 */
22914
22915 extern "C" decl_node decl_getType (decl_node n)
22916 {
22917 switch (n->kind)
22918 {
22919 case decl_new:
22920 case decl_dispose:
22921 return NULL;
22922 break;
22923
22924 case decl_length:
22925 return cardinalN;
22926 break;
22927
22928 case decl_inc:
22929 case decl_dec:
22930 case decl_incl:
22931 case decl_excl:
22932 return NULL;
22933 break;
22934
22935 case decl_nil:
22936 return addressN;
22937 break;
22938
22939 case decl_true:
22940 case decl_false:
22941 return booleanN;
22942 break;
22943
22944 case decl_address:
22945 return n;
22946 break;
22947
22948 case decl_loc:
22949 return n;
22950 break;
22951
22952 case decl_byte:
22953 return n;
22954 break;
22955
22956 case decl_word:
22957 return n;
22958 break;
22959
22960 case decl_csizet:
22961 return n;
22962 break;
22963
22964 case decl_cssizet:
22965 return n;
22966 break;
22967
22968 case decl_boolean:
22969 /* base types. */
22970 return n;
22971 break;
22972
22973 case decl_proc:
22974 return n;
22975 break;
22976
22977 case decl_char:
22978 return n;
22979 break;
22980
22981 case decl_cardinal:
22982 return n;
22983 break;
22984
22985 case decl_longcard:
22986 return n;
22987 break;
22988
22989 case decl_shortcard:
22990 return n;
22991 break;
22992
22993 case decl_integer:
22994 return n;
22995 break;
22996
22997 case decl_longint:
22998 return n;
22999 break;
23000
23001 case decl_shortint:
23002 return n;
23003 break;
23004
23005 case decl_real:
23006 return n;
23007 break;
23008
23009 case decl_longreal:
23010 return n;
23011 break;
23012
23013 case decl_shortreal:
23014 return n;
23015 break;
23016
23017 case decl_bitset:
23018 return n;
23019 break;
23020
23021 case decl_ztype:
23022 return n;
23023 break;
23024
23025 case decl_rtype:
23026 return n;
23027 break;
23028
23029 case decl_complex:
23030 return n;
23031 break;
23032
23033 case decl_longcomplex:
23034 return n;
23035 break;
23036
23037 case decl_shortcomplex:
23038 return n;
23039 break;
23040
23041 case decl_type:
23042 /* language features and compound type attributes. */
23043 return n->typeF.type;
23044 break;
23045
23046 case decl_record:
23047 return n;
23048 break;
23049
23050 case decl_varient:
23051 return n;
23052 break;
23053
23054 case decl_var:
23055 return n->varF.type;
23056 break;
23057
23058 case decl_enumeration:
23059 return n;
23060 break;
23061
23062 case decl_subrange:
23063 return n->subrangeF.type;
23064 break;
23065
23066 case decl_array:
23067 return n->arrayF.type;
23068 break;
23069
23070 case decl_string:
23071 return charN;
23072 break;
23073
23074 case decl_const:
23075 return n->constF.type;
23076 break;
23077
23078 case decl_literal:
23079 return n->literalF.type;
23080 break;
23081
23082 case decl_varparam:
23083 return n->varparamF.type;
23084 break;
23085
23086 case decl_param:
23087 return n->paramF.type;
23088 break;
23089
23090 case decl_optarg:
23091 return n->optargF.type;
23092 break;
23093
23094 case decl_pointer:
23095 return n->pointerF.type;
23096 break;
23097
23098 case decl_recordfield:
23099 return n->recordfieldF.type;
23100 break;
23101
23102 case decl_varientfield:
23103 return n;
23104 break;
23105
23106 case decl_enumerationfield:
23107 return n->enumerationfieldF.type;
23108 break;
23109
23110 case decl_set:
23111 return n->setF.type;
23112 break;
23113
23114 case decl_proctype:
23115 return n->proctypeF.returnType;
23116 break;
23117
23118 case decl_subscript:
23119 return n->subscriptF.type;
23120 break;
23121
23122 case decl_procedure:
23123 /* blocks. */
23124 return n->procedureF.returnType;
23125 break;
23126
23127 case decl_throw:
23128 return NULL;
23129 break;
23130
23131 case decl_unreachable:
23132 return NULL;
23133 break;
23134
23135 case decl_def:
23136 case decl_imp:
23137 case decl_module:
23138 case decl_loop:
23139 case decl_while:
23140 case decl_for:
23141 case decl_repeat:
23142 case decl_if:
23143 case decl_elsif:
23144 case decl_assignment:
23145 /* statements. */
23146 M2RTS_HALT (-1);
23147 __builtin_unreachable ();
23148 break;
23149
23150 case decl_cmplx:
23151 case decl_cast:
23152 case decl_val:
23153 case decl_plus:
23154 case decl_sub:
23155 case decl_div:
23156 case decl_mod:
23157 case decl_mult:
23158 case decl_divide:
23159 /* expressions. */
23160 return n->binaryF.resultType;
23161 break;
23162
23163 case decl_in:
23164 return booleanN;
23165 break;
23166
23167 case decl_max:
23168 case decl_min:
23169 case decl_re:
23170 case decl_im:
23171 case decl_abs:
23172 case decl_constexp:
23173 case decl_deref:
23174 case decl_neg:
23175 case decl_adr:
23176 case decl_size:
23177 case decl_tsize:
23178 return n->unaryF.resultType;
23179 break;
23180
23181 case decl_and:
23182 case decl_or:
23183 case decl_not:
23184 case decl_equal:
23185 case decl_notequal:
23186 case decl_less:
23187 case decl_greater:
23188 case decl_greequal:
23189 case decl_lessequal:
23190 return booleanN;
23191 break;
23192
23193 case decl_trunc:
23194 return integerN;
23195 break;
23196
23197 case decl_float:
23198 return realN;
23199 break;
23200
23201 case decl_high:
23202 return cardinalN;
23203 break;
23204
23205 case decl_ord:
23206 return cardinalN;
23207 break;
23208
23209 case decl_chr:
23210 return charN;
23211 break;
23212
23213 case decl_cap:
23214 return charN;
23215 break;
23216
23217 case decl_arrayref:
23218 return n->arrayrefF.resultType;
23219 break;
23220
23221 case decl_componentref:
23222 return n->componentrefF.resultType;
23223 break;
23224
23225 case decl_pointerref:
23226 return n->pointerrefF.resultType;
23227 break;
23228
23229 case decl_funccall:
23230 return n->funccallF.type;
23231 break;
23232
23233 case decl_setvalue:
23234 return n->setvalueF.type;
23235 break;
23236
23237
23238 default:
23239 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
23240 __builtin_unreachable ();
23241 }
23242 M2RTS_HALT (-1);
23243 __builtin_unreachable ();
23244 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
23245 __builtin_unreachable ();
23246 }
23247
23248
23249 /*
23250 skipType - skips over type aliases.
23251 */
23252
23253 extern "C" decl_node decl_skipType (decl_node n)
23254 {
23255 while ((n != NULL) && (decl_isType (n)))
23256 {
23257 if ((decl_getType (n)) == NULL)
23258 {
23259 /* this will occur if, n, is an opaque type. */
23260 return n;
23261 }
23262 n = decl_getType (n);
23263 }
23264 return n;
23265 /* static analysis guarentees a RETURN statement will be used before here. */
23266 __builtin_unreachable ();
23267 }
23268
23269
23270 /*
23271 putTypeHidden - marks type, des, as being a hidden type.
23272 TYPE des ;
23273 */
23274
23275 extern "C" void decl_putTypeHidden (decl_node des)
23276 {
23277 decl_node s;
23278
23279 mcDebug_assert (des != NULL);
23280 mcDebug_assert (decl_isType (des));
23281 des->typeF.isHidden = true;
23282 s = decl_getScope (des);
23283 mcDebug_assert (decl_isDef (s));
23284 s->defF.hasHidden = true;
23285 }
23286
23287
23288 /*
23289 isTypeHidden - returns TRUE if type, n, is hidden.
23290 */
23291
23292 extern "C" bool decl_isTypeHidden (decl_node n)
23293 {
23294 mcDebug_assert (n != NULL);
23295 mcDebug_assert (decl_isType (n));
23296 return n->typeF.isHidden;
23297 /* static analysis guarentees a RETURN statement will be used before here. */
23298 __builtin_unreachable ();
23299 }
23300
23301
23302 /*
23303 hasHidden - returns TRUE if module, n, has a hidden type.
23304 */
23305
23306 extern "C" bool decl_hasHidden (decl_node n)
23307 {
23308 mcDebug_assert (decl_isDef (n));
23309 return n->defF.hasHidden;
23310 /* static analysis guarentees a RETURN statement will be used before here. */
23311 __builtin_unreachable ();
23312 }
23313
23314
23315 /*
23316 isVar - returns TRUE if node, n, is a type.
23317 */
23318
23319 extern "C" bool decl_isVar (decl_node n)
23320 {
23321 mcDebug_assert (n != NULL);
23322 return n->kind == decl_var;
23323 /* static analysis guarentees a RETURN statement will be used before here. */
23324 __builtin_unreachable ();
23325 }
23326
23327
23328 /*
23329 isTemporary - returns TRUE if node, n, is a variable and temporary.
23330 */
23331
23332 extern "C" bool decl_isTemporary (decl_node n)
23333 {
23334 return false;
23335 /* static analysis guarentees a RETURN statement will be used before here. */
23336 __builtin_unreachable ();
23337 }
23338
23339
23340 /*
23341 isExported - returns TRUE if symbol, n, is exported from
23342 the definition module.
23343 */
23344
23345 extern "C" bool decl_isExported (decl_node n)
23346 {
23347 decl_node s;
23348
23349 s = decl_getScope (n);
23350 if (s != NULL)
23351 {
23352 switch (s->kind)
23353 {
23354 case decl_def:
23355 return Indexing_IsIndiceInIndex (s->defF.exported, reinterpret_cast<void *> (n));
23356 break;
23357
23358
23359 default:
23360 return false;
23361 break;
23362 }
23363 }
23364 return false;
23365 /* static analysis guarentees a RETURN statement will be used before here. */
23366 __builtin_unreachable ();
23367 }
23368
23369
23370 /*
23371 getDeclScope - returns the node representing the
23372 current declaration scope.
23373 */
23374
23375 extern "C" decl_node decl_getDeclScope (void)
23376 {
23377 unsigned int i;
23378
23379 i = Indexing_HighIndice (scopeStack);
23380 return static_cast<decl_node> (Indexing_GetIndice (scopeStack, i));
23381 /* static analysis guarentees a RETURN statement will be used before here. */
23382 __builtin_unreachable ();
23383 }
23384
23385
23386 /*
23387 getScope - returns the scope associated with node, n.
23388 */
23389
23390 extern "C" decl_node decl_getScope (decl_node n)
23391 {
23392 switch (n->kind)
23393 {
23394 case decl_stmtseq:
23395 case decl_exit:
23396 case decl_return:
23397 case decl_comment:
23398 case decl_identlist:
23399 case decl_setvalue:
23400 case decl_halt:
23401 case decl_new:
23402 case decl_dispose:
23403 case decl_length:
23404 case decl_inc:
23405 case decl_dec:
23406 case decl_incl:
23407 case decl_excl:
23408 case decl_nil:
23409 case decl_true:
23410 case decl_false:
23411 return NULL;
23412 break;
23413
23414 case decl_address:
23415 case decl_loc:
23416 case decl_byte:
23417 case decl_word:
23418 case decl_csizet:
23419 case decl_cssizet:
23420 return systemN;
23421 break;
23422
23423 case decl_boolean:
23424 case decl_proc:
23425 case decl_char:
23426 case decl_cardinal:
23427 case decl_longcard:
23428 case decl_shortcard:
23429 case decl_integer:
23430 case decl_longint:
23431 case decl_shortint:
23432 case decl_real:
23433 case decl_longreal:
23434 case decl_shortreal:
23435 case decl_bitset:
23436 case decl_ztype:
23437 case decl_rtype:
23438 case decl_complex:
23439 case decl_longcomplex:
23440 case decl_shortcomplex:
23441 /* base types. */
23442 return NULL;
23443 break;
23444
23445 case decl_type:
23446 /* language features and compound type attributes. */
23447 return n->typeF.scope;
23448 break;
23449
23450 case decl_record:
23451 return n->recordF.scope;
23452 break;
23453
23454 case decl_varient:
23455 return n->varientF.scope;
23456 break;
23457
23458 case decl_var:
23459 return n->varF.scope;
23460 break;
23461
23462 case decl_enumeration:
23463 return n->enumerationF.scope;
23464 break;
23465
23466 case decl_subrange:
23467 return n->subrangeF.scope;
23468 break;
23469
23470 case decl_array:
23471 return n->arrayF.scope;
23472 break;
23473
23474 case decl_string:
23475 return NULL;
23476 break;
23477
23478 case decl_const:
23479 return n->constF.scope;
23480 break;
23481
23482 case decl_literal:
23483 return NULL;
23484 break;
23485
23486 case decl_varparam:
23487 return n->varparamF.scope;
23488 break;
23489
23490 case decl_param:
23491 return n->paramF.scope;
23492 break;
23493
23494 case decl_optarg:
23495 return n->optargF.scope;
23496 break;
23497
23498 case decl_pointer:
23499 return n->pointerF.scope;
23500 break;
23501
23502 case decl_recordfield:
23503 return n->recordfieldF.scope;
23504 break;
23505
23506 case decl_varientfield:
23507 return n->varientfieldF.scope;
23508 break;
23509
23510 case decl_enumerationfield:
23511 return n->enumerationfieldF.scope;
23512 break;
23513
23514 case decl_set:
23515 return n->setF.scope;
23516 break;
23517
23518 case decl_proctype:
23519 return n->proctypeF.scope;
23520 break;
23521
23522 case decl_subscript:
23523 return NULL;
23524 break;
23525
23526 case decl_procedure:
23527 /* blocks. */
23528 return n->procedureF.scope;
23529 break;
23530
23531 case decl_def:
23532 case decl_imp:
23533 case decl_module:
23534 case decl_case:
23535 case decl_loop:
23536 case decl_while:
23537 case decl_for:
23538 case decl_repeat:
23539 case decl_if:
23540 case decl_elsif:
23541 case decl_assignment:
23542 /* statements. */
23543 return NULL;
23544 break;
23545
23546 case decl_componentref:
23547 case decl_pointerref:
23548 case decl_arrayref:
23549 case decl_chr:
23550 case decl_cap:
23551 case decl_ord:
23552 case decl_float:
23553 case decl_trunc:
23554 case decl_high:
23555 case decl_cast:
23556 case decl_val:
23557 case decl_plus:
23558 case decl_sub:
23559 case decl_div:
23560 case decl_mod:
23561 case decl_mult:
23562 case decl_divide:
23563 case decl_in:
23564 /* expressions. */
23565 return NULL;
23566 break;
23567
23568 case decl_neg:
23569 return NULL;
23570 break;
23571
23572 case decl_lsl:
23573 case decl_lsr:
23574 case decl_lor:
23575 case decl_land:
23576 case decl_lnot:
23577 case decl_lxor:
23578 case decl_and:
23579 case decl_or:
23580 case decl_not:
23581 case decl_constexp:
23582 case decl_deref:
23583 case decl_equal:
23584 case decl_notequal:
23585 case decl_less:
23586 case decl_greater:
23587 case decl_greequal:
23588 case decl_lessequal:
23589 return NULL;
23590 break;
23591
23592 case decl_adr:
23593 case decl_size:
23594 case decl_tsize:
23595 case decl_throw:
23596 return systemN;
23597 break;
23598
23599 case decl_unreachable:
23600 case decl_cmplx:
23601 case decl_re:
23602 case decl_im:
23603 case decl_min:
23604 case decl_max:
23605 return NULL;
23606 break;
23607
23608 case decl_vardecl:
23609 return n->vardeclF.scope;
23610 break;
23611
23612 case decl_funccall:
23613 return NULL;
23614 break;
23615
23616 case decl_explist:
23617 return NULL;
23618 break;
23619
23620 case decl_caselabellist:
23621 return NULL;
23622 break;
23623
23624 case decl_caselist:
23625 return NULL;
23626 break;
23627
23628 case decl_range:
23629 return NULL;
23630 break;
23631
23632 case decl_varargs:
23633 return n->varargsF.scope;
23634 break;
23635
23636
23637 default:
23638 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
23639 __builtin_unreachable ();
23640 }
23641 /* static analysis guarentees a RETURN statement will be used before here. */
23642 __builtin_unreachable ();
23643 }
23644
23645
23646 /*
23647 isLiteral - returns TRUE if, n, is a literal.
23648 */
23649
23650 extern "C" bool decl_isLiteral (decl_node n)
23651 {
23652 mcDebug_assert (n != NULL);
23653 return n->kind == decl_literal;
23654 /* static analysis guarentees a RETURN statement will be used before here. */
23655 __builtin_unreachable ();
23656 }
23657
23658
23659 /*
23660 isConstSet - returns TRUE if, n, is a constant set.
23661 */
23662
23663 extern "C" bool decl_isConstSet (decl_node n)
23664 {
23665 mcDebug_assert (n != NULL);
23666 if ((decl_isLiteral (n)) || (decl_isConst (n)))
23667 {
23668 return decl_isSet (decl_skipType (decl_getType (n)));
23669 }
23670 return false;
23671 /* static analysis guarentees a RETURN statement will be used before here. */
23672 __builtin_unreachable ();
23673 }
23674
23675
23676 /*
23677 isEnumerationField - returns TRUE if, n, is an enumeration field.
23678 */
23679
23680 extern "C" bool decl_isEnumerationField (decl_node n)
23681 {
23682 mcDebug_assert (n != NULL);
23683 return n->kind == decl_enumerationfield;
23684 /* static analysis guarentees a RETURN statement will be used before here. */
23685 __builtin_unreachable ();
23686 }
23687
23688
23689 /*
23690 isEnumeration - returns TRUE if node, n, is an enumeration type.
23691 */
23692
23693 extern "C" bool decl_isEnumeration (decl_node n)
23694 {
23695 mcDebug_assert (n != NULL);
23696 return n->kind == decl_enumeration;
23697 /* static analysis guarentees a RETURN statement will be used before here. */
23698 __builtin_unreachable ();
23699 }
23700
23701
23702 /*
23703 isUnbounded - returns TRUE if, n, is an unbounded array.
23704 */
23705
23706 extern "C" bool decl_isUnbounded (decl_node n)
23707 {
23708 mcDebug_assert (n != NULL);
23709 return (n->kind == decl_array) && n->arrayF.isUnbounded;
23710 /* static analysis guarentees a RETURN statement will be used before here. */
23711 __builtin_unreachable ();
23712 }
23713
23714
23715 /*
23716 isParameter - returns TRUE if, n, is a parameter.
23717 */
23718
23719 extern "C" bool decl_isParameter (decl_node n)
23720 {
23721 mcDebug_assert (n != NULL);
23722 return (n->kind == decl_param) || (n->kind == decl_varparam);
23723 /* static analysis guarentees a RETURN statement will be used before here. */
23724 __builtin_unreachable ();
23725 }
23726
23727
23728 /*
23729 isVarParam - returns TRUE if, n, is a var parameter.
23730 */
23731
23732 extern "C" bool decl_isVarParam (decl_node n)
23733 {
23734 mcDebug_assert (n != NULL);
23735 return n->kind == decl_varparam;
23736 /* static analysis guarentees a RETURN statement will be used before here. */
23737 __builtin_unreachable ();
23738 }
23739
23740
23741 /*
23742 isParam - returns TRUE if, n, is a non var parameter.
23743 */
23744
23745 extern "C" bool decl_isParam (decl_node n)
23746 {
23747 mcDebug_assert (n != NULL);
23748 return n->kind == decl_param;
23749 /* static analysis guarentees a RETURN statement will be used before here. */
23750 __builtin_unreachable ();
23751 }
23752
23753
23754 /*
23755 isNonVarParam - is an alias to isParam.
23756 */
23757
23758 extern "C" bool decl_isNonVarParam (decl_node n)
23759 {
23760 return decl_isParam (n);
23761 /* static analysis guarentees a RETURN statement will be used before here. */
23762 __builtin_unreachable ();
23763 }
23764
23765
23766 /*
23767 addOptParameter - returns an optarg which has been created and added to
23768 procedure node, proc. It has a name, id, and, type,
23769 and an initial value, init.
23770 */
23771
23772 extern "C" decl_node decl_addOptParameter (decl_node proc, nameKey_Name id, decl_node type, decl_node init)
23773 {
23774 decl_node p;
23775 decl_node l;
23776
23777 mcDebug_assert (decl_isProcedure (proc));
23778 l = decl_makeIdentList ();
23779 mcDebug_assert (decl_putIdent (l, id));
23780 checkMakeVariables (proc, l, type, false, true);
23781 if (! proc->procedureF.checking)
23782 {
23783 p = makeOptParameter (l, type, init);
23784 decl_addParameter (proc, p);
23785 }
23786 return p;
23787 /* static analysis guarentees a RETURN statement will be used before here. */
23788 __builtin_unreachable ();
23789 }
23790
23791
23792 /*
23793 isOptarg - returns TRUE if, n, is an optarg.
23794 */
23795
23796 extern "C" bool decl_isOptarg (decl_node n)
23797 {
23798 return n->kind == decl_optarg;
23799 /* static analysis guarentees a RETURN statement will be used before here. */
23800 __builtin_unreachable ();
23801 }
23802
23803
23804 /*
23805 isRecord - returns TRUE if, n, is a record.
23806 */
23807
23808 extern "C" bool decl_isRecord (decl_node n)
23809 {
23810 mcDebug_assert (n != NULL);
23811 return n->kind == decl_record;
23812 /* static analysis guarentees a RETURN statement will be used before here. */
23813 __builtin_unreachable ();
23814 }
23815
23816
23817 /*
23818 isRecordField - returns TRUE if, n, is a record field.
23819 */
23820
23821 extern "C" bool decl_isRecordField (decl_node n)
23822 {
23823 mcDebug_assert (n != NULL);
23824 return n->kind == decl_recordfield;
23825 /* static analysis guarentees a RETURN statement will be used before here. */
23826 __builtin_unreachable ();
23827 }
23828
23829
23830 /*
23831 isVarientField - returns TRUE if, n, is a varient field.
23832 */
23833
23834 extern "C" bool decl_isVarientField (decl_node n)
23835 {
23836 mcDebug_assert (n != NULL);
23837 return n->kind == decl_varientfield;
23838 /* static analysis guarentees a RETURN statement will be used before here. */
23839 __builtin_unreachable ();
23840 }
23841
23842
23843 /*
23844 isArray - returns TRUE if, n, is an array.
23845 */
23846
23847 extern "C" bool decl_isArray (decl_node n)
23848 {
23849 mcDebug_assert (n != NULL);
23850 return n->kind == decl_array;
23851 /* static analysis guarentees a RETURN statement will be used before here. */
23852 __builtin_unreachable ();
23853 }
23854
23855
23856 /*
23857 isProcType - returns TRUE if, n, is a procedure type.
23858 */
23859
23860 extern "C" bool decl_isProcType (decl_node n)
23861 {
23862 mcDebug_assert (n != NULL);
23863 return n->kind == decl_proctype;
23864 /* static analysis guarentees a RETURN statement will be used before here. */
23865 __builtin_unreachable ();
23866 }
23867
23868
23869 /*
23870 isPointer - returns TRUE if, n, is a pointer.
23871 */
23872
23873 extern "C" bool decl_isPointer (decl_node n)
23874 {
23875 mcDebug_assert (n != NULL);
23876 return n->kind == decl_pointer;
23877 /* static analysis guarentees a RETURN statement will be used before here. */
23878 __builtin_unreachable ();
23879 }
23880
23881
23882 /*
23883 isProcedure - returns TRUE if, n, is a procedure.
23884 */
23885
23886 extern "C" bool decl_isProcedure (decl_node n)
23887 {
23888 mcDebug_assert (n != NULL);
23889 return n->kind == decl_procedure;
23890 /* static analysis guarentees a RETURN statement will be used before here. */
23891 __builtin_unreachable ();
23892 }
23893
23894
23895 /*
23896 isVarient - returns TRUE if, n, is a varient record.
23897 */
23898
23899 extern "C" bool decl_isVarient (decl_node n)
23900 {
23901 mcDebug_assert (n != NULL);
23902 return n->kind == decl_varient;
23903 /* static analysis guarentees a RETURN statement will be used before here. */
23904 __builtin_unreachable ();
23905 }
23906
23907
23908 /*
23909 isSet - returns TRUE if, n, is a set type.
23910 */
23911
23912 extern "C" bool decl_isSet (decl_node n)
23913 {
23914 mcDebug_assert (n != NULL);
23915 return n->kind == decl_set;
23916 /* static analysis guarentees a RETURN statement will be used before here. */
23917 __builtin_unreachable ();
23918 }
23919
23920
23921 /*
23922 isSubrange - returns TRUE if, n, is a subrange type.
23923 */
23924
23925 extern "C" bool decl_isSubrange (decl_node n)
23926 {
23927 mcDebug_assert (n != NULL);
23928 return n->kind == decl_subrange;
23929 /* static analysis guarentees a RETURN statement will be used before here. */
23930 __builtin_unreachable ();
23931 }
23932
23933
23934 /*
23935 isZtype - returns TRUE if, n, is the Z type.
23936 */
23937
23938 extern "C" bool decl_isZtype (decl_node n)
23939 {
23940 return n == ztypeN;
23941 /* static analysis guarentees a RETURN statement will be used before here. */
23942 __builtin_unreachable ();
23943 }
23944
23945
23946 /*
23947 isRtype - returns TRUE if, n, is the R type.
23948 */
23949
23950 extern "C" bool decl_isRtype (decl_node n)
23951 {
23952 return n == rtypeN;
23953 /* static analysis guarentees a RETURN statement will be used before here. */
23954 __builtin_unreachable ();
23955 }
23956
23957
23958 /*
23959 makeConst - create, initialise and return a const node.
23960 */
23961
23962 extern "C" decl_node decl_makeConst (nameKey_Name n)
23963 {
23964 decl_node d;
23965
23966 d = newNode (decl_const);
23967 d->constF.name = n;
23968 d->constF.type = NULL;
23969 d->constF.scope = decl_getDeclScope ();
23970 d->constF.value = NULL;
23971 return addToScope (d);
23972 /* static analysis guarentees a RETURN statement will be used before here. */
23973 __builtin_unreachable ();
23974 }
23975
23976
23977 /*
23978 putConst - places value, v, into node, n.
23979 */
23980
23981 extern "C" void decl_putConst (decl_node n, decl_node v)
23982 {
23983 mcDebug_assert (decl_isConst (n));
23984 n->constF.value = v;
23985 }
23986
23987
23988 /*
23989 makeType - create, initialise and return a type node.
23990 */
23991
23992 extern "C" decl_node decl_makeType (nameKey_Name n)
23993 {
23994 decl_node d;
23995
23996 d = newNode (decl_type);
23997 d->typeF.name = n;
23998 d->typeF.type = NULL;
23999 d->typeF.scope = decl_getDeclScope ();
24000 d->typeF.isHidden = false;
24001 d->typeF.isInternal = false;
24002 return addToScope (d);
24003 /* static analysis guarentees a RETURN statement will be used before here. */
24004 __builtin_unreachable ();
24005 }
24006
24007
24008 /*
24009 makeTypeImp - lookup a type in the definition module
24010 and return it. Otherwise create a new type.
24011 */
24012
24013 extern "C" decl_node decl_makeTypeImp (nameKey_Name n)
24014 {
24015 decl_node d;
24016
24017 d = decl_lookupSym (n);
24018 if (d != NULL)
24019 {
24020 d->typeF.isHidden = false;
24021 return addToScope (d);
24022 }
24023 else
24024 {
24025 d = newNode (decl_type);
24026 d->typeF.name = n;
24027 d->typeF.type = NULL;
24028 d->typeF.scope = decl_getDeclScope ();
24029 d->typeF.isHidden = false;
24030 return addToScope (d);
24031 }
24032 /* static analysis guarentees a RETURN statement will be used before here. */
24033 __builtin_unreachable ();
24034 }
24035
24036
24037 /*
24038 makeVar - create, initialise and return a var node.
24039 */
24040
24041 extern "C" decl_node decl_makeVar (nameKey_Name n)
24042 {
24043 decl_node d;
24044
24045 d = newNode (decl_var);
24046 d->varF.name = n;
24047 d->varF.type = NULL;
24048 d->varF.decl = NULL;
24049 d->varF.scope = decl_getDeclScope ();
24050 d->varF.isInitialised = false;
24051 d->varF.isParameter = false;
24052 d->varF.isVarParameter = false;
24053 initCname (&d->varF.cname);
24054 return addToScope (d);
24055 /* static analysis guarentees a RETURN statement will be used before here. */
24056 __builtin_unreachable ();
24057 }
24058
24059
24060 /*
24061 putVar - places, type, as the type for var.
24062 */
24063
24064 extern "C" void decl_putVar (decl_node var, decl_node type, decl_node decl)
24065 {
24066 mcDebug_assert (var != NULL);
24067 mcDebug_assert (decl_isVar (var));
24068 var->varF.type = type;
24069 var->varF.decl = decl;
24070 }
24071
24072
24073 /*
24074 makeVarDecl - create a vardecl node and create a shadow variable in the
24075 current scope.
24076 */
24077
24078 extern "C" decl_node decl_makeVarDecl (decl_node i, decl_node type)
24079 {
24080 decl_node d;
24081 decl_node v;
24082 unsigned int j;
24083 unsigned int n;
24084
24085 type = checkPtr (type);
24086 d = newNode (decl_vardecl);
24087 d->vardeclF.names = i->identlistF.names;
24088 d->vardeclF.type = type;
24089 d->vardeclF.scope = decl_getDeclScope ();
24090 n = wlists_noOfItemsInList (d->vardeclF.names);
24091 j = 1;
24092 while (j <= n)
24093 {
24094 v = decl_lookupSym (wlists_getItemFromList (d->vardeclF.names, j));
24095 mcDebug_assert (decl_isVar (v));
24096 decl_putVar (v, type, d);
24097 j += 1;
24098 }
24099 return d;
24100 /* static analysis guarentees a RETURN statement will be used before here. */
24101 __builtin_unreachable ();
24102 }
24103
24104
24105 /*
24106 makeEnum - creates an enumerated type and returns the node.
24107 */
24108
24109 extern "C" decl_node decl_makeEnum (void)
24110 {
24111 if ((currentModule != NULL) && (decl_getEnumsComplete (currentModule)))
24112 {
24113 return decl_getNextEnum ();
24114 }
24115 else
24116 {
24117 return doMakeEnum ();
24118 }
24119 /* static analysis guarentees a RETURN statement will be used before here. */
24120 __builtin_unreachable ();
24121 }
24122
24123
24124 /*
24125 makeEnumField - returns an enumeration field, named, n.
24126 */
24127
24128 extern "C" decl_node decl_makeEnumField (decl_node e, nameKey_Name n)
24129 {
24130 if ((currentModule != NULL) && (decl_getEnumsComplete (currentModule)))
24131 {
24132 return decl_getNextEnum ();
24133 }
24134 else
24135 {
24136 return doMakeEnumField (e, n);
24137 }
24138 /* static analysis guarentees a RETURN statement will be used before here. */
24139 __builtin_unreachable ();
24140 }
24141
24142
24143 /*
24144 makeSubrange - returns a subrange node, built from range: low..high.
24145 */
24146
24147 extern "C" decl_node decl_makeSubrange (decl_node low, decl_node high)
24148 {
24149 decl_node n;
24150
24151 n = newNode (decl_subrange);
24152 n->subrangeF.low = low;
24153 n->subrangeF.high = high;
24154 n->subrangeF.type = NULL;
24155 n->subrangeF.scope = decl_getDeclScope ();
24156 return n;
24157 /* static analysis guarentees a RETURN statement will be used before here. */
24158 __builtin_unreachable ();
24159 }
24160
24161
24162 /*
24163 putSubrangeType - assigns, type, to the subrange type, sub.
24164 */
24165
24166 extern "C" void decl_putSubrangeType (decl_node sub, decl_node type)
24167 {
24168 mcDebug_assert (decl_isSubrange (sub));
24169 sub->subrangeF.type = type;
24170 }
24171
24172
24173 /*
24174 makePointer - returns a pointer of, type, node.
24175 */
24176
24177 extern "C" decl_node decl_makePointer (decl_node type)
24178 {
24179 decl_node n;
24180
24181 n = newNode (decl_pointer);
24182 n->pointerF.type = type;
24183 n->pointerF.scope = decl_getDeclScope ();
24184 return n;
24185 /* static analysis guarentees a RETURN statement will be used before here. */
24186 __builtin_unreachable ();
24187 }
24188
24189
24190 /*
24191 makeSet - returns a set of, type, node.
24192 */
24193
24194 extern "C" decl_node decl_makeSet (decl_node type)
24195 {
24196 decl_node n;
24197
24198 n = newNode (decl_set);
24199 n->setF.type = type;
24200 n->setF.scope = decl_getDeclScope ();
24201 return n;
24202 /* static analysis guarentees a RETURN statement will be used before here. */
24203 __builtin_unreachable ();
24204 }
24205
24206
24207 /*
24208 makeArray - returns a node representing ARRAY subr OF type.
24209 */
24210
24211 extern "C" decl_node decl_makeArray (decl_node subr, decl_node type)
24212 {
24213 decl_node n;
24214 decl_node s;
24215
24216 s = decl_skipType (subr);
24217 mcDebug_assert (((decl_isSubrange (s)) || (isOrdinal (s))) || (decl_isEnumeration (s)));
24218 n = newNode (decl_array);
24219 n->arrayF.subr = subr;
24220 n->arrayF.type = type;
24221 n->arrayF.scope = decl_getDeclScope ();
24222 n->arrayF.isUnbounded = false;
24223 return n;
24224 /* static analysis guarentees a RETURN statement will be used before here. */
24225 __builtin_unreachable ();
24226 }
24227
24228
24229 /*
24230 putUnbounded - sets array, n, as unbounded.
24231 */
24232
24233 extern "C" void decl_putUnbounded (decl_node n)
24234 {
24235 mcDebug_assert (n->kind == decl_array);
24236 n->arrayF.isUnbounded = true;
24237 }
24238
24239
24240 /*
24241 makeRecord - creates and returns a record node.
24242 */
24243
24244 extern "C" decl_node decl_makeRecord (void)
24245 {
24246 decl_node n;
24247
24248 n = newNode (decl_record);
24249 n->recordF.localSymbols = symbolKey_initTree ();
24250 n->recordF.listOfSons = Indexing_InitIndex (1);
24251 n->recordF.scope = decl_getDeclScope ();
24252 return n;
24253 /* static analysis guarentees a RETURN statement will be used before here. */
24254 __builtin_unreachable ();
24255 }
24256
24257
24258 /*
24259 makeVarient - creates a new symbol, a varient symbol for record or varient field
24260 symbol, r.
24261 */
24262
24263 extern "C" decl_node decl_makeVarient (decl_node r)
24264 {
24265 decl_node n;
24266
24267 n = newNode (decl_varient);
24268 n->varientF.listOfSons = Indexing_InitIndex (1);
24269 /* if so use this n^.varientF.parent := r */
24270 if (decl_isRecord (r))
24271 {
24272 n->varientF.varient = NULL;
24273 }
24274 else
24275 {
24276 n->varientF.varient = r;
24277 }
24278 n->varientF.tag = NULL;
24279 n->varientF.scope = decl_getDeclScope ();
24280 switch (r->kind)
24281 {
24282 case decl_record:
24283 /* now add, n, to the record/varient, r, field list */
24284 Indexing_IncludeIndiceIntoIndex (r->recordF.listOfSons, reinterpret_cast<void *> (n));
24285 break;
24286
24287 case decl_varientfield:
24288 Indexing_IncludeIndiceIntoIndex (r->varientfieldF.listOfSons, reinterpret_cast<void *> (n));
24289 break;
24290
24291
24292 default:
24293 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
24294 __builtin_unreachable ();
24295 }
24296 return n;
24297 /* static analysis guarentees a RETURN statement will be used before here. */
24298 __builtin_unreachable ();
24299 }
24300
24301
24302 /*
24303 addFieldsToRecord - adds fields, i, of type, t, into a record, r.
24304 It returns, r.
24305 */
24306
24307 extern "C" decl_node decl_addFieldsToRecord (decl_node r, decl_node v, decl_node i, decl_node t)
24308 {
24309 decl_node p;
24310 decl_node fj;
24311 unsigned int j;
24312 unsigned int n;
24313 nameKey_Name fn;
24314
24315 if (decl_isRecord (r))
24316 {
24317 p = r;
24318 v = NULL;
24319 }
24320 else
24321 {
24322 p = getRecord (getParent (r));
24323 mcDebug_assert (decl_isVarientField (r));
24324 mcDebug_assert (decl_isVarient (v));
24325 putFieldVarient (r, v);
24326 }
24327 n = wlists_noOfItemsInList (i->identlistF.names);
24328 j = 1;
24329 while (j <= n)
24330 {
24331 fn = static_cast<nameKey_Name> (wlists_getItemFromList (i->identlistF.names, j));
24332 fj = static_cast<decl_node> (symbolKey_getSymKey (p->recordF.localSymbols, n));
24333 if (fj == NULL)
24334 {
24335 fj = putFieldRecord (r, fn, t, v);
24336 }
24337 else
24338 {
24339 mcMetaError_metaErrors2 ((const char *) "record field {%1ad} has already been declared inside a {%2Dd} {%2a}", 67, (const char *) "attempting to declare a duplicate record field", 46, (const unsigned char *) &fj, (sizeof (fj)-1), (const unsigned char *) &p, (sizeof (p)-1));
24340 }
24341 j += 1;
24342 }
24343 return r;
24344 /* static analysis guarentees a RETURN statement will be used before here. */
24345 __builtin_unreachable ();
24346 }
24347
24348
24349 /*
24350 buildVarientSelector - builds a field of name, tag, of, type onto:
24351 record or varient field, r.
24352 varient, v.
24353 */
24354
24355 extern "C" void decl_buildVarientSelector (decl_node r, decl_node v, nameKey_Name tag, decl_node type)
24356 {
24357 decl_node f;
24358
24359 mcDebug_assert ((decl_isRecord (r)) || (decl_isVarientField (r)));
24360 if ((decl_isRecord (r)) || (decl_isVarientField (r)))
24361 {
24362 /* avoid gcc warning by using compound statement even if not strictly necessary. */
24363 if ((type == NULL) && (tag == nameKey_NulName))
24364 {
24365 mcMetaError_metaError1 ((const char *) "expecting a tag field in the declaration of a varient record {%1Ua}", 67, (const unsigned char *) &r, (sizeof (r)-1));
24366 }
24367 else if (type == NULL)
24368 {
24369 /* avoid dangling else. */
24370 f = decl_lookupSym (tag);
24371 putVarientTag (v, f);
24372 }
24373 else
24374 {
24375 /* avoid dangling else. */
24376 f = putFieldRecord (r, tag, type, v);
24377 mcDebug_assert (decl_isRecordField (f));
24378 f->recordfieldF.tag = true;
24379 putVarientTag (v, f);
24380 }
24381 }
24382 }
24383
24384
24385 /*
24386 buildVarientFieldRecord - builds a varient field into a varient symbol, v.
24387 The varient field is returned.
24388 */
24389
24390 extern "C" decl_node decl_buildVarientFieldRecord (decl_node v, decl_node p)
24391 {
24392 decl_node f;
24393
24394 mcDebug_assert (decl_isVarient (v));
24395 f = makeVarientField (v, p);
24396 mcDebug_assert (decl_isVarientField (f));
24397 putFieldVarient (f, v);
24398 return f;
24399 /* static analysis guarentees a RETURN statement will be used before here. */
24400 __builtin_unreachable ();
24401 }
24402
24403
24404 /*
24405 getSymName - returns the name of symbol, n.
24406 */
24407
24408 extern "C" nameKey_Name decl_getSymName (decl_node n)
24409 {
24410 switch (n->kind)
24411 {
24412 case decl_new:
24413 return nameKey_makeKey ((const char *) "NEW", 3);
24414 break;
24415
24416 case decl_dispose:
24417 return nameKey_makeKey ((const char *) "DISPOSE", 7);
24418 break;
24419
24420 case decl_length:
24421 return nameKey_makeKey ((const char *) "LENGTH", 6);
24422 break;
24423
24424 case decl_inc:
24425 return nameKey_makeKey ((const char *) "INC", 3);
24426 break;
24427
24428 case decl_dec:
24429 return nameKey_makeKey ((const char *) "DEC", 3);
24430 break;
24431
24432 case decl_incl:
24433 return nameKey_makeKey ((const char *) "INCL", 4);
24434 break;
24435
24436 case decl_excl:
24437 return nameKey_makeKey ((const char *) "EXCL", 4);
24438 break;
24439
24440 case decl_nil:
24441 return nameKey_makeKey ((const char *) "NIL", 3);
24442 break;
24443
24444 case decl_true:
24445 return nameKey_makeKey ((const char *) "TRUE", 4);
24446 break;
24447
24448 case decl_false:
24449 return nameKey_makeKey ((const char *) "FALSE", 5);
24450 break;
24451
24452 case decl_address:
24453 return nameKey_makeKey ((const char *) "ADDRESS", 7);
24454 break;
24455
24456 case decl_loc:
24457 return nameKey_makeKey ((const char *) "LOC", 3);
24458 break;
24459
24460 case decl_byte:
24461 return nameKey_makeKey ((const char *) "BYTE", 4);
24462 break;
24463
24464 case decl_word:
24465 return nameKey_makeKey ((const char *) "WORD", 4);
24466 break;
24467
24468 case decl_csizet:
24469 return nameKey_makeKey ((const char *) "CSIZE_T", 7);
24470 break;
24471
24472 case decl_cssizet:
24473 return nameKey_makeKey ((const char *) "CSSIZE_T", 8);
24474 break;
24475
24476 case decl_boolean:
24477 /* base types. */
24478 return nameKey_makeKey ((const char *) "BOOLEAN", 7);
24479 break;
24480
24481 case decl_proc:
24482 return nameKey_makeKey ((const char *) "PROC", 4);
24483 break;
24484
24485 case decl_char:
24486 return nameKey_makeKey ((const char *) "CHAR", 4);
24487 break;
24488
24489 case decl_cardinal:
24490 return nameKey_makeKey ((const char *) "CARDINAL", 8);
24491 break;
24492
24493 case decl_longcard:
24494 return nameKey_makeKey ((const char *) "LONGCARD", 8);
24495 break;
24496
24497 case decl_shortcard:
24498 return nameKey_makeKey ((const char *) "SHORTCARD", 9);
24499 break;
24500
24501 case decl_integer:
24502 return nameKey_makeKey ((const char *) "INTEGER", 7);
24503 break;
24504
24505 case decl_longint:
24506 return nameKey_makeKey ((const char *) "LONGINT", 7);
24507 break;
24508
24509 case decl_shortint:
24510 return nameKey_makeKey ((const char *) "SHORTINT", 8);
24511 break;
24512
24513 case decl_real:
24514 return nameKey_makeKey ((const char *) "REAL", 4);
24515 break;
24516
24517 case decl_longreal:
24518 return nameKey_makeKey ((const char *) "LONGREAL", 8);
24519 break;
24520
24521 case decl_shortreal:
24522 return nameKey_makeKey ((const char *) "SHORTREAL", 9);
24523 break;
24524
24525 case decl_bitset:
24526 return nameKey_makeKey ((const char *) "BITSET", 6);
24527 break;
24528
24529 case decl_ztype:
24530 return nameKey_makeKey ((const char *) "_ZTYPE", 6);
24531 break;
24532
24533 case decl_rtype:
24534 return nameKey_makeKey ((const char *) "_RTYPE", 6);
24535 break;
24536
24537 case decl_complex:
24538 return nameKey_makeKey ((const char *) "COMPLEX", 7);
24539 break;
24540
24541 case decl_longcomplex:
24542 return nameKey_makeKey ((const char *) "LONGCOMPLEX", 11);
24543 break;
24544
24545 case decl_shortcomplex:
24546 return nameKey_makeKey ((const char *) "SHORTCOMPLEX", 12);
24547 break;
24548
24549 case decl_type:
24550 /* language features and compound type attributes. */
24551 return n->typeF.name;
24552 break;
24553
24554 case decl_record:
24555 return nameKey_NulName;
24556 break;
24557
24558 case decl_varient:
24559 return nameKey_NulName;
24560 break;
24561
24562 case decl_var:
24563 return n->varF.name;
24564 break;
24565
24566 case decl_enumeration:
24567 return nameKey_NulName;
24568 break;
24569
24570 case decl_subrange:
24571 return nameKey_NulName;
24572 break;
24573
24574 case decl_pointer:
24575 return nameKey_NulName;
24576 break;
24577
24578 case decl_array:
24579 return nameKey_NulName;
24580 break;
24581
24582 case decl_string:
24583 return n->stringF.name;
24584 break;
24585
24586 case decl_const:
24587 return n->constF.name;
24588 break;
24589
24590 case decl_literal:
24591 return n->literalF.name;
24592 break;
24593
24594 case decl_varparam:
24595 return nameKey_NulName;
24596 break;
24597
24598 case decl_param:
24599 return nameKey_NulName;
24600 break;
24601
24602 case decl_optarg:
24603 return nameKey_NulName;
24604 break;
24605
24606 case decl_recordfield:
24607 return n->recordfieldF.name;
24608 break;
24609
24610 case decl_varientfield:
24611 return n->varientfieldF.name;
24612 break;
24613
24614 case decl_enumerationfield:
24615 return n->enumerationfieldF.name;
24616 break;
24617
24618 case decl_set:
24619 return nameKey_NulName;
24620 break;
24621
24622 case decl_proctype:
24623 return nameKey_NulName;
24624 break;
24625
24626 case decl_subscript:
24627 return nameKey_NulName;
24628 break;
24629
24630 case decl_procedure:
24631 /* blocks. */
24632 return n->procedureF.name;
24633 break;
24634
24635 case decl_def:
24636 return n->defF.name;
24637 break;
24638
24639 case decl_imp:
24640 return n->impF.name;
24641 break;
24642
24643 case decl_module:
24644 return n->moduleF.name;
24645 break;
24646
24647 case decl_loop:
24648 case decl_while:
24649 case decl_for:
24650 case decl_repeat:
24651 case decl_if:
24652 case decl_elsif:
24653 case decl_assignment:
24654 /* statements. */
24655 return nameKey_NulName;
24656 break;
24657
24658 case decl_constexp:
24659 case decl_deref:
24660 case decl_arrayref:
24661 case decl_componentref:
24662 case decl_cast:
24663 case decl_val:
24664 case decl_plus:
24665 case decl_sub:
24666 case decl_div:
24667 case decl_mod:
24668 case decl_mult:
24669 case decl_divide:
24670 case decl_in:
24671 case decl_neg:
24672 case decl_equal:
24673 case decl_notequal:
24674 case decl_less:
24675 case decl_greater:
24676 case decl_greequal:
24677 case decl_lessequal:
24678 /* expressions. */
24679 return nameKey_NulName;
24680 break;
24681
24682 case decl_adr:
24683 return nameKey_makeKey ((const char *) "ADR", 3);
24684 break;
24685
24686 case decl_size:
24687 return nameKey_makeKey ((const char *) "SIZE", 4);
24688 break;
24689
24690 case decl_tsize:
24691 return nameKey_makeKey ((const char *) "TSIZE", 5);
24692 break;
24693
24694 case decl_chr:
24695 return nameKey_makeKey ((const char *) "CHR", 3);
24696 break;
24697
24698 case decl_abs:
24699 return nameKey_makeKey ((const char *) "ABS", 3);
24700 break;
24701
24702 case decl_ord:
24703 return nameKey_makeKey ((const char *) "ORD", 3);
24704 break;
24705
24706 case decl_float:
24707 return nameKey_makeKey ((const char *) "FLOAT", 5);
24708 break;
24709
24710 case decl_trunc:
24711 return nameKey_makeKey ((const char *) "TRUNC", 5);
24712 break;
24713
24714 case decl_high:
24715 return nameKey_makeKey ((const char *) "HIGH", 4);
24716 break;
24717
24718 case decl_throw:
24719 return nameKey_makeKey ((const char *) "THROW", 5);
24720 break;
24721
24722 case decl_unreachable:
24723 return nameKey_makeKey ((const char *) "builtin_unreachable", 19);
24724 break;
24725
24726 case decl_cmplx:
24727 return nameKey_makeKey ((const char *) "CMPLX", 5);
24728 break;
24729
24730 case decl_re:
24731 return nameKey_makeKey ((const char *) "RE", 2);
24732 break;
24733
24734 case decl_im:
24735 return nameKey_makeKey ((const char *) "IM", 2);
24736 break;
24737
24738 case decl_max:
24739 return nameKey_makeKey ((const char *) "MAX", 3);
24740 break;
24741
24742 case decl_min:
24743 return nameKey_makeKey ((const char *) "MIN", 3);
24744 break;
24745
24746 case decl_funccall:
24747 return nameKey_NulName;
24748 break;
24749
24750 case decl_identlist:
24751 return nameKey_NulName;
24752 break;
24753
24754
24755 default:
24756 M2RTS_HALT (-1);
24757 __builtin_unreachable ();
24758 break;
24759 }
24760 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
24761 __builtin_unreachable ();
24762 }
24763
24764
24765 /*
24766 import - attempts to add node, n, into the scope of module, m.
24767 It might fail due to a name clash in which case the
24768 previous named symbol is returned. On success, n,
24769 is returned.
24770 */
24771
24772 extern "C" decl_node decl_import (decl_node m, decl_node n)
24773 {
24774 nameKey_Name name;
24775 decl_node r;
24776
24777 mcDebug_assert (((decl_isDef (m)) || (decl_isModule (m))) || (decl_isImp (m)));
24778 name = decl_getSymName (n);
24779 r = decl_lookupInScope (m, name);
24780 if (r == NULL)
24781 {
24782 switch (m->kind)
24783 {
24784 case decl_def:
24785 symbolKey_putSymKey (m->defF.decls.symbols, name, reinterpret_cast<void *> (n));
24786 break;
24787
24788 case decl_imp:
24789 symbolKey_putSymKey (m->impF.decls.symbols, name, reinterpret_cast<void *> (n));
24790 break;
24791
24792 case decl_module:
24793 symbolKey_putSymKey (m->moduleF.decls.symbols, name, reinterpret_cast<void *> (n));
24794 break;
24795
24796
24797 default:
24798 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
24799 __builtin_unreachable ();
24800 }
24801 importEnumFields (m, n);
24802 return n;
24803 }
24804 return r;
24805 /* static analysis guarentees a RETURN statement will be used before here. */
24806 __builtin_unreachable ();
24807 }
24808
24809
24810 /*
24811 lookupExported - attempts to lookup a node named, i, from definition
24812 module, n. The node is returned if found.
24813 NIL is returned if not found.
24814 */
24815
24816 extern "C" decl_node decl_lookupExported (decl_node n, nameKey_Name i)
24817 {
24818 decl_node r;
24819
24820 mcDebug_assert (decl_isDef (n));
24821 r = static_cast<decl_node> (symbolKey_getSymKey (n->defF.decls.symbols, i));
24822 if ((r != NULL) && (decl_isExported (r)))
24823 {
24824 return r;
24825 }
24826 return NULL;
24827 /* static analysis guarentees a RETURN statement will be used before here. */
24828 __builtin_unreachable ();
24829 }
24830
24831
24832 /*
24833 lookupSym - returns the symbol named, n, from the scope stack.
24834 */
24835
24836 extern "C" decl_node decl_lookupSym (nameKey_Name n)
24837 {
24838 decl_node s;
24839 decl_node m;
24840 unsigned int l;
24841 unsigned int h;
24842
24843 l = Indexing_LowIndice (scopeStack);
24844 h = Indexing_HighIndice (scopeStack);
24845 while (h >= l)
24846 {
24847 s = static_cast<decl_node> (Indexing_GetIndice (scopeStack, h));
24848 m = decl_lookupInScope (s, n);
24849 if (debugScopes && (m == NULL))
24850 {
24851 out3 ((const char *) " [%d] search for symbol name %s in scope %s\\n", 45, h, n, s);
24852 }
24853 if (m != NULL)
24854 {
24855 if (debugScopes)
24856 {
24857 out3 ((const char *) " [%d] search for symbol name %s in scope %s (found)\\n", 53, h, n, s);
24858 }
24859 return m;
24860 }
24861 h -= 1;
24862 }
24863 return lookupBase (n);
24864 /* static analysis guarentees a RETURN statement will be used before here. */
24865 __builtin_unreachable ();
24866 }
24867
24868
24869 /*
24870 addImportedModule - add module, i, to be imported by, m.
24871 If scoped then module, i, is added to the
24872 module, m, scope.
24873 */
24874
24875 extern "C" void decl_addImportedModule (decl_node m, decl_node i, bool scoped)
24876 {
24877 mcDebug_assert ((decl_isDef (i)) || (decl_isModule (i)));
24878 if (decl_isDef (m))
24879 {
24880 Indexing_IncludeIndiceIntoIndex (m->defF.importedModules, reinterpret_cast<void *> (i));
24881 }
24882 else if (decl_isImp (m))
24883 {
24884 /* avoid dangling else. */
24885 Indexing_IncludeIndiceIntoIndex (m->impF.importedModules, reinterpret_cast<void *> (i));
24886 }
24887 else if (decl_isModule (m))
24888 {
24889 /* avoid dangling else. */
24890 Indexing_IncludeIndiceIntoIndex (m->moduleF.importedModules, reinterpret_cast<void *> (i));
24891 }
24892 else
24893 {
24894 /* avoid dangling else. */
24895 M2RTS_HALT (-1);
24896 __builtin_unreachable ();
24897 }
24898 if (scoped)
24899 {
24900 addModuleToScope (m, i);
24901 }
24902 }
24903
24904
24905 /*
24906 setSource - sets the source filename for module, n, to s.
24907 */
24908
24909 extern "C" void decl_setSource (decl_node n, nameKey_Name s)
24910 {
24911 switch (n->kind)
24912 {
24913 case decl_def:
24914 n->defF.source = s;
24915 break;
24916
24917 case decl_module:
24918 n->moduleF.source = s;
24919 break;
24920
24921 case decl_imp:
24922 n->impF.source = s;
24923 break;
24924
24925
24926 default:
24927 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
24928 __builtin_unreachable ();
24929 }
24930 }
24931
24932
24933 /*
24934 getSource - returns the source filename for module, n.
24935 */
24936
24937 extern "C" nameKey_Name decl_getSource (decl_node n)
24938 {
24939 switch (n->kind)
24940 {
24941 case decl_def:
24942 return n->defF.source;
24943 break;
24944
24945 case decl_module:
24946 return n->moduleF.source;
24947 break;
24948
24949 case decl_imp:
24950 return n->impF.source;
24951 break;
24952
24953
24954 default:
24955 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
24956 __builtin_unreachable ();
24957 }
24958 /* static analysis guarentees a RETURN statement will be used before here. */
24959 __builtin_unreachable ();
24960 }
24961
24962
24963 /*
24964 getMainModule - returns the main module node.
24965 */
24966
24967 extern "C" decl_node decl_getMainModule (void)
24968 {
24969 return mainModule;
24970 /* static analysis guarentees a RETURN statement will be used before here. */
24971 __builtin_unreachable ();
24972 }
24973
24974
24975 /*
24976 getCurrentModule - returns the current module being compiled.
24977 */
24978
24979 extern "C" decl_node decl_getCurrentModule (void)
24980 {
24981 return currentModule;
24982 /* static analysis guarentees a RETURN statement will be used before here. */
24983 __builtin_unreachable ();
24984 }
24985
24986
24987 /*
24988 foreachDefModuleDo - foreach definition node, n, in the module universe,
24989 call p (n).
24990 */
24991
24992 extern "C" void decl_foreachDefModuleDo (symbolKey_performOperation p)
24993 {
24994 Indexing_ForeachIndiceInIndexDo (defUniverseI, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) p.proc});
24995 }
24996
24997
24998 /*
24999 foreachModModuleDo - foreach implementation or module node, n, in the module universe,
25000 call p (n).
25001 */
25002
25003 extern "C" void decl_foreachModModuleDo (symbolKey_performOperation p)
25004 {
25005 Indexing_ForeachIndiceInIndexDo (modUniverseI, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) p.proc});
25006 }
25007
25008
25009 /*
25010 enterScope - pushes symbol, n, to the scope stack.
25011 */
25012
25013 extern "C" void decl_enterScope (decl_node n)
25014 {
25015 if (Indexing_IsIndiceInIndex (scopeStack, reinterpret_cast<void *> (n)))
25016 {
25017 M2RTS_HALT (-1);
25018 __builtin_unreachable ();
25019 }
25020 else
25021 {
25022 Indexing_IncludeIndiceIntoIndex (scopeStack, reinterpret_cast<void *> (n));
25023 }
25024 if (debugScopes)
25025 {
25026 libc_printf ((const char *) "enter scope\\n", 13);
25027 dumpScopes ();
25028 }
25029 }
25030
25031
25032 /*
25033 leaveScope - removes the top level scope.
25034 */
25035
25036 extern "C" void decl_leaveScope (void)
25037 {
25038 unsigned int i;
25039 decl_node n;
25040
25041 i = Indexing_HighIndice (scopeStack);
25042 n = static_cast<decl_node> (Indexing_GetIndice (scopeStack, i));
25043 Indexing_RemoveIndiceFromIndex (scopeStack, reinterpret_cast<void *> (n));
25044 if (debugScopes)
25045 {
25046 libc_printf ((const char *) "leave scope\\n", 13);
25047 dumpScopes ();
25048 }
25049 }
25050
25051
25052 /*
25053 makeProcedure - create, initialise and return a procedure node.
25054 */
25055
25056 extern "C" decl_node decl_makeProcedure (nameKey_Name n)
25057 {
25058 decl_node d;
25059
25060 d = decl_lookupSym (n);
25061 if (d == NULL)
25062 {
25063 d = newNode (decl_procedure);
25064 d->procedureF.name = n;
25065 initDecls (&d->procedureF.decls);
25066 d->procedureF.scope = decl_getDeclScope ();
25067 d->procedureF.parameters = Indexing_InitIndex (1);
25068 d->procedureF.isForC = isDefForCNode (decl_getDeclScope ());
25069 d->procedureF.built = false;
25070 d->procedureF.returnopt = false;
25071 d->procedureF.optarg_ = NULL;
25072 d->procedureF.noreturnused = false;
25073 d->procedureF.noreturn = false;
25074 d->procedureF.vararg = false;
25075 d->procedureF.checking = false;
25076 d->procedureF.paramcount = 0;
25077 d->procedureF.returnType = NULL;
25078 d->procedureF.beginStatements = NULL;
25079 initCname (&d->procedureF.cname);
25080 d->procedureF.defComment = NULL;
25081 d->procedureF.modComment = NULL;
25082 }
25083 return addProcedureToScope (d, n);
25084 /* static analysis guarentees a RETURN statement will be used before here. */
25085 __builtin_unreachable ();
25086 }
25087
25088
25089 /*
25090 putCommentDefProcedure - remembers the procedure comment (if it exists) as a
25091 definition module procedure heading. NIL is placed
25092 if there is no procedure comment available.
25093 */
25094
25095 extern "C" void decl_putCommentDefProcedure (decl_node n)
25096 {
25097 mcDebug_assert (decl_isProcedure (n));
25098 if (mcComment_isProcedureComment (mcLexBuf_lastcomment))
25099 {
25100 n->procedureF.defComment = mcLexBuf_lastcomment;
25101 }
25102 }
25103
25104
25105 /*
25106 putCommentModProcedure - remembers the procedure comment (if it exists) as an
25107 implementation/program module procedure heading. NIL is placed
25108 if there is no procedure comment available.
25109 */
25110
25111 extern "C" void decl_putCommentModProcedure (decl_node n)
25112 {
25113 mcDebug_assert (decl_isProcedure (n));
25114 if (mcComment_isProcedureComment (mcLexBuf_lastcomment))
25115 {
25116 n->procedureF.modComment = mcLexBuf_lastcomment;
25117 }
25118 }
25119
25120
25121 /*
25122 makeProcType - returns a proctype node.
25123 */
25124
25125 extern "C" decl_node decl_makeProcType (void)
25126 {
25127 decl_node d;
25128
25129 d = newNode (decl_proctype);
25130 d->proctypeF.scope = decl_getDeclScope ();
25131 d->proctypeF.parameters = Indexing_InitIndex (1);
25132 d->proctypeF.returnopt = false;
25133 d->proctypeF.optarg_ = NULL;
25134 d->proctypeF.vararg = false;
25135 d->proctypeF.returnType = NULL;
25136 return d;
25137 /* static analysis guarentees a RETURN statement will be used before here. */
25138 __builtin_unreachable ();
25139 }
25140
25141
25142 /*
25143 putReturnType - sets the return type of procedure or proctype, proc, to, type.
25144 */
25145
25146 extern "C" void decl_putReturnType (decl_node proc, decl_node type)
25147 {
25148 mcDebug_assert ((decl_isProcedure (proc)) || (decl_isProcType (proc)));
25149 if (decl_isProcedure (proc))
25150 {
25151 proc->procedureF.returnType = type;
25152 }
25153 else
25154 {
25155 proc->proctypeF.returnType = type;
25156 }
25157 }
25158
25159
25160 /*
25161 putOptReturn - sets, proctype or procedure, proc, to have an optional return type.
25162 */
25163
25164 extern "C" void decl_putOptReturn (decl_node proc)
25165 {
25166 mcDebug_assert ((decl_isProcedure (proc)) || (decl_isProcType (proc)));
25167 if (decl_isProcedure (proc))
25168 {
25169 proc->procedureF.returnopt = true;
25170 }
25171 else
25172 {
25173 proc->proctypeF.returnopt = true;
25174 }
25175 }
25176
25177
25178 /*
25179 makeVarParameter - returns a var parameter node with, name: type.
25180 */
25181
25182 extern "C" decl_node decl_makeVarParameter (decl_node l, decl_node type, decl_node proc, bool isused)
25183 {
25184 decl_node d;
25185
25186 mcDebug_assert ((l == NULL) || (isIdentList (l)));
25187 d = newNode (decl_varparam);
25188 d->varparamF.namelist = l;
25189 d->varparamF.type = type;
25190 d->varparamF.scope = proc;
25191 d->varparamF.isUnbounded = false;
25192 d->varparamF.isForC = isDefForCNode (proc);
25193 d->varparamF.isUsed = isused;
25194 return d;
25195 /* static analysis guarentees a RETURN statement will be used before here. */
25196 __builtin_unreachable ();
25197 }
25198
25199
25200 /*
25201 makeNonVarParameter - returns a non var parameter node with, name: type.
25202 */
25203
25204 extern "C" decl_node decl_makeNonVarParameter (decl_node l, decl_node type, decl_node proc, bool isused)
25205 {
25206 decl_node d;
25207
25208 mcDebug_assert ((l == NULL) || (isIdentList (l)));
25209 d = newNode (decl_param);
25210 d->paramF.namelist = l;
25211 d->paramF.type = type;
25212 d->paramF.scope = proc;
25213 d->paramF.isUnbounded = false;
25214 d->paramF.isForC = isDefForCNode (proc);
25215 d->paramF.isUsed = isused;
25216 return d;
25217 /* static analysis guarentees a RETURN statement will be used before here. */
25218 __builtin_unreachable ();
25219 }
25220
25221
25222 /*
25223 paramEnter - reset the parameter count.
25224 */
25225
25226 extern "C" void decl_paramEnter (decl_node n)
25227 {
25228 mcDebug_assert (decl_isProcedure (n));
25229 n->procedureF.paramcount = 0;
25230 }
25231
25232
25233 /*
25234 paramLeave - set paramater checking to TRUE from now onwards.
25235 */
25236
25237 extern "C" void decl_paramLeave (decl_node n)
25238 {
25239 mcDebug_assert (decl_isProcedure (n));
25240 n->procedureF.checking = true;
25241 if ((decl_isImp (currentModule)) || (decl_isModule (currentModule)))
25242 {
25243 n->procedureF.built = true;
25244 }
25245 }
25246
25247
25248 /*
25249 makeIdentList - returns a node which will be used to maintain an ident list.
25250 */
25251
25252 extern "C" decl_node decl_makeIdentList (void)
25253 {
25254 decl_node n;
25255
25256 n = newNode (decl_identlist);
25257 n->identlistF.names = wlists_initList ();
25258 n->identlistF.cnamed = false;
25259 return n;
25260 /* static analysis guarentees a RETURN statement will be used before here. */
25261 __builtin_unreachable ();
25262 }
25263
25264
25265 /*
25266 putIdent - places ident, i, into identlist, n. It returns TRUE if
25267 ident, i, is unique.
25268 */
25269
25270 extern "C" bool decl_putIdent (decl_node n, nameKey_Name i)
25271 {
25272 mcDebug_assert (isIdentList (n));
25273 if (wlists_isItemInList (n->identlistF.names, i))
25274 {
25275 return false;
25276 }
25277 else
25278 {
25279 wlists_putItemIntoList (n->identlistF.names, i);
25280 return true;
25281 }
25282 /* static analysis guarentees a RETURN statement will be used before here. */
25283 __builtin_unreachable ();
25284 }
25285
25286
25287 /*
25288 addVarParameters - adds the identlist, i, of, type, to be VAR parameters
25289 in procedure, n.
25290 */
25291
25292 extern "C" void decl_addVarParameters (decl_node n, decl_node i, decl_node type, bool isused)
25293 {
25294 decl_node p;
25295
25296 mcDebug_assert (isIdentList (i));
25297 mcDebug_assert (decl_isProcedure (n));
25298 checkMakeVariables (n, i, type, true, isused);
25299 if (n->procedureF.checking)
25300 {
25301 checkParameters (n, i, type, true, isused); /* will destroy, i. */
25302 }
25303 else
25304 {
25305 p = decl_makeVarParameter (i, type, n, isused);
25306 Indexing_IncludeIndiceIntoIndex (n->procedureF.parameters, reinterpret_cast<void *> (p));
25307 }
25308 }
25309
25310
25311 /*
25312 addNonVarParameters - adds the identlist, i, of, type, to be parameters
25313 in procedure, n.
25314 */
25315
25316 extern "C" void decl_addNonVarParameters (decl_node n, decl_node i, decl_node type, bool isused)
25317 {
25318 decl_node p;
25319
25320 mcDebug_assert (isIdentList (i));
25321 mcDebug_assert (decl_isProcedure (n));
25322 checkMakeVariables (n, i, type, false, isused);
25323 if (n->procedureF.checking)
25324 {
25325 checkParameters (n, i, type, false, isused); /* will destroy, i. */
25326 }
25327 else
25328 {
25329 p = decl_makeNonVarParameter (i, type, n, isused);
25330 Indexing_IncludeIndiceIntoIndex (n->procedureF.parameters, reinterpret_cast<void *> (p));
25331 }
25332 }
25333
25334
25335 /*
25336 makeVarargs - returns a varargs node.
25337 */
25338
25339 extern "C" decl_node decl_makeVarargs (void)
25340 {
25341 decl_node d;
25342
25343 d = newNode (decl_varargs);
25344 d->varargsF.scope = NULL;
25345 return d;
25346 /* static analysis guarentees a RETURN statement will be used before here. */
25347 __builtin_unreachable ();
25348 }
25349
25350
25351 /*
25352 isVarargs - returns TRUE if, n, is a varargs node.
25353 */
25354
25355 extern "C" bool decl_isVarargs (decl_node n)
25356 {
25357 return n->kind == decl_varargs;
25358 /* static analysis guarentees a RETURN statement will be used before here. */
25359 __builtin_unreachable ();
25360 }
25361
25362
25363 /*
25364 addParameter - adds a parameter, param, to procedure or proctype, proc.
25365 */
25366
25367 extern "C" void decl_addParameter (decl_node proc, decl_node param)
25368 {
25369 mcDebug_assert ((((decl_isVarargs (param)) || (decl_isParam (param))) || (decl_isVarParam (param))) || (decl_isOptarg (param)));
25370 switch (proc->kind)
25371 {
25372 case decl_procedure:
25373 Indexing_IncludeIndiceIntoIndex (proc->procedureF.parameters, reinterpret_cast<void *> (param));
25374 if (decl_isVarargs (param))
25375 {
25376 proc->procedureF.vararg = true;
25377 }
25378 if (decl_isOptarg (param))
25379 {
25380 proc->procedureF.optarg_ = param;
25381 }
25382 break;
25383
25384 case decl_proctype:
25385 Indexing_IncludeIndiceIntoIndex (proc->proctypeF.parameters, reinterpret_cast<void *> (param));
25386 if (decl_isVarargs (param))
25387 {
25388 proc->proctypeF.vararg = true;
25389 }
25390 if (decl_isOptarg (param))
25391 {
25392 proc->proctypeF.optarg_ = param;
25393 }
25394 break;
25395
25396
25397 default:
25398 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
25399 __builtin_unreachable ();
25400 }
25401 }
25402
25403
25404 /*
25405 makeBinaryTok - creates and returns a boolean type node with,
25406 l, and, r, nodes.
25407 */
25408
25409 extern "C" decl_node decl_makeBinaryTok (mcReserved_toktype op, decl_node l, decl_node r)
25410 {
25411 if (op == mcReserved_equaltok)
25412 {
25413 return makeBinary (decl_equal, l, r, booleanN);
25414 }
25415 else if ((op == mcReserved_hashtok) || (op == mcReserved_lessgreatertok))
25416 {
25417 /* avoid dangling else. */
25418 return makeBinary (decl_notequal, l, r, booleanN);
25419 }
25420 else if (op == mcReserved_lesstok)
25421 {
25422 /* avoid dangling else. */
25423 return makeBinary (decl_less, l, r, booleanN);
25424 }
25425 else if (op == mcReserved_greatertok)
25426 {
25427 /* avoid dangling else. */
25428 return makeBinary (decl_greater, l, r, booleanN);
25429 }
25430 else if (op == mcReserved_greaterequaltok)
25431 {
25432 /* avoid dangling else. */
25433 return makeBinary (decl_greequal, l, r, booleanN);
25434 }
25435 else if (op == mcReserved_lessequaltok)
25436 {
25437 /* avoid dangling else. */
25438 return makeBinary (decl_lessequal, l, r, booleanN);
25439 }
25440 else if (op == mcReserved_andtok)
25441 {
25442 /* avoid dangling else. */
25443 return makeBinary (decl_and, l, r, booleanN);
25444 }
25445 else if (op == mcReserved_ortok)
25446 {
25447 /* avoid dangling else. */
25448 return makeBinary (decl_or, l, r, booleanN);
25449 }
25450 else if (op == mcReserved_plustok)
25451 {
25452 /* avoid dangling else. */
25453 return makeBinary (decl_plus, l, r, NULL);
25454 }
25455 else if (op == mcReserved_minustok)
25456 {
25457 /* avoid dangling else. */
25458 return makeBinary (decl_sub, l, r, NULL);
25459 }
25460 else if (op == mcReserved_divtok)
25461 {
25462 /* avoid dangling else. */
25463 return makeBinary (decl_div, l, r, NULL);
25464 }
25465 else if (op == mcReserved_timestok)
25466 {
25467 /* avoid dangling else. */
25468 return makeBinary (decl_mult, l, r, NULL);
25469 }
25470 else if (op == mcReserved_modtok)
25471 {
25472 /* avoid dangling else. */
25473 return makeBinary (decl_mod, l, r, NULL);
25474 }
25475 else if (op == mcReserved_intok)
25476 {
25477 /* avoid dangling else. */
25478 return makeBinary (decl_in, l, r, NULL);
25479 }
25480 else if (op == mcReserved_dividetok)
25481 {
25482 /* avoid dangling else. */
25483 return makeBinary (decl_divide, l, r, NULL);
25484 }
25485 else
25486 {
25487 /* avoid dangling else. */
25488 M2RTS_HALT (-1); /* most likely op needs a clause as above. */
25489 __builtin_unreachable ();
25490 }
25491 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
25492 __builtin_unreachable ();
25493 }
25494
25495
25496 /*
25497 makeUnaryTok - creates and returns a boolean type node with,
25498 e, node.
25499 */
25500
25501 extern "C" decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e)
25502 {
25503 if (op == mcReserved_nottok)
25504 {
25505 return makeUnary (decl_not, e, booleanN);
25506 }
25507 else if (op == mcReserved_plustok)
25508 {
25509 /* avoid dangling else. */
25510 return makeUnary (decl_plus, e, NULL);
25511 }
25512 else if (op == mcReserved_minustok)
25513 {
25514 /* avoid dangling else. */
25515 return makeUnary (decl_neg, e, NULL);
25516 }
25517 else
25518 {
25519 /* avoid dangling else. */
25520 M2RTS_HALT (-1); /* most likely op needs a clause as above. */
25521 __builtin_unreachable ();
25522 }
25523 ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
25524 __builtin_unreachable ();
25525 }
25526
25527
25528 /*
25529 makeComponentRef - build a componentref node which accesses, field,
25530 within, record, rec.
25531 */
25532
25533 extern "C" decl_node decl_makeComponentRef (decl_node rec, decl_node field)
25534 {
25535 decl_node n;
25536 decl_node a;
25537
25538 /*
25539 n := getLastOp (rec) ;
25540 IF (n#NIL) AND (isDeref (n) OR isPointerRef (n)) AND
25541 (skipType (getType (rec)) = skipType (getType (n)))
25542 THEN
25543 a := n^.unaryF.arg ;
25544 n^.kind := pointerref ;
25545 n^.pointerrefF.ptr := a ;
25546 n^.pointerrefF.field := field ;
25547 n^.pointerrefF.resultType := getType (field) ;
25548 RETURN n
25549 ELSE
25550 RETURN doMakeComponentRef (rec, field)
25551 END
25552 */
25553 if (isDeref (rec))
25554 {
25555 a = rec->unaryF.arg;
25556 rec->kind = decl_pointerref;
25557 rec->pointerrefF.ptr = a;
25558 rec->pointerrefF.field = field;
25559 rec->pointerrefF.resultType = decl_getType (field);
25560 return rec;
25561 }
25562 else
25563 {
25564 return doMakeComponentRef (rec, field);
25565 }
25566 /* static analysis guarentees a RETURN statement will be used before here. */
25567 __builtin_unreachable ();
25568 }
25569
25570
25571 /*
25572 makePointerRef - build a pointerref node which accesses, field,
25573 within, pointer to record, ptr.
25574 */
25575
25576 extern "C" decl_node decl_makePointerRef (decl_node ptr, decl_node field)
25577 {
25578 decl_node n;
25579
25580 n = newNode (decl_pointerref);
25581 n->pointerrefF.ptr = ptr;
25582 n->pointerrefF.field = field;
25583 n->pointerrefF.resultType = decl_getType (field);
25584 return n;
25585 /* static analysis guarentees a RETURN statement will be used before here. */
25586 __builtin_unreachable ();
25587 }
25588
25589
25590 /*
25591 isPointerRef - returns TRUE if, n, is a pointerref node.
25592 */
25593
25594 extern "C" bool decl_isPointerRef (decl_node n)
25595 {
25596 mcDebug_assert (n != NULL);
25597 return n->kind == decl_pointerref;
25598 /* static analysis guarentees a RETURN statement will be used before here. */
25599 __builtin_unreachable ();
25600 }
25601
25602
25603 /*
25604 makeDeRef - dereferences the pointer defined by, n.
25605 */
25606
25607 extern "C" decl_node decl_makeDeRef (decl_node n)
25608 {
25609 decl_node t;
25610
25611 t = decl_skipType (decl_getType (n));
25612 mcDebug_assert (decl_isPointer (t));
25613 return makeUnary (decl_deref, n, decl_getType (t));
25614 /* static analysis guarentees a RETURN statement will be used before here. */
25615 __builtin_unreachable ();
25616 }
25617
25618
25619 /*
25620 makeArrayRef - build an arrayref node which access element,
25621 index, in, array. array is a variable/expression/constant
25622 which has a type array.
25623 */
25624
25625 extern "C" decl_node decl_makeArrayRef (decl_node array, decl_node index)
25626 {
25627 decl_node n;
25628 decl_node t;
25629 unsigned int i;
25630 unsigned int j;
25631
25632 n = newNode (decl_arrayref);
25633 n->arrayrefF.array = array;
25634 n->arrayrefF.index = index;
25635 t = array;
25636 j = expListLen (index);
25637 i = 1;
25638 t = decl_skipType (decl_getType (t));
25639 do {
25640 if (decl_isArray (t))
25641 {
25642 t = decl_skipType (decl_getType (t));
25643 }
25644 else
25645 {
25646 mcMetaError_metaError2 ((const char *) "cannot access {%1N} dimension of array {%2a}", 44, (const unsigned char *) &i, (sizeof (i)-1), (const unsigned char *) &t, (sizeof (t)-1));
25647 }
25648 i += 1;
25649 } while (! (i > j));
25650 n->arrayrefF.resultType = t;
25651 return n;
25652 /* static analysis guarentees a RETURN statement will be used before here. */
25653 __builtin_unreachable ();
25654 }
25655
25656
25657 /*
25658 getLastOp - return the right most non leaf node.
25659 */
25660
25661 extern "C" decl_node decl_getLastOp (decl_node n)
25662 {
25663 return doGetLastOp (n, n);
25664 /* static analysis guarentees a RETURN statement will be used before here. */
25665 __builtin_unreachable ();
25666 }
25667
25668
25669 /*
25670 getCardinal - returns the cardinal type node.
25671 */
25672
25673 extern "C" decl_node decl_getCardinal (void)
25674 {
25675 return cardinalN;
25676 /* static analysis guarentees a RETURN statement will be used before here. */
25677 __builtin_unreachable ();
25678 }
25679
25680
25681 /*
25682 makeLiteralInt - creates and returns a literal node based on an integer type.
25683 */
25684
25685 extern "C" decl_node decl_makeLiteralInt (nameKey_Name n)
25686 {
25687 decl_node m;
25688 DynamicStrings_String s;
25689
25690 m = newNode (decl_literal);
25691 s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
25692 m->literalF.name = n;
25693 if ((DynamicStrings_char (s, -1)) == 'C')
25694 {
25695 m->literalF.type = charN;
25696 }
25697 else
25698 {
25699 m->literalF.type = ztypeN;
25700 }
25701 s = DynamicStrings_KillString (s);
25702 return m;
25703 /* static analysis guarentees a RETURN statement will be used before here. */
25704 __builtin_unreachable ();
25705 }
25706
25707
25708 /*
25709 makeLiteralReal - creates and returns a literal node based on a real type.
25710 */
25711
25712 extern "C" decl_node decl_makeLiteralReal (nameKey_Name n)
25713 {
25714 decl_node m;
25715
25716 m = newNode (decl_literal);
25717 m->literalF.name = n;
25718 m->literalF.type = rtypeN;
25719 return m;
25720 /* static analysis guarentees a RETURN statement will be used before here. */
25721 __builtin_unreachable ();
25722 }
25723
25724
25725 /*
25726 makeString - creates and returns a node containing string, n.
25727 */
25728
25729 extern "C" decl_node decl_makeString (nameKey_Name n)
25730 {
25731 decl_node m;
25732
25733 m = newNode (decl_string);
25734 m->stringF.name = n;
25735 m->stringF.length = nameKey_lengthKey (n);
25736 m->stringF.isCharCompatible = m->stringF.length <= 3;
25737 m->stringF.cstring = toCstring (n);
25738 m->stringF.clength = lenCstring (m->stringF.cstring);
25739 if (m->stringF.isCharCompatible)
25740 {
25741 m->stringF.cchar = toCchar (n);
25742 }
25743 else
25744 {
25745 m->stringF.cchar = NULL;
25746 }
25747 return m;
25748 /* static analysis guarentees a RETURN statement will be used before here. */
25749 __builtin_unreachable ();
25750 }
25751
25752
25753 /*
25754 makeSetValue - creates and returns a setvalue node.
25755 */
25756
25757 extern "C" decl_node decl_makeSetValue (void)
25758 {
25759 decl_node n;
25760
25761 n = newNode (decl_setvalue);
25762 n->setvalueF.type = bitsetN;
25763 n->setvalueF.values = Indexing_InitIndex (1);
25764 return n;
25765 /* static analysis guarentees a RETURN statement will be used before here. */
25766 __builtin_unreachable ();
25767 }
25768
25769
25770 /*
25771 isSetValue - returns TRUE if, n, is a setvalue node.
25772 */
25773
25774 extern "C" bool decl_isSetValue (decl_node n)
25775 {
25776 mcDebug_assert (n != NULL);
25777 return n->kind == decl_setvalue;
25778 /* static analysis guarentees a RETURN statement will be used before here. */
25779 __builtin_unreachable ();
25780 }
25781
25782
25783 /*
25784 putSetValue - assigns the type, t, to the set value, n. The
25785 node, n, is returned.
25786 */
25787
25788 extern "C" decl_node decl_putSetValue (decl_node n, decl_node t)
25789 {
25790 mcDebug_assert (decl_isSetValue (n));
25791 n->setvalueF.type = t;
25792 return n;
25793 /* static analysis guarentees a RETURN statement will be used before here. */
25794 __builtin_unreachable ();
25795 }
25796
25797
25798 /*
25799 includeSetValue - includes the range l..h into the setvalue.
25800 h might be NIL indicating that a single element
25801 is to be included into the set.
25802 n is returned.
25803 */
25804
25805 extern "C" decl_node decl_includeSetValue (decl_node n, decl_node l, decl_node h)
25806 {
25807 mcDebug_assert (decl_isSetValue (n));
25808 Indexing_IncludeIndiceIntoIndex (n->setvalueF.values, reinterpret_cast<void *> (l));
25809 return n;
25810 /* static analysis guarentees a RETURN statement will be used before here. */
25811 __builtin_unreachable ();
25812 }
25813
25814
25815 /*
25816 getBuiltinConst - creates and returns a builtin const if available.
25817 */
25818
25819 extern "C" decl_node decl_getBuiltinConst (nameKey_Name n)
25820 {
25821 if (n == (nameKey_makeKey ((const char *) "BITS_PER_UNIT", 13)))
25822 {
25823 return bitsperunitN;
25824 }
25825 else if (n == (nameKey_makeKey ((const char *) "BITS_PER_WORD", 13)))
25826 {
25827 /* avoid dangling else. */
25828 return bitsperwordN;
25829 }
25830 else if (n == (nameKey_makeKey ((const char *) "BITS_PER_CHAR", 13)))
25831 {
25832 /* avoid dangling else. */
25833 return bitspercharN;
25834 }
25835 else if (n == (nameKey_makeKey ((const char *) "UNITS_PER_WORD", 14)))
25836 {
25837 /* avoid dangling else. */
25838 return unitsperwordN;
25839 }
25840 else
25841 {
25842 /* avoid dangling else. */
25843 return NULL;
25844 }
25845 /* static analysis guarentees a RETURN statement will be used before here. */
25846 __builtin_unreachable ();
25847 }
25848
25849
25850 /*
25851 makeExpList - creates and returns an expList node.
25852 */
25853
25854 extern "C" decl_node decl_makeExpList (void)
25855 {
25856 decl_node n;
25857
25858 n = newNode (decl_explist);
25859 n->explistF.exp = Indexing_InitIndex (1);
25860 return n;
25861 /* static analysis guarentees a RETURN statement will be used before here. */
25862 __builtin_unreachable ();
25863 }
25864
25865
25866 /*
25867 isExpList - returns TRUE if, n, is an explist node.
25868 */
25869
25870 extern "C" bool decl_isExpList (decl_node n)
25871 {
25872 mcDebug_assert (n != NULL);
25873 return n->kind == decl_explist;
25874 /* static analysis guarentees a RETURN statement will be used before here. */
25875 __builtin_unreachable ();
25876 }
25877
25878
25879 /*
25880 putExpList - places, expression, e, within the explist, n.
25881 */
25882
25883 extern "C" void decl_putExpList (decl_node n, decl_node e)
25884 {
25885 mcDebug_assert (n != NULL);
25886 mcDebug_assert (decl_isExpList (n));
25887 Indexing_PutIndice (n->explistF.exp, (Indexing_HighIndice (n->explistF.exp))+1, reinterpret_cast<void *> (e));
25888 }
25889
25890
25891 /*
25892 makeConstExp - returns a constexp node.
25893 */
25894
25895 extern "C" decl_node decl_makeConstExp (void)
25896 {
25897 if ((currentModule != NULL) && (getConstExpComplete (currentModule)))
25898 {
25899 return decl_getNextConstExp ();
25900 }
25901 else
25902 {
25903 return doMakeConstExp ();
25904 }
25905 /* static analysis guarentees a RETURN statement will be used before here. */
25906 __builtin_unreachable ();
25907 }
25908
25909
25910 /*
25911 getNextConstExp - returns the next constexp node.
25912 */
25913
25914 extern "C" decl_node decl_getNextConstExp (void)
25915 {
25916 decl_node n;
25917
25918 mcDebug_assert (((decl_isDef (currentModule)) || (decl_isImp (currentModule))) || (decl_isModule (currentModule)));
25919 if (decl_isDef (currentModule))
25920 {
25921 return getNextFixup (&currentModule->defF.constFixup);
25922 }
25923 else if (decl_isImp (currentModule))
25924 {
25925 /* avoid dangling else. */
25926 return getNextFixup (&currentModule->impF.constFixup);
25927 }
25928 else if (decl_isModule (currentModule))
25929 {
25930 /* avoid dangling else. */
25931 return getNextFixup (&currentModule->moduleF.constFixup);
25932 }
25933 return n;
25934 /* static analysis guarentees a RETURN statement will be used before here. */
25935 __builtin_unreachable ();
25936 }
25937
25938
25939 /*
25940 setConstExpComplete - sets the field inside the def or imp or module, n.
25941 */
25942
25943 extern "C" void decl_setConstExpComplete (decl_node n)
25944 {
25945 switch (n->kind)
25946 {
25947 case decl_def:
25948 n->defF.constsComplete = true;
25949 break;
25950
25951 case decl_imp:
25952 n->impF.constsComplete = true;
25953 break;
25954
25955 case decl_module:
25956 n->moduleF.constsComplete = true;
25957 break;
25958
25959
25960 default:
25961 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
25962 __builtin_unreachable ();
25963 }
25964 }
25965
25966
25967 /*
25968 fixupConstExp - assign fixup expression, e, into the argument of, c.
25969 */
25970
25971 extern "C" decl_node decl_fixupConstExp (decl_node c, decl_node e)
25972 {
25973 mcDebug_assert (isConstExp (c));
25974 c->unaryF.arg = e;
25975 return c;
25976 /* static analysis guarentees a RETURN statement will be used before here. */
25977 __builtin_unreachable ();
25978 }
25979
25980
25981 /*
25982 resetConstExpPos - resets the index into the saved list of constexps inside
25983 module, n.
25984 */
25985
25986 extern "C" void decl_resetConstExpPos (decl_node n)
25987 {
25988 mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n)));
25989 if (decl_isDef (n))
25990 {
25991 n->defF.constFixup.count = 0;
25992 }
25993 else if (decl_isImp (n))
25994 {
25995 /* avoid dangling else. */
25996 n->impF.constFixup.count = 0;
25997 }
25998 else if (decl_isModule (n))
25999 {
26000 /* avoid dangling else. */
26001 n->moduleF.constFixup.count = 0;
26002 }
26003 }
26004
26005
26006 /*
26007 makeFuncCall - builds a function call to c with param list, n.
26008 */
26009
26010 extern "C" decl_node decl_makeFuncCall (decl_node c, decl_node n)
26011 {
26012 decl_node f;
26013
26014 mcDebug_assert ((n == NULL) || (decl_isExpList (n)));
26015 if (((c == haltN) && ((decl_getMainModule ()) != (decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5))))) && ((decl_getMainModule ()) != (decl_lookupImp (nameKey_makeKey ((const char *) "M2RTS", 5)))))
26016 {
26017 decl_addImportedModule (decl_getMainModule (), decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5)), false);
26018 }
26019 f = checkIntrinsic (c, n);
26020 checkCHeaders (c);
26021 if (f == NULL)
26022 {
26023 f = newNode (decl_funccall);
26024 f->funccallF.function = c;
26025 f->funccallF.args = n;
26026 f->funccallF.type = NULL;
26027 initPair (&f->funccallF.funccallComment);
26028 }
26029 return f;
26030 /* static analysis guarentees a RETURN statement will be used before here. */
26031 __builtin_unreachable ();
26032 }
26033
26034
26035 /*
26036 makeStatementSequence - create and return a statement sequence node.
26037 */
26038
26039 extern "C" decl_node decl_makeStatementSequence (void)
26040 {
26041 decl_node n;
26042
26043 n = newNode (decl_stmtseq);
26044 n->stmtF.statements = Indexing_InitIndex (1);
26045 return n;
26046 /* static analysis guarentees a RETURN statement will be used before here. */
26047 __builtin_unreachable ();
26048 }
26049
26050
26051 /*
26052 isStatementSequence - returns TRUE if node, n, is a statement sequence.
26053 */
26054
26055 extern "C" bool decl_isStatementSequence (decl_node n)
26056 {
26057 return n->kind == decl_stmtseq;
26058 /* static analysis guarentees a RETURN statement will be used before here. */
26059 __builtin_unreachable ();
26060 }
26061
26062
26063 /*
26064 addStatement - adds node, n, as a statement to statememt sequence, s.
26065 */
26066
26067 extern "C" void decl_addStatement (decl_node s, decl_node n)
26068 {
26069 if (n != NULL)
26070 {
26071 mcDebug_assert (decl_isStatementSequence (s));
26072 Indexing_PutIndice (s->stmtF.statements, (Indexing_HighIndice (s->stmtF.statements))+1, reinterpret_cast<void *> (n));
26073 if ((isIntrinsic (n)) && n->intrinsicF.postUnreachable)
26074 {
26075 n->intrinsicF.postUnreachable = false;
26076 decl_addStatement (s, makeIntrinsicProc (decl_unreachable, 0, NULL));
26077 }
26078 }
26079 }
26080
26081
26082 /*
26083 addCommentBody - adds a body comment to a statement sequence node.
26084 */
26085
26086 extern "C" void decl_addCommentBody (decl_node n)
26087 {
26088 mcComment_commentDesc b;
26089
26090 if (n != NULL)
26091 {
26092 b = mcLexBuf_getBodyComment ();
26093 if (b != NULL)
26094 {
26095 addGenericBody (n, decl_makeCommentS (b));
26096 }
26097 }
26098 }
26099
26100
26101 /*
26102 addCommentAfter - adds an after comment to a statement sequence node.
26103 */
26104
26105 extern "C" void decl_addCommentAfter (decl_node n)
26106 {
26107 mcComment_commentDesc a;
26108
26109 if (n != NULL)
26110 {
26111 a = mcLexBuf_getAfterComment ();
26112 if (a != NULL)
26113 {
26114 addGenericAfter (n, decl_makeCommentS (a));
26115 }
26116 }
26117 }
26118
26119
26120 /*
26121 addIfComments - adds the, body, and, after, comments to if node, n.
26122 */
26123
26124 extern "C" void decl_addIfComments (decl_node n, decl_node body, decl_node after)
26125 {
26126 mcDebug_assert (decl_isIf (n));
26127 n->ifF.ifComment.after = after;
26128 n->ifF.ifComment.body = body;
26129 }
26130
26131
26132 /*
26133 addElseComments - adds the, body, and, after, comments to an, if, or an elsif, node, n.
26134 */
26135
26136 extern "C" void decl_addElseComments (decl_node n, decl_node body, decl_node after)
26137 {
26138 mcDebug_assert ((decl_isIf (n)) || (decl_isElsif (n)));
26139 if (decl_isIf (n))
26140 {
26141 n->ifF.elseComment.after = after;
26142 n->ifF.elseComment.body = body;
26143 }
26144 else
26145 {
26146 n->elsifF.elseComment.after = after;
26147 n->elsifF.elseComment.body = body;
26148 }
26149 }
26150
26151
26152 /*
26153 addIfEndComments - adds the, body, and, after, comments to an, if, node, n.
26154 */
26155
26156 extern "C" void decl_addIfEndComments (decl_node n, decl_node body, decl_node after)
26157 {
26158 mcDebug_assert (decl_isIf (n));
26159 n->ifF.endComment.after = after;
26160 n->ifF.endComment.body = body;
26161 }
26162
26163
26164 /*
26165 makeReturn - creates and returns a return node.
26166 */
26167
26168 extern "C" decl_node decl_makeReturn (void)
26169 {
26170 decl_node type;
26171 decl_node n;
26172
26173 n = newNode (decl_return);
26174 n->returnF.exp = NULL;
26175 if (decl_isProcedure (decl_getDeclScope ()))
26176 {
26177 n->returnF.scope = decl_getDeclScope ();
26178 }
26179 else
26180 {
26181 n->returnF.scope = NULL;
26182 }
26183 initPair (&n->returnF.returnComment);
26184 return n;
26185 /* static analysis guarentees a RETURN statement will be used before here. */
26186 __builtin_unreachable ();
26187 }
26188
26189
26190 /*
26191 isReturn - returns TRUE if node, n, is a return.
26192 */
26193
26194 extern "C" bool decl_isReturn (decl_node n)
26195 {
26196 mcDebug_assert (n != NULL);
26197 return n->kind == decl_return;
26198 /* static analysis guarentees a RETURN statement will be used before here. */
26199 __builtin_unreachable ();
26200 }
26201
26202
26203 /*
26204 putReturn - assigns node, e, as the expression on the return node.
26205 */
26206
26207 extern "C" void decl_putReturn (decl_node n, decl_node e)
26208 {
26209 mcDebug_assert (decl_isReturn (n));
26210 n->returnF.exp = e;
26211 }
26212
26213
26214 /*
26215 makeWhile - creates and returns a while node.
26216 */
26217
26218 extern "C" decl_node decl_makeWhile (void)
26219 {
26220 decl_node n;
26221
26222 n = newNode (decl_while);
26223 n->whileF.expr = NULL;
26224 n->whileF.statements = NULL;
26225 initPair (&n->whileF.doComment);
26226 initPair (&n->whileF.endComment);
26227 return n;
26228 /* static analysis guarentees a RETURN statement will be used before here. */
26229 __builtin_unreachable ();
26230 }
26231
26232
26233 /*
26234 putWhile - places an expression, e, and statement sequence, s, into the while
26235 node, n.
26236 */
26237
26238 extern "C" void decl_putWhile (decl_node n, decl_node e, decl_node s)
26239 {
26240 mcDebug_assert (decl_isWhile (n));
26241 n->whileF.expr = e;
26242 n->whileF.statements = s;
26243 }
26244
26245
26246 /*
26247 isWhile - returns TRUE if node, n, is a while.
26248 */
26249
26250 extern "C" bool decl_isWhile (decl_node n)
26251 {
26252 return n->kind == decl_while;
26253 /* static analysis guarentees a RETURN statement will be used before here. */
26254 __builtin_unreachable ();
26255 }
26256
26257
26258 /*
26259 addWhileDoComment - adds body and after comments to while node, w.
26260 */
26261
26262 extern "C" void decl_addWhileDoComment (decl_node w, decl_node body, decl_node after)
26263 {
26264 mcDebug_assert (decl_isWhile (w));
26265 w->whileF.doComment.after = after;
26266 w->whileF.doComment.body = body;
26267 }
26268
26269
26270 /*
26271 addWhileEndComment - adds body and after comments to the end of a while node, w.
26272 */
26273
26274 extern "C" void decl_addWhileEndComment (decl_node w, decl_node body, decl_node after)
26275 {
26276 mcDebug_assert (decl_isWhile (w));
26277 w->whileF.endComment.after = after;
26278 w->whileF.endComment.body = body;
26279 }
26280
26281
26282 /*
26283 makeAssignment - creates and returns an assignment node.
26284 The designator is, d, and expression, e.
26285 */
26286
26287 extern "C" decl_node decl_makeAssignment (decl_node d, decl_node e)
26288 {
26289 decl_node n;
26290
26291 n = newNode (decl_assignment);
26292 n->assignmentF.des = d;
26293 n->assignmentF.expr = e;
26294 initPair (&n->assignmentF.assignComment);
26295 return n;
26296 /* static analysis guarentees a RETURN statement will be used before here. */
26297 __builtin_unreachable ();
26298 }
26299
26300
26301 /*
26302 putBegin - assigns statements, s, to be the normal part in
26303 block, b. The block may be a procedure or module,
26304 or implementation node.
26305 */
26306
26307 extern "C" void decl_putBegin (decl_node b, decl_node s)
26308 {
26309 mcDebug_assert (((decl_isImp (b)) || (decl_isProcedure (b))) || (decl_isModule (b)));
26310 switch (b->kind)
26311 {
26312 case decl_imp:
26313 b->impF.beginStatements = s;
26314 break;
26315
26316 case decl_module:
26317 b->moduleF.beginStatements = s;
26318 break;
26319
26320 case decl_procedure:
26321 b->procedureF.beginStatements = s;
26322 break;
26323
26324
26325 default:
26326 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
26327 __builtin_unreachable ();
26328 }
26329 }
26330
26331
26332 /*
26333 putFinally - assigns statements, s, to be the final part in
26334 block, b. The block may be a module
26335 or implementation node.
26336 */
26337
26338 extern "C" void decl_putFinally (decl_node b, decl_node s)
26339 {
26340 mcDebug_assert (((decl_isImp (b)) || (decl_isProcedure (b))) || (decl_isModule (b)));
26341 switch (b->kind)
26342 {
26343 case decl_imp:
26344 b->impF.finallyStatements = s;
26345 break;
26346
26347 case decl_module:
26348 b->moduleF.finallyStatements = s;
26349 break;
26350
26351
26352 default:
26353 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
26354 __builtin_unreachable ();
26355 }
26356 }
26357
26358
26359 /*
26360 makeExit - creates and returns an exit node.
26361 */
26362
26363 extern "C" decl_node decl_makeExit (decl_node l, unsigned int n)
26364 {
26365 decl_node e;
26366
26367 mcDebug_assert (decl_isLoop (l));
26368 e = newNode (decl_exit);
26369 e->exitF.loop = l;
26370 l->loopF.labelno = n;
26371 return e;
26372 /* static analysis guarentees a RETURN statement will be used before here. */
26373 __builtin_unreachable ();
26374 }
26375
26376
26377 /*
26378 isExit - returns TRUE if node, n, is an exit.
26379 */
26380
26381 extern "C" bool decl_isExit (decl_node n)
26382 {
26383 mcDebug_assert (n != NULL);
26384 return n->kind == decl_exit;
26385 /* static analysis guarentees a RETURN statement will be used before here. */
26386 __builtin_unreachable ();
26387 }
26388
26389
26390 /*
26391 makeLoop - creates and returns a loop node.
26392 */
26393
26394 extern "C" decl_node decl_makeLoop (void)
26395 {
26396 decl_node l;
26397
26398 l = newNode (decl_loop);
26399 l->loopF.statements = NULL;
26400 l->loopF.labelno = 0;
26401 return l;
26402 /* static analysis guarentees a RETURN statement will be used before here. */
26403 __builtin_unreachable ();
26404 }
26405
26406
26407 /*
26408 isLoop - returns TRUE if, n, is a loop node.
26409 */
26410
26411 extern "C" bool decl_isLoop (decl_node n)
26412 {
26413 mcDebug_assert (n != NULL);
26414 return n->kind == decl_loop;
26415 /* static analysis guarentees a RETURN statement will be used before here. */
26416 __builtin_unreachable ();
26417 }
26418
26419
26420 /*
26421 putLoop - places statement sequence, s, into loop, l.
26422 */
26423
26424 extern "C" void decl_putLoop (decl_node l, decl_node s)
26425 {
26426 mcDebug_assert (decl_isLoop (l));
26427 l->loopF.statements = s;
26428 }
26429
26430
26431 /*
26432 makeComment - creates and returns a comment node.
26433 */
26434
26435 extern "C" decl_node decl_makeComment (const char *a_, unsigned int _a_high)
26436 {
26437 mcComment_commentDesc c;
26438 DynamicStrings_String s;
26439 char a[_a_high+1];
26440
26441 /* make a local copy of each unbounded array. */
26442 memcpy (a, a_, _a_high+1);
26443
26444 c = mcComment_initComment (true);
26445 s = DynamicStrings_InitString ((const char *) a, _a_high);
26446 mcComment_addText (c, DynamicStrings_string (s));
26447 s = DynamicStrings_KillString (s);
26448 return decl_makeCommentS (c);
26449 /* static analysis guarentees a RETURN statement will be used before here. */
26450 __builtin_unreachable ();
26451 }
26452
26453
26454 /*
26455 makeCommentS - creates and returns a comment node.
26456 */
26457
26458 extern "C" decl_node decl_makeCommentS (mcComment_commentDesc c)
26459 {
26460 decl_node n;
26461
26462 if (c == NULL)
26463 {
26464 return NULL;
26465 }
26466 else
26467 {
26468 n = newNode (decl_comment);
26469 n->commentF.content = c;
26470 return n;
26471 }
26472 /* static analysis guarentees a RETURN statement will be used before here. */
26473 __builtin_unreachable ();
26474 }
26475
26476
26477 /*
26478 makeIf - creates and returns an if node. The if node
26479 will have expression, e, and statement sequence, s,
26480 as the then component.
26481 */
26482
26483 extern "C" decl_node decl_makeIf (decl_node e, decl_node s)
26484 {
26485 decl_node n;
26486
26487 n = newNode (decl_if);
26488 n->ifF.expr = e;
26489 n->ifF.then = s;
26490 n->ifF.else_ = NULL;
26491 n->ifF.elsif = NULL;
26492 initPair (&n->ifF.ifComment);
26493 initPair (&n->ifF.elseComment);
26494 initPair (&n->ifF.endComment);
26495 return n;
26496 /* static analysis guarentees a RETURN statement will be used before here. */
26497 __builtin_unreachable ();
26498 }
26499
26500
26501 /*
26502 isIf - returns TRUE if, n, is an if node.
26503 */
26504
26505 extern "C" bool decl_isIf (decl_node n)
26506 {
26507 return n->kind == decl_if;
26508 /* static analysis guarentees a RETURN statement will be used before here. */
26509 __builtin_unreachable ();
26510 }
26511
26512
26513 /*
26514 makeElsif - creates and returns an elsif node.
26515 This node has an expression, e, and statement
26516 sequence, s.
26517 */
26518
26519 extern "C" decl_node decl_makeElsif (decl_node i, decl_node e, decl_node s)
26520 {
26521 decl_node n;
26522
26523 n = newNode (decl_elsif);
26524 n->elsifF.expr = e;
26525 n->elsifF.then = s;
26526 n->elsifF.elsif = NULL;
26527 n->elsifF.else_ = NULL;
26528 initPair (&n->elsifF.elseComment);
26529 mcDebug_assert ((decl_isIf (i)) || (decl_isElsif (i)));
26530 if (decl_isIf (i))
26531 {
26532 i->ifF.elsif = n;
26533 mcDebug_assert (i->ifF.else_ == NULL);
26534 }
26535 else
26536 {
26537 i->elsifF.elsif = n;
26538 mcDebug_assert (i->elsifF.else_ == NULL);
26539 }
26540 return n;
26541 /* static analysis guarentees a RETURN statement will be used before here. */
26542 __builtin_unreachable ();
26543 }
26544
26545
26546 /*
26547 isElsif - returns TRUE if node, n, is an elsif node.
26548 */
26549
26550 extern "C" bool decl_isElsif (decl_node n)
26551 {
26552 return n->kind == decl_elsif;
26553 /* static analysis guarentees a RETURN statement will be used before here. */
26554 __builtin_unreachable ();
26555 }
26556
26557
26558 /*
26559 putElse - the else is grafted onto the if/elsif node, i,
26560 and the statement sequence will be, s.
26561 */
26562
26563 extern "C" void decl_putElse (decl_node i, decl_node s)
26564 {
26565 mcDebug_assert ((decl_isIf (i)) || (decl_isElsif (i)));
26566 if (decl_isIf (i))
26567 {
26568 mcDebug_assert (i->ifF.elsif == NULL);
26569 mcDebug_assert (i->ifF.else_ == NULL);
26570 i->ifF.else_ = s;
26571 }
26572 else
26573 {
26574 mcDebug_assert (i->elsifF.elsif == NULL);
26575 mcDebug_assert (i->elsifF.else_ == NULL);
26576 i->elsifF.else_ = s;
26577 }
26578 }
26579
26580
26581 /*
26582 makeFor - creates and returns a for node.
26583 */
26584
26585 extern "C" decl_node decl_makeFor (void)
26586 {
26587 decl_node n;
26588
26589 n = newNode (decl_for);
26590 n->forF.des = NULL;
26591 n->forF.start = NULL;
26592 n->forF.end = NULL;
26593 n->forF.increment = NULL;
26594 n->forF.statements = NULL;
26595 return n;
26596 /* static analysis guarentees a RETURN statement will be used before here. */
26597 __builtin_unreachable ();
26598 }
26599
26600
26601 /*
26602 isFor - returns TRUE if node, n, is a for node.
26603 */
26604
26605 extern "C" bool decl_isFor (decl_node n)
26606 {
26607 mcDebug_assert (n != NULL);
26608 return n->kind == decl_for;
26609 /* static analysis guarentees a RETURN statement will be used before here. */
26610 __builtin_unreachable ();
26611 }
26612
26613
26614 /*
26615 putFor - assigns the fields of the for node with
26616 ident, i,
26617 start, s,
26618 end, e,
26619 increment, i,
26620 statements, sq.
26621 */
26622
26623 extern "C" void decl_putFor (decl_node f, decl_node i, decl_node s, decl_node e, decl_node b, decl_node sq)
26624 {
26625 mcDebug_assert (decl_isFor (f));
26626 f->forF.des = i;
26627 f->forF.start = s;
26628 f->forF.end = e;
26629 f->forF.increment = b;
26630 f->forF.statements = sq;
26631 }
26632
26633
26634 /*
26635 makeRepeat - creates and returns a repeat node.
26636 */
26637
26638 extern "C" decl_node decl_makeRepeat (void)
26639 {
26640 decl_node n;
26641
26642 n = newNode (decl_repeat);
26643 n->repeatF.expr = NULL;
26644 n->repeatF.statements = NULL;
26645 initPair (&n->repeatF.repeatComment);
26646 initPair (&n->repeatF.untilComment);
26647 return n;
26648 /* static analysis guarentees a RETURN statement will be used before here. */
26649 __builtin_unreachable ();
26650 }
26651
26652
26653 /*
26654 isRepeat - returns TRUE if node, n, is a repeat node.
26655 */
26656
26657 extern "C" bool decl_isRepeat (decl_node n)
26658 {
26659 mcDebug_assert (n != NULL);
26660 return n->kind == decl_repeat;
26661 /* static analysis guarentees a RETURN statement will be used before here. */
26662 __builtin_unreachable ();
26663 }
26664
26665
26666 /*
26667 putRepeat - places statements, s, and expression, e, into
26668 repeat statement, n.
26669 */
26670
26671 extern "C" void decl_putRepeat (decl_node n, decl_node s, decl_node e)
26672 {
26673 n->repeatF.expr = e;
26674 n->repeatF.statements = s;
26675 }
26676
26677
26678 /*
26679 addRepeatComment - adds body and after comments to repeat node, r.
26680 */
26681
26682 extern "C" void decl_addRepeatComment (decl_node r, decl_node body, decl_node after)
26683 {
26684 mcDebug_assert (decl_isRepeat (r));
26685 r->repeatF.repeatComment.after = after;
26686 r->repeatF.repeatComment.body = body;
26687 }
26688
26689
26690 /*
26691 addUntilComment - adds body and after comments to the until section of a repeat node, r.
26692 */
26693
26694 extern "C" void decl_addUntilComment (decl_node r, decl_node body, decl_node after)
26695 {
26696 mcDebug_assert (decl_isRepeat (r));
26697 r->repeatF.untilComment.after = after;
26698 r->repeatF.untilComment.body = body;
26699 }
26700
26701
26702 /*
26703 makeCase - builds and returns a case statement node.
26704 */
26705
26706 extern "C" decl_node decl_makeCase (void)
26707 {
26708 decl_node n;
26709
26710 n = newNode (decl_case);
26711 n->caseF.expression = NULL;
26712 n->caseF.caseLabelList = Indexing_InitIndex (1);
26713 n->caseF.else_ = NULL;
26714 return n;
26715 /* static analysis guarentees a RETURN statement will be used before here. */
26716 __builtin_unreachable ();
26717 }
26718
26719
26720 /*
26721 isCase - returns TRUE if node, n, is a case statement.
26722 */
26723
26724 extern "C" bool decl_isCase (decl_node n)
26725 {
26726 mcDebug_assert (n != NULL);
26727 return n->kind == decl_case;
26728 /* static analysis guarentees a RETURN statement will be used before here. */
26729 __builtin_unreachable ();
26730 }
26731
26732
26733 /*
26734 putCaseExpression - places expression, e, into case statement, n.
26735 n is returned.
26736 */
26737
26738 extern "C" decl_node decl_putCaseExpression (decl_node n, decl_node e)
26739 {
26740 mcDebug_assert (decl_isCase (n));
26741 n->caseF.expression = e;
26742 return n;
26743 /* static analysis guarentees a RETURN statement will be used before here. */
26744 __builtin_unreachable ();
26745 }
26746
26747
26748 /*
26749 putCaseElse - places else statement, e, into case statement, n.
26750 n is returned.
26751 */
26752
26753 extern "C" decl_node decl_putCaseElse (decl_node n, decl_node e)
26754 {
26755 mcDebug_assert (decl_isCase (n));
26756 n->caseF.else_ = e;
26757 return n;
26758 /* static analysis guarentees a RETURN statement will be used before here. */
26759 __builtin_unreachable ();
26760 }
26761
26762
26763 /*
26764 putCaseStatement - places a caselist, l, and associated
26765 statement sequence, s, into case statement, n.
26766 n is returned.
26767 */
26768
26769 extern "C" decl_node decl_putCaseStatement (decl_node n, decl_node l, decl_node s)
26770 {
26771 mcDebug_assert (decl_isCase (n));
26772 mcDebug_assert (decl_isCaseList (l));
26773 Indexing_IncludeIndiceIntoIndex (n->caseF.caseLabelList, reinterpret_cast<void *> (decl_makeCaseLabelList (l, s)));
26774 return n;
26775 /* static analysis guarentees a RETURN statement will be used before here. */
26776 __builtin_unreachable ();
26777 }
26778
26779
26780 /*
26781 makeCaseLabelList - creates and returns a caselabellist node.
26782 */
26783
26784 extern "C" decl_node decl_makeCaseLabelList (decl_node l, decl_node s)
26785 {
26786 decl_node n;
26787
26788 n = newNode (decl_caselabellist);
26789 n->caselabellistF.caseList = l;
26790 n->caselabellistF.statements = s;
26791 return n;
26792 /* static analysis guarentees a RETURN statement will be used before here. */
26793 __builtin_unreachable ();
26794 }
26795
26796
26797 /*
26798 isCaseLabelList - returns TRUE if, n, is a caselabellist.
26799 */
26800
26801 extern "C" bool decl_isCaseLabelList (decl_node n)
26802 {
26803 mcDebug_assert (n != NULL);
26804 return n->kind == decl_caselabellist;
26805 /* static analysis guarentees a RETURN statement will be used before here. */
26806 __builtin_unreachable ();
26807 }
26808
26809
26810 /*
26811 makeCaseList - creates and returns a case statement node.
26812 */
26813
26814 extern "C" decl_node decl_makeCaseList (void)
26815 {
26816 decl_node n;
26817
26818 n = newNode (decl_caselist);
26819 n->caselistF.rangePairs = Indexing_InitIndex (1);
26820 return n;
26821 /* static analysis guarentees a RETURN statement will be used before here. */
26822 __builtin_unreachable ();
26823 }
26824
26825
26826 /*
26827 isCaseList - returns TRUE if, n, is a case list.
26828 */
26829
26830 extern "C" bool decl_isCaseList (decl_node n)
26831 {
26832 mcDebug_assert (n != NULL);
26833 return n->kind == decl_caselist;
26834 /* static analysis guarentees a RETURN statement will be used before here. */
26835 __builtin_unreachable ();
26836 }
26837
26838
26839 /*
26840 putCaseRange - places the case range lo..hi into caselist, n.
26841 */
26842
26843 extern "C" decl_node decl_putCaseRange (decl_node n, decl_node lo, decl_node hi)
26844 {
26845 mcDebug_assert (decl_isCaseList (n));
26846 Indexing_IncludeIndiceIntoIndex (n->caselistF.rangePairs, reinterpret_cast<void *> (decl_makeRange (lo, hi)));
26847 return n;
26848 /* static analysis guarentees a RETURN statement will be used before here. */
26849 __builtin_unreachable ();
26850 }
26851
26852
26853 /*
26854 makeRange - creates and returns a case range.
26855 */
26856
26857 extern "C" decl_node decl_makeRange (decl_node lo, decl_node hi)
26858 {
26859 decl_node n;
26860
26861 n = newNode (decl_range);
26862 n->rangeF.lo = lo;
26863 n->rangeF.hi = hi;
26864 return n;
26865 /* static analysis guarentees a RETURN statement will be used before here. */
26866 __builtin_unreachable ();
26867 }
26868
26869
26870 /*
26871 isRange - returns TRUE if node, n, is a range.
26872 */
26873
26874 extern "C" bool decl_isRange (decl_node n)
26875 {
26876 mcDebug_assert (n != NULL);
26877 return n->kind == decl_range;
26878 /* static analysis guarentees a RETURN statement will be used before here. */
26879 __builtin_unreachable ();
26880 }
26881
26882
26883 /*
26884 setNoReturn - sets noreturn field inside procedure.
26885 */
26886
26887 extern "C" void decl_setNoReturn (decl_node n, bool value)
26888 {
26889 mcDebug_assert (n != NULL);
26890 mcDebug_assert (decl_isProcedure (n));
26891 if (n->procedureF.noreturnused && (n->procedureF.noreturn != value))
26892 {
26893 mcMetaError_metaError1 ((const char *) "{%1DMad} definition module and implementation module have different <* noreturn *> attributes", 93, (const unsigned char *) &n, (sizeof (n)-1));
26894 }
26895 n->procedureF.noreturn = value;
26896 n->procedureF.noreturnused = true;
26897 }
26898
26899
26900 /*
26901 dupExpr - duplicate the expression nodes, it does not duplicate
26902 variables, literals, constants but only the expression
26903 operators (including function calls and parameter lists).
26904 */
26905
26906 extern "C" decl_node decl_dupExpr (decl_node n)
26907 {
26908 if (n == NULL)
26909 {
26910 return NULL;
26911 }
26912 else
26913 {
26914 return doDupExpr (n);
26915 }
26916 /* static analysis guarentees a RETURN statement will be used before here. */
26917 __builtin_unreachable ();
26918 }
26919
26920
26921 /*
26922 setLangC -
26923 */
26924
26925 extern "C" void decl_setLangC (void)
26926 {
26927 lang = decl_ansiC;
26928 }
26929
26930
26931 /*
26932 setLangCP -
26933 */
26934
26935 extern "C" void decl_setLangCP (void)
26936 {
26937 lang = decl_ansiCP;
26938 keyc_cp ();
26939 }
26940
26941
26942 /*
26943 setLangM2 -
26944 */
26945
26946 extern "C" void decl_setLangM2 (void)
26947 {
26948 lang = decl_pim4;
26949 }
26950
26951
26952 /*
26953 out - walks the tree of node declarations for the main module
26954 and writes the output to the outputFile specified in
26955 mcOptions. It outputs the declarations in the language
26956 specified above.
26957 */
26958
26959 extern "C" void decl_out (void)
26960 {
26961 mcPretty_pretty p;
26962
26963 openOutput ();
26964 p = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln});
26965 switch (lang)
26966 {
26967 case decl_ansiC:
26968 outC (p, decl_getMainModule ());
26969 break;
26970
26971 case decl_ansiCP:
26972 outC (p, decl_getMainModule ());
26973 break;
26974
26975 case decl_pim4:
26976 outM2 (p, decl_getMainModule ());
26977 break;
26978
26979
26980 default:
26981 CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
26982 __builtin_unreachable ();
26983 }
26984 closeOutput ();
26985 }
26986
26987 extern "C" void _M2_decl_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
26988 {
26989 init ();
26990 }
26991
26992 extern "C" void _M2_decl_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
26993 {
26994 }