/* do not edit automatically generated by mc from decl. */ /* decl.mod declaration nodes used to create the AST. Copyright (C) 2015-2023 Free Software Foundation, Inc. Contributed by Gaius Mulley . This file is part of GNU Modula-2. GNU Modula-2 is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3, or (at your option) any later version. GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Modula-2; see the file COPYING3. If not see . */ #include "config.h" #include "system.h" # if !defined (PROC_D) # define PROC_D typedef void (*PROC_t) (void); typedef struct { PROC_t proc; } PROC; # endif # if !defined (TRUE) # define TRUE (1==1) # endif # if !defined (FALSE) # define FALSE (1==0) # endif # include "GStorage.h" # include "Gmcrts.h" #if defined(__cplusplus) # undef NULL # define NULL 0 #endif typedef unsigned int nameKey_Name; # define nameKey_NulName 0 typedef struct mcPretty_writeProc_p mcPretty_writeProc; typedef struct symbolKey__T8_r symbolKey__T8; typedef symbolKey__T8 *symbolKey_symbolTree; typedef struct mcPretty_writeLnProc_p mcPretty_writeLnProc; typedef unsigned int FIO_File; extern FIO_File FIO_StdOut; # define symbolKey_NulKey NULL typedef struct symbolKey_performOperation_p symbolKey_performOperation; # define ASCII_tab ASCII_ht typedef struct alists__T13_r alists__T13; typedef alists__T13 *alists_alist; typedef struct alists__T14_a alists__T14; # define ASCII_ht (char) 011 # define ASCII_lf ASCII_nl # define ASCII_nl (char) 012 typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure; typedef struct decl_isNodeF_p decl_isNodeF; # define SYSTEM_BITSPERBYTE 8 # define SYSTEM_BYTESPERWORD 4 typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP; typedef struct symbolKey_isSymbol_p symbolKey_isSymbol; # define ASCII_nul (char) 000 # define ASCII_soh (char) 001 # define ASCII_stx (char) 002 # define ASCII_etx (char) 003 # define ASCII_eot (char) 004 # define ASCII_enq (char) 005 # define ASCII_ack (char) 006 # define ASCII_bel (char) 007 # define ASCII_bs (char) 010 # define ASCII_vt (char) 013 # define ASCII_np (char) 014 # define ASCII_cr (char) 015 # define ASCII_so (char) 016 # define ASCII_si (char) 017 # define ASCII_dle (char) 020 # define ASCII_dc1 (char) 021 # define ASCII_dc2 (char) 022 # define ASCII_dc3 (char) 023 # define ASCII_dc4 (char) 024 # define ASCII_nak (char) 025 # define ASCII_syn (char) 026 # define ASCII_etb (char) 027 # define ASCII_can (char) 030 # define ASCII_em (char) 031 # define ASCII_sub (char) 032 # define ASCII_esc (char) 033 # define ASCII_fs (char) 034 # define ASCII_gs (char) 035 # define ASCII_rs (char) 036 # define ASCII_us (char) 037 # define ASCII_sp (char) 040 # define ASCII_ff ASCII_np # define ASCII_eof ASCII_eot # define ASCII_del (char) 0177 # define ASCII_EOL ASCII_nl extern FIO_File FIO_StdErr; extern FIO_File FIO_StdIn; typedef long int libc_time_t; typedef struct libc_tm_r libc_tm; typedef libc_tm *libc_ptrToTM; typedef struct libc_timeb_r libc_timeb; typedef struct libc_exitP_p libc_exitP; typedef struct mcError__T11_r mcError__T11; typedef mcError__T11 *mcError_error; extern int mcLexBuf_currentinteger; extern unsigned int mcLexBuf_currentcolumn; extern void * mcLexBuf_currentstring; typedef struct alists_performOperation_p alists_performOperation; typedef struct wlists_performOperation_p wlists_performOperation; typedef struct StdIO_ProcWrite_p StdIO_ProcWrite; typedef struct StdIO_ProcRead_p StdIO_ProcRead; # define indentation 3 # define indentationC 2 # define debugScopes FALSE # define debugDecl FALSE # define caseException TRUE # define returnException TRUE # define forceCompoundStatement TRUE # define enableDefForCStrings FALSE # define enableMemsetOnAllocation TRUE # define forceQualified TRUE typedef struct decl_nodeRec_r decl_nodeRec; typedef struct decl_intrinsicT_r decl_intrinsicT; typedef struct decl_fixupInfo_r decl_fixupInfo; typedef struct decl_explistT_r decl_explistT; typedef struct decl_setvalueT_r decl_setvalueT; typedef struct decl_identlistT_r decl_identlistT; typedef struct decl_funccallT_r decl_funccallT; typedef struct decl_commentT_r decl_commentT; typedef struct decl_stmtT_r decl_stmtT; typedef struct decl_returnT_r decl_returnT; typedef struct decl_exitT_r decl_exitT; typedef struct decl_vardeclT_r decl_vardeclT; typedef struct decl_typeT_r decl_typeT; typedef struct decl_recordT_r decl_recordT; typedef struct decl_varientT_r decl_varientT; typedef struct decl_varT_r decl_varT; typedef struct decl_enumerationT_r decl_enumerationT; typedef struct decl_subrangeT_r decl_subrangeT; typedef struct decl_subscriptT_r decl_subscriptT; typedef struct decl_arrayT_r decl_arrayT; typedef struct decl_stringT_r decl_stringT; typedef struct decl_literalT_r decl_literalT; typedef struct decl_constT_r decl_constT; typedef struct decl_varparamT_r decl_varparamT; typedef struct decl_paramT_r decl_paramT; typedef struct decl_varargsT_r decl_varargsT; typedef struct decl_optargT_r decl_optargT; typedef struct decl_pointerT_r decl_pointerT; typedef struct decl_recordfieldT_r decl_recordfieldT; typedef struct decl_varientfieldT_r decl_varientfieldT; typedef struct decl_enumerationfieldT_r decl_enumerationfieldT; typedef struct decl_setT_r decl_setT; typedef struct decl_componentrefT_r decl_componentrefT; typedef struct decl_pointerrefT_r decl_pointerrefT; typedef struct decl_arrayrefT_r decl_arrayrefT; typedef struct decl_commentPair_r decl_commentPair; typedef struct decl_assignmentT_r decl_assignmentT; typedef struct decl_ifT_r decl_ifT; typedef struct decl_elsifT_r decl_elsifT; typedef struct decl_loopT_r decl_loopT; typedef struct decl_whileT_r decl_whileT; typedef struct decl_repeatT_r decl_repeatT; typedef struct decl_caseT_r decl_caseT; typedef struct decl_caselabellistT_r decl_caselabellistT; typedef struct decl_caselistT_r decl_caselistT; typedef struct decl_rangeT_r decl_rangeT; typedef struct decl_forT_r decl_forT; typedef struct decl_statementT_r decl_statementT; typedef struct decl_scopeT_r decl_scopeT; typedef struct decl_procedureT_r decl_procedureT; typedef struct decl_proctypeT_r decl_proctypeT; typedef struct decl_binaryT_r decl_binaryT; typedef struct decl_unaryT_r decl_unaryT; typedef struct decl_moduleT_r decl_moduleT; typedef struct decl_defT_r decl_defT; typedef struct decl_impT_r decl_impT; typedef struct decl_where_r decl_where; typedef struct decl_nodeProcedure_p decl_nodeProcedure; typedef struct decl_cnameT_r decl_cnameT; # define MaxBuf 127 # define maxNoOfElements 5 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; # define MaxnoOfelements 5 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; extern mcReserved_toktype mcLexBuf_currenttoken; typedef enum {decl_ansiC, decl_ansiCP, decl_pim4} decl_language; typedef enum {decl_completed, decl_blocked, decl_partial, decl_recursive} decl_dependentState; typedef enum {decl_text, decl_punct, decl_space} decl_outputStates; typedef decl_nodeRec *decl_node; typedef struct Indexing__T5_r Indexing__T5; typedef struct mcComment__T6_r mcComment__T6; typedef enum {mcComment_unknown, mcComment_procedureHeading, mcComment_inBody, mcComment_afterStatement} mcComment_commentType; typedef struct DynamicStrings_stringRecord_r DynamicStrings_stringRecord; typedef struct DynamicStrings_Contents_r DynamicStrings_Contents; typedef struct wlists__T9_r wlists__T9; typedef struct mcPretty__T12_r mcPretty__T12; typedef struct wlists__T10_a wlists__T10; typedef struct DynamicStrings__T7_a DynamicStrings__T7; typedef Indexing__T5 *Indexing_Index; typedef mcComment__T6 *mcComment_commentDesc; extern mcComment_commentDesc mcLexBuf_currentcomment; extern mcComment_commentDesc mcLexBuf_lastcomment; typedef DynamicStrings_stringRecord *DynamicStrings_String; typedef wlists__T9 *wlists_wlist; typedef mcPretty__T12 *mcPretty_pretty; typedef void (*mcPretty_writeProc_t) (char); struct mcPretty_writeProc_p { mcPretty_writeProc_t proc; }; struct symbolKey__T8_r { nameKey_Name name; void *key; symbolKey_symbolTree left; symbolKey_symbolTree right; }; typedef void (*mcPretty_writeLnProc_t) (void); struct mcPretty_writeLnProc_p { mcPretty_writeLnProc_t proc; }; typedef void (*symbolKey_performOperation_t) (void *); struct symbolKey_performOperation_p { symbolKey_performOperation_t proc; }; struct alists__T14_a { void * array[MaxnoOfelements-1+1]; }; typedef void (*Indexing_IndexProcedure_t) (void *); struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; }; typedef unsigned int (*decl_isNodeF_t) (decl_node); struct decl_isNodeF_p { decl_isNodeF_t proc; }; typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *); struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; }; typedef unsigned int (*symbolKey_isSymbol_t) (void *); struct symbolKey_isSymbol_p { symbolKey_isSymbol_t proc; }; struct libc_tm_r { int tm_sec; int tm_min; int tm_hour; int tm_mday; int tm_mon; int tm_year; int tm_wday; int tm_yday; int tm_isdst; long int tm_gmtoff; void *tm_zone; }; struct libc_timeb_r { libc_time_t time_; short unsigned int millitm; short unsigned int timezone; short unsigned int dstflag; }; typedef int (*libc_exitP_t) (void); typedef libc_exitP_t libc_exitP_C; struct libc_exitP_p { libc_exitP_t proc; }; struct mcError__T11_r { mcError_error parent; mcError_error child; mcError_error next; unsigned int fatal; DynamicStrings_String s; unsigned int token; }; typedef void (*alists_performOperation_t) (void *); struct alists_performOperation_p { alists_performOperation_t proc; }; typedef void (*wlists_performOperation_t) (unsigned int); struct wlists_performOperation_p { wlists_performOperation_t proc; }; typedef void (*StdIO_ProcWrite_t) (char); struct StdIO_ProcWrite_p { StdIO_ProcWrite_t proc; }; typedef void (*StdIO_ProcRead_t) (char *); struct StdIO_ProcRead_p { StdIO_ProcRead_t proc; }; struct decl_fixupInfo_r { unsigned int count; Indexing_Index info; }; struct decl_explistT_r { Indexing_Index exp; }; struct decl_setvalueT_r { decl_node type; Indexing_Index values; }; struct decl_identlistT_r { wlists_wlist names; unsigned int cnamed; }; struct decl_commentT_r { mcComment_commentDesc content; }; struct decl_stmtT_r { Indexing_Index statements; }; struct decl_exitT_r { decl_node loop; }; struct decl_vardeclT_r { wlists_wlist names; decl_node type; decl_node scope; }; struct decl_typeT_r { nameKey_Name name; decl_node type; decl_node scope; unsigned int isHidden; unsigned int isInternal; }; struct decl_recordT_r { symbolKey_symbolTree localSymbols; Indexing_Index listOfSons; decl_node scope; }; struct decl_varientT_r { Indexing_Index listOfSons; decl_node varient; decl_node tag; decl_node scope; }; struct decl_enumerationT_r { unsigned int noOfElements; symbolKey_symbolTree localSymbols; Indexing_Index listOfSons; decl_node low; decl_node high; decl_node scope; }; struct decl_subrangeT_r { decl_node low; decl_node high; decl_node type; decl_node scope; }; struct decl_subscriptT_r { decl_node type; decl_node expr; }; struct decl_arrayT_r { decl_node subr; decl_node type; decl_node scope; unsigned int isUnbounded; }; struct decl_stringT_r { nameKey_Name name; unsigned int length; unsigned int isCharCompatible; DynamicStrings_String cstring; unsigned int clength; DynamicStrings_String cchar; }; struct decl_literalT_r { nameKey_Name name; decl_node type; }; struct decl_constT_r { nameKey_Name name; decl_node type; decl_node value; decl_node scope; }; struct decl_varparamT_r { decl_node namelist; decl_node type; decl_node scope; unsigned int isUnbounded; unsigned int isForC; unsigned int isUsed; }; struct decl_paramT_r { decl_node namelist; decl_node type; decl_node scope; unsigned int isUnbounded; unsigned int isForC; unsigned int isUsed; }; struct decl_varargsT_r { decl_node scope; }; struct decl_optargT_r { decl_node namelist; decl_node type; decl_node scope; decl_node init; }; struct decl_pointerT_r { decl_node type; decl_node scope; }; struct decl_varientfieldT_r { nameKey_Name name; decl_node parent; decl_node varient; unsigned int simple; Indexing_Index listOfSons; decl_node scope; }; struct decl_setT_r { decl_node type; decl_node scope; }; struct decl_componentrefT_r { decl_node rec; decl_node field; decl_node resultType; }; struct decl_pointerrefT_r { decl_node ptr; decl_node field; decl_node resultType; }; struct decl_arrayrefT_r { decl_node array; decl_node index; decl_node resultType; }; struct decl_commentPair_r { decl_node after; decl_node body; }; struct decl_loopT_r { decl_node statements; unsigned int labelno; }; struct decl_caseT_r { decl_node expression; Indexing_Index caseLabelList; decl_node else_; }; struct decl_caselabellistT_r { decl_node caseList; decl_node statements; }; struct decl_caselistT_r { Indexing_Index rangePairs; }; struct decl_rangeT_r { decl_node lo; decl_node hi; }; struct decl_forT_r { decl_node des; decl_node start; decl_node end; decl_node increment; decl_node statements; }; struct decl_statementT_r { Indexing_Index sequence; }; struct decl_scopeT_r { symbolKey_symbolTree symbols; Indexing_Index constants; Indexing_Index types; Indexing_Index procedures; Indexing_Index variables; }; struct decl_proctypeT_r { Indexing_Index parameters; unsigned int returnopt; unsigned int vararg; decl_node optarg_; decl_node scope; decl_node returnType; }; struct decl_binaryT_r { decl_node left; decl_node right; decl_node resultType; }; struct decl_unaryT_r { decl_node arg; decl_node resultType; }; struct decl_where_r { unsigned int defDeclared; unsigned int modDeclared; unsigned int firstUsed; }; typedef void (*decl_nodeProcedure_t) (decl_node); struct decl_nodeProcedure_p { decl_nodeProcedure_t proc; }; struct decl_cnameT_r { nameKey_Name name; unsigned int init; }; struct Indexing__T5_r { void *ArrayStart; unsigned int ArraySize; unsigned int Used; unsigned int Low; unsigned int High; unsigned int Debug; unsigned int Map; }; struct mcComment__T6_r { mcComment_commentType type; DynamicStrings_String content; nameKey_Name procName; unsigned int used; }; struct wlists__T10_a { unsigned int array[maxNoOfElements-1+1]; }; struct DynamicStrings__T7_a { char array[(MaxBuf-1)+1]; }; struct alists__T13_r { unsigned int noOfelements; alists__T14 elements; alists_alist next; }; struct decl_intrinsicT_r { decl_node args; unsigned int noArgs; decl_node type; decl_commentPair intrinsicComment; unsigned int postUnreachable; }; struct decl_funccallT_r { decl_node function; decl_node args; decl_node type; decl_commentPair funccallComment; }; struct decl_returnT_r { decl_node exp; decl_node scope; decl_commentPair returnComment; }; struct decl_varT_r { nameKey_Name name; decl_node type; decl_node decl; decl_node scope; unsigned int isInitialised; unsigned int isParameter; unsigned int isVarParameter; unsigned int isUsed; decl_cnameT cname; }; struct decl_recordfieldT_r { nameKey_Name name; decl_node type; unsigned int tag; decl_node parent; decl_node varient; decl_node scope; decl_cnameT cname; }; struct decl_enumerationfieldT_r { nameKey_Name name; decl_node type; decl_node scope; unsigned int value; decl_cnameT cname; }; struct decl_assignmentT_r { decl_node des; decl_node expr; decl_commentPair assignComment; }; struct decl_ifT_r { decl_node expr; decl_node elsif; decl_node then; decl_node else_; decl_commentPair ifComment; decl_commentPair elseComment; decl_commentPair endComment; }; struct decl_elsifT_r { decl_node expr; decl_node elsif; decl_node then; decl_node else_; decl_commentPair elseComment; }; struct decl_whileT_r { decl_node expr; decl_node statements; decl_commentPair doComment; decl_commentPair endComment; }; struct decl_repeatT_r { decl_node expr; decl_node statements; decl_commentPair repeatComment; decl_commentPair untilComment; }; struct decl_procedureT_r { nameKey_Name name; decl_scopeT decls; decl_node scope; Indexing_Index parameters; unsigned int isForC; unsigned int built; unsigned int checking; unsigned int returnopt; unsigned int vararg; unsigned int noreturnused; unsigned int noreturn; unsigned int paramcount; decl_node optarg_; decl_node returnType; decl_node beginStatements; decl_cnameT cname; mcComment_commentDesc defComment; mcComment_commentDesc modComment; }; struct decl_moduleT_r { nameKey_Name name; nameKey_Name source; Indexing_Index importedModules; decl_fixupInfo constFixup; decl_fixupInfo enumFixup; decl_scopeT decls; decl_node beginStatements; decl_node finallyStatements; unsigned int enumsComplete; unsigned int constsComplete; unsigned int visited; decl_commentPair com; }; struct decl_defT_r { nameKey_Name name; nameKey_Name source; unsigned int hasHidden; unsigned int forC; Indexing_Index exported; Indexing_Index importedModules; decl_fixupInfo constFixup; decl_fixupInfo enumFixup; decl_scopeT decls; unsigned int enumsComplete; unsigned int constsComplete; unsigned int visited; decl_commentPair com; }; struct decl_impT_r { nameKey_Name name; nameKey_Name source; Indexing_Index importedModules; decl_fixupInfo constFixup; decl_fixupInfo enumFixup; decl_node beginStatements; decl_node finallyStatements; decl_node definitionModule; decl_scopeT decls; unsigned int enumsComplete; unsigned int constsComplete; unsigned int visited; decl_commentPair com; }; struct DynamicStrings_Contents_r { DynamicStrings__T7 buf; unsigned int len; DynamicStrings_String next; }; struct wlists__T9_r { unsigned int noOfElements; wlists__T10 elements; wlists_wlist next; }; struct mcPretty__T12_r { mcPretty_writeProc write_; mcPretty_writeLnProc writeln; unsigned int needsSpace; unsigned int needsIndent; unsigned int seekPos; unsigned int curLine; unsigned int curPos; unsigned int indent; mcPretty_pretty stacked; }; typedef struct DynamicStrings_descriptor_r DynamicStrings_descriptor; typedef DynamicStrings_descriptor *DynamicStrings_Descriptor; typedef struct DynamicStrings_DebugInfo_r DynamicStrings_DebugInfo; typedef enum {DynamicStrings_inuse, DynamicStrings_marked, DynamicStrings_onlist, DynamicStrings_poisoned} DynamicStrings_desState; struct DynamicStrings_descriptor_r { unsigned int charStarUsed; void *charStar; unsigned int charStarSize; unsigned int charStarValid; DynamicStrings_desState state; DynamicStrings_String garbage; }; struct DynamicStrings_DebugInfo_r { DynamicStrings_String next; void *file; unsigned int line; void *proc; }; struct decl_nodeRec_r { decl_nodeT kind; /* case tag */ union { decl_intrinsicT intrinsicF; decl_explistT explistF; decl_exitT exitF; decl_returnT returnF; decl_stmtT stmtF; decl_commentT commentF; decl_typeT typeF; decl_recordT recordF; decl_varientT varientF; decl_varT varF; decl_enumerationT enumerationF; decl_subrangeT subrangeF; decl_subscriptT subscriptF; decl_arrayT arrayF; decl_stringT stringF; decl_constT constF; decl_literalT literalF; decl_varparamT varparamF; decl_paramT paramF; decl_varargsT varargsF; decl_optargT optargF; decl_pointerT pointerF; decl_recordfieldT recordfieldF; decl_varientfieldT varientfieldF; decl_enumerationfieldT enumerationfieldF; decl_setT setF; decl_proctypeT proctypeF; decl_procedureT procedureF; decl_defT defF; decl_impT impF; decl_moduleT moduleF; decl_loopT loopF; decl_whileT whileF; decl_forT forF; decl_repeatT repeatF; decl_caseT caseF; decl_caselabellistT caselabellistF; decl_caselistT caselistF; decl_rangeT rangeF; decl_ifT ifF; decl_elsifT elsifF; decl_assignmentT assignmentF; decl_arrayrefT arrayrefF; decl_pointerrefT pointerrefF; decl_componentrefT componentrefF; decl_binaryT binaryF; decl_unaryT unaryF; decl_identlistT identlistF; decl_vardeclT vardeclF; decl_funccallT funccallF; decl_setvalueT setvalueF; }; decl_where at; }; struct DynamicStrings_stringRecord_r { DynamicStrings_Contents contents; DynamicStrings_Descriptor head; DynamicStrings_DebugInfo debug; }; static FIO_File outputFile; static decl_language lang; static decl_node bitsperunitN; static decl_node bitsperwordN; static decl_node bitspercharN; static decl_node unitsperwordN; static decl_node mainModule; static decl_node currentModule; static decl_node defModule; static decl_node systemN; static decl_node addressN; static decl_node locN; static decl_node byteN; static decl_node wordN; static decl_node csizetN; static decl_node cssizetN; static decl_node adrN; static decl_node sizeN; static decl_node tsizeN; static decl_node newN; static decl_node disposeN; static decl_node lengthN; static decl_node incN; static decl_node decN; static decl_node inclN; static decl_node exclN; static decl_node highN; static decl_node m2rtsN; static decl_node haltN; static decl_node throwN; static decl_node chrN; static decl_node capN; static decl_node absN; static decl_node floatN; static decl_node truncN; static decl_node ordN; static decl_node valN; static decl_node minN; static decl_node maxN; static decl_node booleanN; static decl_node procN; static decl_node charN; static decl_node integerN; static decl_node cardinalN; static decl_node longcardN; static decl_node shortcardN; static decl_node longintN; static decl_node shortintN; static decl_node bitsetN; static decl_node bitnumN; static decl_node ztypeN; static decl_node rtypeN; static decl_node complexN; static decl_node longcomplexN; static decl_node shortcomplexN; static decl_node cmplxN; static decl_node reN; static decl_node imN; static decl_node realN; static decl_node longrealN; static decl_node shortrealN; static decl_node nilN; static decl_node trueN; static decl_node falseN; static Indexing_Index scopeStack; static Indexing_Index defUniverseI; static Indexing_Index modUniverseI; static symbolKey_symbolTree modUniverse; static symbolKey_symbolTree defUniverse; static symbolKey_symbolTree baseSymbols; static decl_outputStates outputState; static mcPretty_pretty doP; static alists_alist todoQ; static alists_alist partialQ; static alists_alist doneQ; static unsigned int mustVisitScope; static unsigned int simplified; static unsigned int tempCount; static decl_node globalNode; extern "C" void SYSTEM_ShiftVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int ShiftCount); 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); 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); extern "C" void SYSTEM_RotateVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int RotateCount); 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); 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); extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies); extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname); extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p); extern "C" void M2RTS_ExecuteInitialProcedures (void); extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p); extern "C" void M2RTS_ExecuteTerminationProcedures (void); extern "C" void M2RTS_Terminate (void) __attribute__ ((noreturn)); extern "C" void M2RTS_HALT (int exitcode) __attribute__ ((noreturn)); extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn)); extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) __attribute__ ((noreturn)); extern "C" void M2RTS_ExitOnHalt (int e); 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)); extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high); extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); /* getDeclaredMod - returns the token number associated with the nodes declaration in the implementation or program module. */ extern "C" unsigned int decl_getDeclaredMod (decl_node n); /* getDeclaredDef - returns the token number associated with the nodes declaration in the definition module. */ extern "C" unsigned int decl_getDeclaredDef (decl_node n); /* getFirstUsed - returns the token number associated with the first use of node, n. */ extern "C" unsigned int decl_getFirstUsed (decl_node n); /* isDef - return TRUE if node, n, is a definition module. */ extern "C" unsigned int decl_isDef (decl_node n); /* isImp - return TRUE if node, n, is an implementation module. */ extern "C" unsigned int decl_isImp (decl_node n); /* isImpOrModule - returns TRUE if, n, is a program module or implementation module. */ extern "C" unsigned int decl_isImpOrModule (decl_node n); /* isVisited - returns TRUE if the node was visited. */ extern "C" unsigned int decl_isVisited (decl_node n); /* unsetVisited - unset the visited flag on a def/imp/module node. */ extern "C" void decl_unsetVisited (decl_node n); /* setVisited - set the visited flag on a def/imp/module node. */ extern "C" void decl_setVisited (decl_node n); /* setEnumsComplete - sets the field inside the def or imp or module, n. */ extern "C" void decl_setEnumsComplete (decl_node n); /* getEnumsComplete - gets the field from the def or imp or module, n. */ extern "C" unsigned int decl_getEnumsComplete (decl_node n); /* resetEnumPos - resets the index into the saved list of enums inside module, n. */ extern "C" void decl_resetEnumPos (decl_node n); /* getNextEnum - returns the next enumeration node. */ extern "C" decl_node decl_getNextEnum (void); /* isModule - return TRUE if node, n, is a program module. */ extern "C" unsigned int decl_isModule (decl_node n); /* isMainModule - return TRUE if node, n, is the main module specified by the source file. This might be a definition, implementation or program module. */ extern "C" unsigned int decl_isMainModule (decl_node n); /* setMainModule - sets node, n, as the main module to be compiled. */ extern "C" void decl_setMainModule (decl_node n); /* setCurrentModule - sets node, n, as the current module being compiled. */ extern "C" void decl_setCurrentModule (decl_node n); /* lookupDef - returns a definition module node named, n. */ extern "C" decl_node decl_lookupDef (nameKey_Name n); /* lookupImp - returns an implementation module node named, n. */ extern "C" decl_node decl_lookupImp (nameKey_Name n); /* lookupModule - returns a module node named, n. */ extern "C" decl_node decl_lookupModule (nameKey_Name n); /* putDefForC - the definition module was defined FOR "C". */ extern "C" void decl_putDefForC (decl_node n); /* lookupInScope - looks up a symbol named, n, from, scope. */ extern "C" decl_node decl_lookupInScope (decl_node scope, nameKey_Name n); /* isConst - returns TRUE if node, n, is a const. */ extern "C" unsigned int decl_isConst (decl_node n); /* isType - returns TRUE if node, n, is a type. */ extern "C" unsigned int decl_isType (decl_node n); /* putType - places, exp, as the type alias to des. TYPE des = exp ; */ extern "C" void decl_putType (decl_node des, decl_node exp); /* getType - returns the type associated with node, n. */ extern "C" decl_node decl_getType (decl_node n); /* skipType - skips over type aliases. */ extern "C" decl_node decl_skipType (decl_node n); /* putTypeHidden - marks type, des, as being a hidden type. TYPE des ; */ extern "C" void decl_putTypeHidden (decl_node des); /* isTypeHidden - returns TRUE if type, n, is hidden. */ extern "C" unsigned int decl_isTypeHidden (decl_node n); /* hasHidden - returns TRUE if module, n, has a hidden type. */ extern "C" unsigned int decl_hasHidden (decl_node n); /* isVar - returns TRUE if node, n, is a type. */ extern "C" unsigned int decl_isVar (decl_node n); /* isTemporary - returns TRUE if node, n, is a variable and temporary. */ extern "C" unsigned int decl_isTemporary (decl_node n); /* isExported - returns TRUE if symbol, n, is exported from the definition module. */ extern "C" unsigned int decl_isExported (decl_node n); /* getDeclScope - returns the node representing the current declaration scope. */ extern "C" decl_node decl_getDeclScope (void); /* getScope - returns the scope associated with node, n. */ extern "C" decl_node decl_getScope (decl_node n); /* isLiteral - returns TRUE if, n, is a literal. */ extern "C" unsigned int decl_isLiteral (decl_node n); /* isConstSet - returns TRUE if, n, is a constant set. */ extern "C" unsigned int decl_isConstSet (decl_node n); /* isEnumerationField - returns TRUE if, n, is an enumeration field. */ extern "C" unsigned int decl_isEnumerationField (decl_node n); /* isEnumeration - returns TRUE if node, n, is an enumeration type. */ extern "C" unsigned int decl_isEnumeration (decl_node n); /* isUnbounded - returns TRUE if, n, is an unbounded array. */ extern "C" unsigned int decl_isUnbounded (decl_node n); /* isParameter - returns TRUE if, n, is a parameter. */ extern "C" unsigned int decl_isParameter (decl_node n); /* isVarParam - returns TRUE if, n, is a var parameter. */ extern "C" unsigned int decl_isVarParam (decl_node n); /* isParam - returns TRUE if, n, is a non var parameter. */ extern "C" unsigned int decl_isParam (decl_node n); /* isNonVarParam - is an alias to isParam. */ extern "C" unsigned int decl_isNonVarParam (decl_node n); /* addOptParameter - returns an optarg which has been created and added to procedure node, proc. It has a name, id, and, type, and an initial value, init. */ extern "C" decl_node decl_addOptParameter (decl_node proc, nameKey_Name id, decl_node type, decl_node init); /* isOptarg - returns TRUE if, n, is an optarg. */ extern "C" unsigned int decl_isOptarg (decl_node n); /* isRecord - returns TRUE if, n, is a record. */ extern "C" unsigned int decl_isRecord (decl_node n); /* isRecordField - returns TRUE if, n, is a record field. */ extern "C" unsigned int decl_isRecordField (decl_node n); /* isVarientField - returns TRUE if, n, is a varient field. */ extern "C" unsigned int decl_isVarientField (decl_node n); /* isArray - returns TRUE if, n, is an array. */ extern "C" unsigned int decl_isArray (decl_node n); /* isProcType - returns TRUE if, n, is a procedure type. */ extern "C" unsigned int decl_isProcType (decl_node n); /* isPointer - returns TRUE if, n, is a pointer. */ extern "C" unsigned int decl_isPointer (decl_node n); /* isProcedure - returns TRUE if, n, is a procedure. */ extern "C" unsigned int decl_isProcedure (decl_node n); /* isVarient - returns TRUE if, n, is a varient record. */ extern "C" unsigned int decl_isVarient (decl_node n); /* isSet - returns TRUE if, n, is a set type. */ extern "C" unsigned int decl_isSet (decl_node n); /* isSubrange - returns TRUE if, n, is a subrange type. */ extern "C" unsigned int decl_isSubrange (decl_node n); /* isZtype - returns TRUE if, n, is the Z type. */ extern "C" unsigned int decl_isZtype (decl_node n); /* isRtype - returns TRUE if, n, is the R type. */ extern "C" unsigned int decl_isRtype (decl_node n); /* makeConst - create, initialise and return a const node. */ extern "C" decl_node decl_makeConst (nameKey_Name n); /* putConst - places value, v, into node, n. */ extern "C" void decl_putConst (decl_node n, decl_node v); /* makeType - create, initialise and return a type node. */ extern "C" decl_node decl_makeType (nameKey_Name n); /* makeTypeImp - lookup a type in the definition module and return it. Otherwise create a new type. */ extern "C" decl_node decl_makeTypeImp (nameKey_Name n); /* makeVar - create, initialise and return a var node. */ extern "C" decl_node decl_makeVar (nameKey_Name n); /* putVar - places, type, as the type for var. */ extern "C" void decl_putVar (decl_node var, decl_node type, decl_node decl); /* makeVarDecl - create a vardecl node and create a shadow variable in the current scope. */ extern "C" decl_node decl_makeVarDecl (decl_node i, decl_node type); /* makeEnum - creates an enumerated type and returns the node. */ extern "C" decl_node decl_makeEnum (void); /* makeEnumField - returns an enumeration field, named, n. */ extern "C" decl_node decl_makeEnumField (decl_node e, nameKey_Name n); /* makeSubrange - returns a subrange node, built from range: low..high. */ extern "C" decl_node decl_makeSubrange (decl_node low, decl_node high); /* putSubrangeType - assigns, type, to the subrange type, sub. */ extern "C" void decl_putSubrangeType (decl_node sub, decl_node type); /* makePointer - returns a pointer of, type, node. */ extern "C" decl_node decl_makePointer (decl_node type); /* makeSet - returns a set of, type, node. */ extern "C" decl_node decl_makeSet (decl_node type); /* makeArray - returns a node representing ARRAY subr OF type. */ extern "C" decl_node decl_makeArray (decl_node subr, decl_node type); /* putUnbounded - sets array, n, as unbounded. */ extern "C" void decl_putUnbounded (decl_node n); /* makeRecord - creates and returns a record node. */ extern "C" decl_node decl_makeRecord (void); /* makeVarient - creates a new symbol, a varient symbol for record or varient field symbol, r. */ extern "C" decl_node decl_makeVarient (decl_node r); /* addFieldsToRecord - adds fields, i, of type, t, into a record, r. It returns, r. */ extern "C" decl_node decl_addFieldsToRecord (decl_node r, decl_node v, decl_node i, decl_node t); /* buildVarientSelector - builds a field of name, tag, of, type onto: record or varient field, r. varient, v. */ extern "C" void decl_buildVarientSelector (decl_node r, decl_node v, nameKey_Name tag, decl_node type); /* buildVarientFieldRecord - builds a varient field into a varient symbol, v. The varient field is returned. */ extern "C" decl_node decl_buildVarientFieldRecord (decl_node v, decl_node p); /* getSymName - returns the name of symbol, n. */ extern "C" nameKey_Name decl_getSymName (decl_node n); /* import - attempts to add node, n, into the scope of module, m. It might fail due to a name clash in which case the previous named symbol is returned. On success, n, is returned. */ extern "C" decl_node decl_import (decl_node m, decl_node n); /* lookupExported - attempts to lookup a node named, i, from definition module, n. The node is returned if found. NIL is returned if not found. */ extern "C" decl_node decl_lookupExported (decl_node n, nameKey_Name i); /* lookupSym - returns the symbol named, n, from the scope stack. */ extern "C" decl_node decl_lookupSym (nameKey_Name n); /* addImportedModule - add module, i, to be imported by, m. If scoped then module, i, is added to the module, m, scope. */ extern "C" void decl_addImportedModule (decl_node m, decl_node i, unsigned int scoped); /* setSource - sets the source filename for module, n, to s. */ extern "C" void decl_setSource (decl_node n, nameKey_Name s); /* getSource - returns the source filename for module, n. */ extern "C" nameKey_Name decl_getSource (decl_node n); /* getMainModule - returns the main module node. */ extern "C" decl_node decl_getMainModule (void); /* getCurrentModule - returns the current module being compiled. */ extern "C" decl_node decl_getCurrentModule (void); /* foreachDefModuleDo - foreach definition node, n, in the module universe, call p (n). */ extern "C" void decl_foreachDefModuleDo (symbolKey_performOperation p); /* foreachModModuleDo - foreach implementation or module node, n, in the module universe, call p (n). */ extern "C" void decl_foreachModModuleDo (symbolKey_performOperation p); /* enterScope - pushes symbol, n, to the scope stack. */ extern "C" void decl_enterScope (decl_node n); /* leaveScope - removes the top level scope. */ extern "C" void decl_leaveScope (void); /* makeProcedure - create, initialise and return a procedure node. */ extern "C" decl_node decl_makeProcedure (nameKey_Name n); /* putCommentDefProcedure - remembers the procedure comment (if it exists) as a definition module procedure heading. NIL is placed if there is no procedure comment available. */ extern "C" void decl_putCommentDefProcedure (decl_node n); /* putCommentModProcedure - remembers the procedure comment (if it exists) as an implementation/program module procedure heading. NIL is placed if there is no procedure comment available. */ extern "C" void decl_putCommentModProcedure (decl_node n); /* makeProcType - returns a proctype node. */ extern "C" decl_node decl_makeProcType (void); /* putReturnType - sets the return type of procedure or proctype, proc, to, type. */ extern "C" void decl_putReturnType (decl_node proc, decl_node type); /* putOptReturn - sets, proctype or procedure, proc, to have an optional return type. */ extern "C" void decl_putOptReturn (decl_node proc); /* makeVarParameter - returns a var parameter node with, name: type. */ extern "C" decl_node decl_makeVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused); /* makeNonVarParameter - returns a non var parameter node with, name: type. */ extern "C" decl_node decl_makeNonVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused); /* paramEnter - reset the parameter count. */ extern "C" void decl_paramEnter (decl_node n); /* paramLeave - set paramater checking to TRUE from now onwards. */ extern "C" void decl_paramLeave (decl_node n); /* makeIdentList - returns a node which will be used to maintain an ident list. */ extern "C" decl_node decl_makeIdentList (void); /* putIdent - places ident, i, into identlist, n. It returns TRUE if ident, i, is unique. */ extern "C" unsigned int decl_putIdent (decl_node n, nameKey_Name i); /* addVarParameters - adds the identlist, i, of, type, to be VAR parameters in procedure, n. */ extern "C" void decl_addVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused); /* addNonVarParameters - adds the identlist, i, of, type, to be parameters in procedure, n. */ extern "C" void decl_addNonVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused); /* makeVarargs - returns a varargs node. */ extern "C" decl_node decl_makeVarargs (void); /* isVarargs - returns TRUE if, n, is a varargs node. */ extern "C" unsigned int decl_isVarargs (decl_node n); /* addParameter - adds a parameter, param, to procedure or proctype, proc. */ extern "C" void decl_addParameter (decl_node proc, decl_node param); /* makeBinaryTok - creates and returns a boolean type node with, l, and, r, nodes. */ extern "C" decl_node decl_makeBinaryTok (mcReserved_toktype op, decl_node l, decl_node r); /* makeUnaryTok - creates and returns a boolean type node with, e, node. */ extern "C" decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e); /* makeComponentRef - build a componentref node which accesses, field, within, record, rec. */ extern "C" decl_node decl_makeComponentRef (decl_node rec, decl_node field); /* makePointerRef - build a pointerref node which accesses, field, within, pointer to record, ptr. */ extern "C" decl_node decl_makePointerRef (decl_node ptr, decl_node field); /* isPointerRef - returns TRUE if, n, is a pointerref node. */ extern "C" unsigned int decl_isPointerRef (decl_node n); /* makeDeRef - dereferences the pointer defined by, n. */ extern "C" decl_node decl_makeDeRef (decl_node n); /* makeArrayRef - build an arrayref node which access element, index, in, array. array is a variable/expression/constant which has a type array. */ extern "C" decl_node decl_makeArrayRef (decl_node array, decl_node index); /* getLastOp - return the right most non leaf node. */ extern "C" decl_node decl_getLastOp (decl_node n); /* getCardinal - returns the cardinal type node. */ extern "C" decl_node decl_getCardinal (void); /* makeLiteralInt - creates and returns a literal node based on an integer type. */ extern "C" decl_node decl_makeLiteralInt (nameKey_Name n); /* makeLiteralReal - creates and returns a literal node based on a real type. */ extern "C" decl_node decl_makeLiteralReal (nameKey_Name n); /* makeString - creates and returns a node containing string, n. */ extern "C" decl_node decl_makeString (nameKey_Name n); /* makeSetValue - creates and returns a setvalue node. */ extern "C" decl_node decl_makeSetValue (void); /* isSetValue - returns TRUE if, n, is a setvalue node. */ extern "C" unsigned int decl_isSetValue (decl_node n); /* putSetValue - assigns the type, t, to the set value, n. The node, n, is returned. */ extern "C" decl_node decl_putSetValue (decl_node n, decl_node t); /* includeSetValue - includes the range l..h into the setvalue. h might be NIL indicating that a single element is to be included into the set. n is returned. */ extern "C" decl_node decl_includeSetValue (decl_node n, decl_node l, decl_node h); /* getBuiltinConst - creates and returns a builtin const if available. */ extern "C" decl_node decl_getBuiltinConst (nameKey_Name n); /* makeExpList - creates and returns an expList node. */ extern "C" decl_node decl_makeExpList (void); /* isExpList - returns TRUE if, n, is an explist node. */ extern "C" unsigned int decl_isExpList (decl_node n); /* putExpList - places, expression, e, within the explist, n. */ extern "C" void decl_putExpList (decl_node n, decl_node e); /* makeConstExp - returns a constexp node. */ extern "C" decl_node decl_makeConstExp (void); /* getNextConstExp - returns the next constexp node. */ extern "C" decl_node decl_getNextConstExp (void); /* setConstExpComplete - sets the field inside the def or imp or module, n. */ extern "C" void decl_setConstExpComplete (decl_node n); /* fixupConstExp - assign fixup expression, e, into the argument of, c. */ extern "C" decl_node decl_fixupConstExp (decl_node c, decl_node e); /* resetConstExpPos - resets the index into the saved list of constexps inside module, n. */ extern "C" void decl_resetConstExpPos (decl_node n); /* makeFuncCall - builds a function call to c with param list, n. */ extern "C" decl_node decl_makeFuncCall (decl_node c, decl_node n); /* makeStatementSequence - create and return a statement sequence node. */ extern "C" decl_node decl_makeStatementSequence (void); /* isStatementSequence - returns TRUE if node, n, is a statement sequence. */ extern "C" unsigned int decl_isStatementSequence (decl_node n); /* addStatement - adds node, n, as a statement to statememt sequence, s. */ extern "C" void decl_addStatement (decl_node s, decl_node n); /* addCommentBody - adds a body comment to a statement sequence node. */ extern "C" void decl_addCommentBody (decl_node n); /* addCommentAfter - adds an after comment to a statement sequence node. */ extern "C" void decl_addCommentAfter (decl_node n); /* addIfComments - adds the, body, and, after, comments to if node, n. */ extern "C" void decl_addIfComments (decl_node n, decl_node body, decl_node after); /* addElseComments - adds the, body, and, after, comments to an, if, or an elsif, node, n. */ extern "C" void decl_addElseComments (decl_node n, decl_node body, decl_node after); /* addIfEndComments - adds the, body, and, after, comments to an, if, node, n. */ extern "C" void decl_addIfEndComments (decl_node n, decl_node body, decl_node after); /* makeReturn - creates and returns a return node. */ extern "C" decl_node decl_makeReturn (void); /* isReturn - returns TRUE if node, n, is a return. */ extern "C" unsigned int decl_isReturn (decl_node n); /* putReturn - assigns node, e, as the expression on the return node. */ extern "C" void decl_putReturn (decl_node n, decl_node e); /* makeWhile - creates and returns a while node. */ extern "C" decl_node decl_makeWhile (void); /* putWhile - places an expression, e, and statement sequence, s, into the while node, n. */ extern "C" void decl_putWhile (decl_node n, decl_node e, decl_node s); /* isWhile - returns TRUE if node, n, is a while. */ extern "C" unsigned int decl_isWhile (decl_node n); /* addWhileDoComment - adds body and after comments to while node, w. */ extern "C" void decl_addWhileDoComment (decl_node w, decl_node body, decl_node after); /* addWhileEndComment - adds body and after comments to the end of a while node, w. */ extern "C" void decl_addWhileEndComment (decl_node w, decl_node body, decl_node after); /* makeAssignment - creates and returns an assignment node. The designator is, d, and expression, e. */ extern "C" decl_node decl_makeAssignment (decl_node d, decl_node e); /* putBegin - assigns statements, s, to be the normal part in block, b. The block may be a procedure or module, or implementation node. */ extern "C" void decl_putBegin (decl_node b, decl_node s); /* putFinally - assigns statements, s, to be the final part in block, b. The block may be a module or implementation node. */ extern "C" void decl_putFinally (decl_node b, decl_node s); /* makeExit - creates and returns an exit node. */ extern "C" decl_node decl_makeExit (decl_node l, unsigned int n); /* isExit - returns TRUE if node, n, is an exit. */ extern "C" unsigned int decl_isExit (decl_node n); /* makeLoop - creates and returns a loop node. */ extern "C" decl_node decl_makeLoop (void); /* isLoop - returns TRUE if, n, is a loop node. */ extern "C" unsigned int decl_isLoop (decl_node n); /* putLoop - places statement sequence, s, into loop, l. */ extern "C" void decl_putLoop (decl_node l, decl_node s); /* makeComment - creates and returns a comment node. */ extern "C" decl_node decl_makeComment (const char *a_, unsigned int _a_high); /* makeCommentS - creates and returns a comment node. */ extern "C" decl_node decl_makeCommentS (mcComment_commentDesc c); /* makeIf - creates and returns an if node. The if node will have expression, e, and statement sequence, s, as the then component. */ extern "C" decl_node decl_makeIf (decl_node e, decl_node s); /* isIf - returns TRUE if, n, is an if node. */ extern "C" unsigned int decl_isIf (decl_node n); /* makeElsif - creates and returns an elsif node. This node has an expression, e, and statement sequence, s. */ extern "C" decl_node decl_makeElsif (decl_node i, decl_node e, decl_node s); /* isElsif - returns TRUE if node, n, is an elsif node. */ extern "C" unsigned int decl_isElsif (decl_node n); /* putElse - the else is grafted onto the if/elsif node, i, and the statement sequence will be, s. */ extern "C" void decl_putElse (decl_node i, decl_node s); /* makeFor - creates and returns a for node. */ extern "C" decl_node decl_makeFor (void); /* isFor - returns TRUE if node, n, is a for node. */ extern "C" unsigned int decl_isFor (decl_node n); /* putFor - assigns the fields of the for node with ident, i, start, s, end, e, increment, i, statements, sq. */ extern "C" void decl_putFor (decl_node f, decl_node i, decl_node s, decl_node e, decl_node b, decl_node sq); /* makeRepeat - creates and returns a repeat node. */ extern "C" decl_node decl_makeRepeat (void); /* isRepeat - returns TRUE if node, n, is a repeat node. */ extern "C" unsigned int decl_isRepeat (decl_node n); /* putRepeat - places statements, s, and expression, e, into repeat statement, n. */ extern "C" void decl_putRepeat (decl_node n, decl_node s, decl_node e); /* addRepeatComment - adds body and after comments to repeat node, r. */ extern "C" void decl_addRepeatComment (decl_node r, decl_node body, decl_node after); /* addUntilComment - adds body and after comments to the until section of a repeat node, r. */ extern "C" void decl_addUntilComment (decl_node r, decl_node body, decl_node after); /* makeCase - builds and returns a case statement node. */ extern "C" decl_node decl_makeCase (void); /* isCase - returns TRUE if node, n, is a case statement. */ extern "C" unsigned int decl_isCase (decl_node n); /* putCaseExpression - places expression, e, into case statement, n. n is returned. */ extern "C" decl_node decl_putCaseExpression (decl_node n, decl_node e); /* putCaseElse - places else statement, e, into case statement, n. n is returned. */ extern "C" decl_node decl_putCaseElse (decl_node n, decl_node e); /* putCaseStatement - places a caselist, l, and associated statement sequence, s, into case statement, n. n is returned. */ extern "C" decl_node decl_putCaseStatement (decl_node n, decl_node l, decl_node s); /* makeCaseLabelList - creates and returns a caselabellist node. */ extern "C" decl_node decl_makeCaseLabelList (decl_node l, decl_node s); /* isCaseLabelList - returns TRUE if, n, is a caselabellist. */ extern "C" unsigned int decl_isCaseLabelList (decl_node n); /* makeCaseList - creates and returns a case statement node. */ extern "C" decl_node decl_makeCaseList (void); /* isCaseList - returns TRUE if, n, is a case list. */ extern "C" unsigned int decl_isCaseList (decl_node n); /* putCaseRange - places the case range lo..hi into caselist, n. */ extern "C" decl_node decl_putCaseRange (decl_node n, decl_node lo, decl_node hi); /* makeRange - creates and returns a case range. */ extern "C" decl_node decl_makeRange (decl_node lo, decl_node hi); /* isRange - returns TRUE if node, n, is a range. */ extern "C" unsigned int decl_isRange (decl_node n); /* setNoReturn - sets noreturn field inside procedure. */ extern "C" void decl_setNoReturn (decl_node n, unsigned int value); /* dupExpr - duplicate the expression nodes, it does not duplicate variables, literals, constants but only the expression operators (including function calls and parameter lists). */ extern "C" decl_node decl_dupExpr (decl_node n); /* setLangC - */ extern "C" void decl_setLangC (void); /* setLangCP - */ extern "C" void decl_setLangCP (void); /* setLangM2 - */ extern "C" void decl_setLangM2 (void); /* out - walks the tree of node declarations for the main module and writes the output to the outputFile specified in mcOptions. It outputs the declarations in the language specified above. */ extern "C" void decl_out (void); extern "C" nameKey_Name nameKey_makeKey (const char *a_, unsigned int _a_high); extern "C" nameKey_Name nameKey_makekey (void * a); extern "C" void nameKey_getKey (nameKey_Name key, char *a, unsigned int _a_high); extern "C" unsigned int nameKey_lengthKey (nameKey_Name key); extern "C" unsigned int nameKey_isKey (const char *a_, unsigned int _a_high); extern "C" void nameKey_writeKey (nameKey_Name key); extern "C" unsigned int nameKey_isSameExcludingCase (nameKey_Name key1, nameKey_Name key2); extern "C" void * nameKey_keyToCharStar (nameKey_Name key); extern "C" symbolKey_symbolTree symbolKey_initTree (void); extern "C" void symbolKey_killTree (symbolKey_symbolTree *t); extern "C" void * symbolKey_getSymKey (symbolKey_symbolTree t, nameKey_Name name); extern "C" void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name, void * key); /* delSymKey - deletes an entry in the binary tree. NB in order for this to work we must ensure that the InitTree sets both left and right to NIL. */ extern "C" void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name); /* isEmptyTree - returns true if symbolTree, t, is empty. */ extern "C" unsigned int symbolKey_isEmptyTree (symbolKey_symbolTree t); /* doesTreeContainAny - returns true if symbolTree, t, contains any symbols which in turn return true when procedure, p, is called with a symbol as its parameter. The symbolTree root is empty apart from the field, left, hence we need two procedures. */ extern "C" unsigned int symbolKey_doesTreeContainAny (symbolKey_symbolTree t, symbolKey_isSymbol p); /* foreachNodeDo - for each node in symbolTree, t, a procedure, p, is called with the node symbol as its parameter. The tree root node only contains a legal left pointer, therefore we need two procedures to examine this tree. */ extern "C" void symbolKey_foreachNodeDo (symbolKey_symbolTree t, symbolKey_performOperation p); /* initComment - the start of a new comment has been seen by the lexical analyser. A new comment block is created and all addText contents are placed in this block. onlySpaces indicates whether we have only seen spaces on this line. */ extern "C" mcComment_commentDesc mcComment_initComment (unsigned int onlySpaces); /* addText - cs is a C string (null terminated) which contains comment text. This is appended to the comment, cd. */ extern "C" void mcComment_addText (mcComment_commentDesc cd, void * cs); /* getContent - returns the content of comment, cd. */ extern "C" DynamicStrings_String mcComment_getContent (mcComment_commentDesc cd); /* getCommentCharStar - returns the C string content of comment, cd. */ extern "C" void * mcComment_getCommentCharStar (mcComment_commentDesc cd); /* setProcedureComment - changes the type of comment, cd, to a procedure heading comment, providing it has the procname as the first word. */ extern "C" void mcComment_setProcedureComment (mcComment_commentDesc cd, nameKey_Name procname); /* getProcedureComment - returns the current procedure comment if available. */ extern "C" DynamicStrings_String mcComment_getProcedureComment (mcComment_commentDesc cd); /* getAfterStatementComment - returns the current statement after comment if available. */ extern "C" DynamicStrings_String mcComment_getAfterStatementComment (mcComment_commentDesc cd); /* getInbodyStatementComment - returns the current statement after comment if available. */ extern "C" DynamicStrings_String mcComment_getInbodyStatementComment (mcComment_commentDesc cd); /* isProcedureComment - returns TRUE if, cd, is a procedure comment. */ extern "C" unsigned int mcComment_isProcedureComment (mcComment_commentDesc cd); /* isBodyComment - returns TRUE if, cd, is a body comment. */ extern "C" unsigned int mcComment_isBodyComment (mcComment_commentDesc cd); /* isAfterComment - returns TRUE if, cd, is an after comment. */ extern "C" unsigned int mcComment_isAfterComment (mcComment_commentDesc cd); extern "C" void mcDebug_assert (unsigned int q); extern "C" void mcDebug_writeDebug (const char *a_, unsigned int _a_high); extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size); extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size); extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size); extern "C" unsigned int Storage_Available (unsigned int Size); extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname); extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname); extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname); extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile); extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s); extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file); extern "C" unsigned int FIO_IsNoError (FIO_File f); extern "C" unsigned int FIO_IsActive (FIO_File f); extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high); extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high); extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high); extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile); extern "C" void FIO_Close (FIO_File f); extern "C" unsigned int FIO_exists (void * fname, unsigned int flength); extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength); extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength); extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile); extern "C" void FIO_FlushBuffer (FIO_File f); extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest); extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high); extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src); extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high); extern "C" void FIO_WriteChar (FIO_File f, char ch); extern "C" unsigned int FIO_EOF (FIO_File f); extern "C" unsigned int FIO_EOLN (FIO_File f); extern "C" unsigned int FIO_WasEOLN (FIO_File f); extern "C" char FIO_ReadChar (FIO_File f); extern "C" void FIO_UnReadChar (FIO_File f, char ch); extern "C" void FIO_WriteLine (FIO_File f); extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high); extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high); extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c); extern "C" unsigned int FIO_ReadCardinal (FIO_File f); extern "C" int FIO_GetUnixFileDescriptor (FIO_File f); extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos); extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos); extern "C" long int FIO_FindPosition (FIO_File f); extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high); extern "C" void * FIO_getFileName (FIO_File f); extern "C" unsigned int FIO_getFileNameLength (FIO_File f); extern "C" void FIO_FlushOutErr (void); /* InitString - creates and returns a String type object. Initial contents are, a. */ extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high); /* KillString - frees String, s, and its contents. NIL is returned. */ extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s); /* Fin - finishes with a string, it calls KillString with, s. The purpose of the procedure is to provide a short cut to calling KillString and then testing the return result. */ extern "C" void DynamicStrings_Fin (DynamicStrings_String s); /* InitStringCharStar - initializes and returns a String to contain the C string. */ extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a); /* InitStringChar - initializes and returns a String to contain the single character, ch. */ extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch); /* Mark - marks String, s, ready for garbage collection. */ extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s); /* Length - returns the length of the String, s. */ extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s); /* ConCat - returns String, a, after the contents of, b, have been appended. */ extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b); /* ConCatChar - returns String, a, after character, ch, has been appended. */ extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch); /* Assign - assigns the contents of, b, into, a. String, a, is returned. */ extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b); /* Dup - duplicate a String, s, returning the copy of s. */ extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s); /* Add - returns a new String which contains the contents of a and b. */ extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b); /* Equal - returns TRUE if String, a, and, b, are equal. */ extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b); /* EqualCharStar - returns TRUE if contents of String, s, is the same as the string, a. */ extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a); /* EqualArray - returns TRUE if contents of String, s, is the same as the string, a. */ extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high); /* Mult - returns a new string which is n concatenations of String, s. */ extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n); /* Slice - returns a new string which contains the elements low..high-1 strings start at element 0 Slice(s, 0, 2) will return elements 0, 1 but not 2 Slice(s, 1, 3) will return elements 1, 2 but not 3 Slice(s, 2, 0) will return elements 2..max Slice(s, 3, -1) will return elements 3..max-1 Slice(s, 4, -2) will return elements 4..max-2 */ extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high); /* Index - returns the indice of the first occurance of, ch, in String, s. -1 is returned if, ch, does not exist. The search starts at position, o. */ extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o); /* RIndex - returns the indice of the last occurance of, ch, in String, s. The search starts at position, o. -1 is returned if, ch, is not found. */ extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o); /* RemoveComment - assuming that, comment, is a comment delimiter which indicates anything to its right is a comment then strip off the comment and also any white space on the remaining right hand side. It leaves any white space on the left hand side alone. */ extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment); /* RemoveWhitePrefix - removes any leading white space from String, s. A new string is returned. */ extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s); /* RemoveWhitePostfix - removes any leading white space from String, s. A new string is returned. */ extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s); /* ToUpper - returns string, s, after it has had its lower case characters replaced by upper case characters. The string, s, is not duplicated. */ extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s); /* ToLower - returns string, s, after it has had its upper case characters replaced by lower case characters. The string, s, is not duplicated. */ extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s); /* CopyOut - copies string, s, to a. */ extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s); /* char - returns the character, ch, at position, i, in String, s. */ extern "C" char DynamicStrings_char (DynamicStrings_String s, int i); /* string - returns the C style char * of String, s. */ extern "C" void * DynamicStrings_string (DynamicStrings_String s); /* InitStringDB - the debug version of InitString. */ extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line); /* InitStringCharStarDB - the debug version of InitStringCharStar. */ extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line); /* InitStringCharDB - the debug version of InitStringChar. */ extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line); /* MultDB - the debug version of MultDB. */ extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line); /* DupDB - the debug version of Dup. */ extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line); /* SliceDB - debug version of Slice. */ extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line); /* PushAllocation - pushes the current allocation/deallocation lists. */ extern "C" void DynamicStrings_PushAllocation (void); /* PopAllocation - test to see that all strings are deallocated since the last push. Then it pops to the previous allocation/deallocation lists. If halt is true then the application terminates with an exit code of 1. */ extern "C" void DynamicStrings_PopAllocation (unsigned int halt); /* PopAllocationExemption - test to see that all strings are deallocated, except string, e, since the last push. Then it pops to the previous allocation/deallocation lists. If halt is true then the application terminates with an exit code of 1. */ extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e); extern "C" DynamicStrings_String StringConvert_IntegerToString (int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower); extern "C" DynamicStrings_String StringConvert_CardinalToString (unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower); extern "C" int StringConvert_StringToInteger (DynamicStrings_String s, unsigned int base, unsigned int *found); extern "C" unsigned int StringConvert_StringToCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found); extern "C" DynamicStrings_String StringConvert_LongIntegerToString (long int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower); extern "C" long int StringConvert_StringToLongInteger (DynamicStrings_String s, unsigned int base, unsigned int *found); extern "C" DynamicStrings_String StringConvert_LongCardinalToString (long unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower); extern "C" long unsigned int StringConvert_StringToLongCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found); extern "C" DynamicStrings_String StringConvert_ShortCardinalToString (short unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower); extern "C" short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found); extern "C" int StringConvert_stoi (DynamicStrings_String s); extern "C" DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, unsigned int sign); extern "C" DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding); extern "C" unsigned int StringConvert_stoc (DynamicStrings_String s); extern "C" int StringConvert_hstoi (DynamicStrings_String s); extern "C" int StringConvert_ostoi (DynamicStrings_String s); extern "C" int StringConvert_bstoi (DynamicStrings_String s); extern "C" unsigned int StringConvert_hstoc (DynamicStrings_String s); extern "C" unsigned int StringConvert_ostoc (DynamicStrings_String s); extern "C" unsigned int StringConvert_bstoc (DynamicStrings_String s); extern "C" long double StringConvert_StringToLongreal (DynamicStrings_String s, unsigned int *found); extern "C" DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth); extern "C" double StringConvert_stor (DynamicStrings_String s); extern "C" long double StringConvert_stolr (DynamicStrings_String s); extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s, unsigned int n); extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n); extern "C" DynamicStrings_String mcOptions_handleOptions (void); extern "C" unsigned int mcOptions_getQuiet (void); extern "C" unsigned int mcOptions_getVerbose (void); extern "C" unsigned int mcOptions_getInternalDebugging (void); extern "C" DynamicStrings_String mcOptions_getCppCommandLine (void); extern "C" DynamicStrings_String mcOptions_getOutputFile (void); extern "C" unsigned int mcOptions_getExtendedOpaque (void); extern "C" void mcOptions_setDebugTopological (unsigned int value); extern "C" unsigned int mcOptions_getDebugTopological (void); extern "C" DynamicStrings_String mcOptions_getHPrefix (void); extern "C" unsigned int mcOptions_getIgnoreFQ (void); extern "C" unsigned int mcOptions_getGccConfigSystem (void); extern "C" unsigned int mcOptions_getScaffoldDynamic (void); extern "C" unsigned int mcOptions_getScaffoldMain (void); extern "C" void mcOptions_writeGPLheader (FIO_File f); extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt); extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high); 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); 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); 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); extern "C" DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s); extern "C" ssize_t libc_write (int d, void * buf, size_t nbytes); extern "C" ssize_t libc_read (int d, void * buf, size_t nbytes); extern "C" int libc_system (void * a); extern "C" void libc_abort (void) __attribute__ ((noreturn)); extern "C" void * libc_malloc (size_t size); extern "C" void libc_free (void * ptr); extern "C" void * libc_realloc (void * ptr, size_t size); extern "C" int libc_isatty (int fd); extern "C" void libc_exit (int r) __attribute__ ((noreturn)); extern "C" void * libc_getenv (void * s); extern "C" int libc_putenv (void * s); extern "C" int libc_getpid (void); extern "C" int libc_dup (int d); extern "C" int libc_close (int d); extern "C" int libc_open (void * filename, int oflag, ...); extern "C" int libc_creat (void * filename, unsigned int mode); extern "C" long int libc_lseek (int fd, long int offset, int whence); extern "C" void libc_perror (const char *string_, unsigned int _string_high); extern "C" int libc_readv (int fd, void * v, int n); extern "C" int libc_writev (int fd, void * v, int n); extern "C" void * libc_getcwd (void * buf, size_t size); extern "C" int libc_chown (void * filename, int uid, int gid); extern "C" size_t libc_strlen (void * a); extern "C" void * libc_strcpy (void * dest, void * src); extern "C" void * libc_strncpy (void * dest, void * src, unsigned int n); extern "C" int libc_unlink (void * file); extern "C" void * libc_memcpy (void * dest, void * src, size_t size); extern "C" void * libc_memset (void * s, int c, size_t size); extern "C" void * libc_memmove (void * dest, void * src, size_t size); extern "C" int libc_printf (const char *format_, unsigned int _format_high, ...); extern "C" int libc_snprintf (void * dest, size_t size, const char *format_, unsigned int _format_high, ...); extern "C" int libc_setenv (void * name, void * value, int overwrite); extern "C" void libc_srand (int seed); extern "C" int libc_rand (void); extern "C" libc_time_t libc_time (void * a); extern "C" void * libc_localtime (libc_time_t *t); extern "C" int libc_ftime (libc_timeb *t); extern "C" int libc_shutdown (int s, int how); extern "C" int libc_rename (void * oldpath, void * newpath); extern "C" int libc_setjmp (void * env); extern "C" void libc_longjmp (void * env, int val); extern "C" int libc_atexit (libc_exitP_C proc); extern "C" void * libc_ttyname (int filedes); extern "C" unsigned int libc_sleep (unsigned int seconds); extern "C" int libc_execv (void * pathname, void * argv); extern "C" void mcMetaError_metaError1 (const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high); 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); 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); 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); 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); 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); 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); 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); extern "C" void mcMetaError_metaErrorT1 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high); 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); 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); 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); 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); 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); 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); 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); extern "C" void mcMetaError_metaErrorString1 (DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high); extern "C" void mcMetaError_metaErrorString2 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); 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); 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); extern "C" void mcMetaError_metaErrorStringT1 (unsigned int tok, DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high); 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); 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); 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); /* internalError - displays an internal error message together with the compiler source file and line number. This function is not buffered and is used when the compiler is about to give up. */ extern "C" void mcError_internalError (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line); /* writeFormat0 - displays the source module and line together with the encapsulated format string. Used for simple error messages tied to the current token. */ extern "C" void mcError_writeFormat0 (const char *a_, unsigned int _a_high); /* writeFormat1 - displays the source module and line together with the encapsulated format string. Used for simple error messages tied to the current token. */ extern "C" void mcError_writeFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); /* writeFormat2 - displays the module and line together with the encapsulated format strings. Used for simple error messages tied to the current token. */ 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); /* writeFormat3 - displays the module and line together with the encapsulated format strings. Used for simple error messages tied to the current token. */ 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); /* newError - creates and returns a new error handle. */ extern "C" mcError_error mcError_newError (unsigned int atTokenNo); /* newWarning - creates and returns a new error handle suitable for a warning. A warning will not stop compilation. */ extern "C" mcError_error mcError_newWarning (unsigned int atTokenNo); /* chainError - creates and returns a new error handle, this new error is associated with, e, and is chained onto the end of, e. If, e, is NIL then the result to NewError is returned. */ extern "C" mcError_error mcError_chainError (unsigned int atTokenNo, mcError_error e); extern "C" void mcError_errorFormat0 (mcError_error e, const char *a_, unsigned int _a_high); extern "C" void mcError_errorFormat1 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); 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); 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); extern "C" void mcError_errorString (mcError_error e, DynamicStrings_String str); /* errorStringAt - given an error string, s, it places this string at token position, tok. The string is consumed. */ extern "C" void mcError_errorStringAt (DynamicStrings_String s, unsigned int tok); /* errorStringAt2 - given an error string, s, it places this string at token positions, tok1 and tok2, respectively. The string is consumed. */ extern "C" void mcError_errorStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2); /* errorStringsAt2 - given error strings, s1, and, s2, it places these strings at token positions, tok1 and tok2, respectively. Both strings are consumed. */ extern "C" void mcError_errorStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2); /* warnStringAt - given an error string, s, it places this string at token position, tok. The string is consumed. */ extern "C" void mcError_warnStringAt (DynamicStrings_String s, unsigned int tok); /* warnStringAt2 - given an warning string, s, it places this string at token positions, tok1 and tok2, respectively. The string is consumed. */ extern "C" void mcError_warnStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2); /* warnStringsAt2 - given warning strings, s1, and, s2, it places these strings at token positions, tok1 and tok2, respectively. Both strings are consumed. */ extern "C" void mcError_warnStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2); extern "C" void mcError_warnFormat0 (const char *a_, unsigned int _a_high); /* warnFormat1 - displays the source module and line together with the encapsulated format string. Used for simple warning messages tied to the current token. */ extern "C" void mcError_warnFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); /* flushErrors - switches the output channel to the error channel and then writes out all errors. */ extern "C" void mcError_flushErrors (void); /* flushWarnings - switches the output channel to the error channel and then writes out all warnings. If an error is present the compilation is terminated, if warnings only were emitted then compilation will continue. */ extern "C" void mcError_flushWarnings (void); /* errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting. */ extern "C" void mcError_errorAbort0 (const char *a_, unsigned int _a_high); extern "C" mcComment_commentDesc mcLexBuf_getProcedureComment (void); extern "C" mcComment_commentDesc mcLexBuf_getBodyComment (void); extern "C" mcComment_commentDesc mcLexBuf_getAfterComment (void); extern "C" unsigned int mcLexBuf_openSource (DynamicStrings_String s); extern "C" void mcLexBuf_closeSource (void); extern "C" void mcLexBuf_reInitialize (void); extern "C" void mcLexBuf_resetForNewPass (void); extern "C" void mcLexBuf_getToken (void); extern "C" void mcLexBuf_insertToken (mcReserved_toktype token); extern "C" void mcLexBuf_insertTokenAndRewind (mcReserved_toktype token); extern "C" unsigned int mcLexBuf_getPreviousTokenLineNo (void); extern "C" unsigned int mcLexBuf_getLineNo (void); extern "C" unsigned int mcLexBuf_getTokenNo (void); extern "C" unsigned int mcLexBuf_tokenToLineNo (unsigned int tokenNo, unsigned int depth); extern "C" unsigned int mcLexBuf_getColumnNo (void); extern "C" unsigned int mcLexBuf_tokenToColumnNo (unsigned int tokenNo, unsigned int depth); extern "C" DynamicStrings_String mcLexBuf_findFileNameFromToken (unsigned int tokenNo, unsigned int depth); extern "C" DynamicStrings_String mcLexBuf_getFileName (void); extern "C" void mcLexBuf_addTok (mcReserved_toktype t); extern "C" void mcLexBuf_addTokCharStar (mcReserved_toktype t, void * s); extern "C" void mcLexBuf_addTokInteger (mcReserved_toktype t, int i); extern "C" void mcLexBuf_addTokComment (mcReserved_toktype t, mcComment_commentDesc com); extern "C" void mcLexBuf_setFile (void * filename); extern "C" void mcLexBuf_pushFile (void * filename); extern "C" void mcLexBuf_popFile (void * filename); 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); extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high); extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high); extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high); /* initPretty - initialise a pretty print data structure. */ extern "C" mcPretty_pretty mcPretty_initPretty (mcPretty_writeProc w, mcPretty_writeLnProc l); /* dupPretty - duplicate a pretty print data structure. */ extern "C" mcPretty_pretty mcPretty_dupPretty (mcPretty_pretty p); /* killPretty - destroy a pretty print data structure. Post condition: p is assigned to NIL. */ extern "C" void mcPretty_killPretty (mcPretty_pretty *p); /* pushPretty - duplicate, p. Push, p, and return the duplicate. */ extern "C" mcPretty_pretty mcPretty_pushPretty (mcPretty_pretty p); /* popPretty - pops the pretty object from the stack. */ extern "C" mcPretty_pretty mcPretty_popPretty (mcPretty_pretty p); /* getindent - returns the current indent value. */ extern "C" unsigned int mcPretty_getindent (mcPretty_pretty p); /* setindent - sets the current indent to, n. */ extern "C" void mcPretty_setindent (mcPretty_pretty p, unsigned int n); /* getcurpos - returns the current cursor position. */ extern "C" unsigned int mcPretty_getcurpos (mcPretty_pretty s); /* getseekpos - returns the seek position. */ extern "C" unsigned int mcPretty_getseekpos (mcPretty_pretty s); /* getcurline - returns the current line number. */ extern "C" unsigned int mcPretty_getcurline (mcPretty_pretty s); extern "C" void mcPretty_setNeedSpace (mcPretty_pretty s); /* noSpace - unset needsSpace. */ extern "C" void mcPretty_noSpace (mcPretty_pretty s); /* print - print a string using, p. */ extern "C" void mcPretty_print (mcPretty_pretty p, const char *a_, unsigned int _a_high); /* prints - print a string using, p. */ extern "C" void mcPretty_prints (mcPretty_pretty p, DynamicStrings_String s); /* raw - print out string, s, without any translation of escape sequences. */ extern "C" void mcPretty_raw (mcPretty_pretty p, DynamicStrings_String s); /* InitIndex - creates and returns an Index. */ extern "C" Indexing_Index Indexing_InitIndex (unsigned int low); /* KillIndex - returns Index to free storage. */ extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i); /* DebugIndex - turns on debugging within an index. */ extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i); /* InBounds - returns TRUE if indice, n, is within the bounds of the dynamic array. */ extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n); /* HighIndice - returns the last legally accessible indice of this array. */ extern "C" unsigned int Indexing_HighIndice (Indexing_Index i); /* LowIndice - returns the first legally accessible indice of this array. */ extern "C" unsigned int Indexing_LowIndice (Indexing_Index i); /* PutIndice - places, a, into the dynamic array at position i[n] */ extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a); /* GetIndice - retrieves, element i[n] from the dynamic array. */ extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n); /* IsIndiceInIndex - returns TRUE if, a, is in the index, i. */ extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a); /* RemoveIndiceFromIndex - removes, a, from Index, i. */ extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a); /* DeleteIndice - delete i[j] from the array. */ extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j); /* IncludeIndiceIntoIndex - if the indice is not in the index, then add it at the end. */ extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a); /* ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j]) */ extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p); /* initList - creates a new alist, l. */ extern "C" alists_alist alists_initList (void); /* killList - deletes the complete alist, l. */ extern "C" void alists_killList (alists_alist *l); /* putItemIntoList - places an ADDRESS, c, into alist, l. */ extern "C" void alists_putItemIntoList (alists_alist l, void * c); /* getItemFromList - retrieves the nth WORD from alist, l. */ extern "C" void * alists_getItemFromList (alists_alist l, unsigned int n); /* getIndexOfList - returns the index for WORD, c, in alist, l. If more than one WORD, c, exists the index for the first is returned. */ extern "C" unsigned int alists_getIndexOfList (alists_alist l, void * c); /* noOfItemsInList - returns the number of items in alist, l. */ extern "C" unsigned int alists_noOfItemsInList (alists_alist l); /* includeItemIntoList - adds an ADDRESS, c, into a alist providing the value does not already exist. */ extern "C" void alists_includeItemIntoList (alists_alist l, void * c); /* removeItemFromList - removes a ADDRESS, c, from a alist. It assumes that this value only appears once. */ extern "C" void alists_removeItemFromList (alists_alist l, void * c); /* isItemInList - returns true if a ADDRESS, c, was found in alist, l. */ extern "C" unsigned int alists_isItemInList (alists_alist l, void * c); /* foreachItemInListDo - calls procedure, P, foreach item in alist, l. */ extern "C" void alists_foreachItemInListDo (alists_alist l, alists_performOperation p); /* duplicateList - returns a duplicate alist derived from, l. */ extern "C" alists_alist alists_duplicateList (alists_alist l); /* initList - creates a new wlist, l. */ extern "C" wlists_wlist wlists_initList (void); /* killList - deletes the complete wlist, l. */ extern "C" void wlists_killList (wlists_wlist *l); /* putItemIntoList - places an WORD, c, into wlist, l. */ extern "C" void wlists_putItemIntoList (wlists_wlist l, unsigned int c); /* getItemFromList - retrieves the nth WORD from wlist, l. */ extern "C" unsigned int wlists_getItemFromList (wlists_wlist l, unsigned int n); /* getIndexOfList - returns the index for WORD, c, in wlist, l. If more than one WORD, c, exists the index for the first is returned. */ extern "C" unsigned int wlists_getIndexOfList (wlists_wlist l, unsigned int c); /* noOfItemsInList - returns the number of items in wlist, l. */ extern "C" unsigned int wlists_noOfItemsInList (wlists_wlist l); /* includeItemIntoList - adds an WORD, c, into a wlist providing the value does not already exist. */ extern "C" void wlists_includeItemIntoList (wlists_wlist l, unsigned int c); /* removeItemFromList - removes a WORD, c, from a wlist. It assumes that this value only appears once. */ extern "C" void wlists_removeItemFromList (wlists_wlist l, unsigned int c); /* replaceItemInList - replace the nth WORD in wlist, l. The first item in a wlists is at index, 1. If the index, n, is out of range nothing is changed. */ extern "C" void wlists_replaceItemInList (wlists_wlist l, unsigned int n, unsigned int w); /* isItemInList - returns true if a WORD, c, was found in wlist, l. */ extern "C" unsigned int wlists_isItemInList (wlists_wlist l, unsigned int c); /* foreachItemInListDo - calls procedure, P, foreach item in wlist, l. */ extern "C" void wlists_foreachItemInListDo (wlists_wlist l, wlists_performOperation p); /* duplicateList - returns a duplicate wlist derived from, l. */ extern "C" wlists_wlist wlists_duplicateList (wlists_wlist l); extern "C" void keyc_useUnistd (void); extern "C" void keyc_useThrow (void); extern "C" void keyc_useStorage (void); extern "C" void keyc_useFree (void); extern "C" void keyc_useMalloc (void); extern "C" void keyc_useProc (void); extern "C" void keyc_useTrue (void); extern "C" void keyc_useFalse (void); extern "C" void keyc_useNull (void); extern "C" void keyc_useMemcpy (void); extern "C" void keyc_useIntMin (void); extern "C" void keyc_useUIntMin (void); extern "C" void keyc_useLongMin (void); extern "C" void keyc_useULongMin (void); extern "C" void keyc_useCharMin (void); extern "C" void keyc_useUCharMin (void); extern "C" void keyc_useIntMax (void); extern "C" void keyc_useUIntMax (void); extern "C" void keyc_useLongMax (void); extern "C" void keyc_useULongMax (void); extern "C" void keyc_useCharMax (void); extern "C" void keyc_useUCharMax (void); extern "C" void keyc_useSize_t (void); extern "C" void keyc_useSSize_t (void); extern "C" void keyc_useLabs (void); extern "C" void keyc_useAbs (void); extern "C" void keyc_useFabs (void); extern "C" void keyc_useFabsl (void); extern "C" void keyc_useException (void); extern "C" void keyc_useComplex (void); extern "C" void keyc_useM2RTS (void); extern "C" void keyc_useStrlen (void); extern "C" void keyc_useCtype (void); extern "C" void keyc_genDefs (mcPretty_pretty p); extern "C" void keyc_genConfigSystem (mcPretty_pretty p); extern "C" void keyc_enterScope (decl_node n); extern "C" void keyc_leaveScope (decl_node n); extern "C" DynamicStrings_String keyc_cname (nameKey_Name n, unsigned int scopes); extern "C" nameKey_Name keyc_cnamen (nameKey_Name n, unsigned int scopes); extern "C" void keyc_cp (void); extern "C" FIO_File mcStream_openFrag (unsigned int id); extern "C" void mcStream_setDest (FIO_File f); extern "C" FIO_File mcStream_combine (void); extern "C" void mcStream_removeFiles (void); extern "C" void StrIO_WriteLn (void); extern "C" void StrIO_ReadString (char *a, unsigned int _a_high); extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high); extern "C" void NumberIO_ReadCard (unsigned int *x); extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n); extern "C" void NumberIO_ReadHex (unsigned int *x); extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n); extern "C" void NumberIO_ReadInt (int *x); extern "C" void NumberIO_WriteInt (int x, unsigned int n); extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x); extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x); extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high); extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x); extern "C" void NumberIO_ReadOct (unsigned int *x); extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n); extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x); extern "C" void NumberIO_ReadBin (unsigned int *x); extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n); extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x); extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x); extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x); extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x); extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high); extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high); extern "C" void Assertion_Assert (unsigned int Condition); extern "C" void StdIO_Read (char *ch); extern "C" void StdIO_Write (char ch); extern "C" void StdIO_PushOutput (StdIO_ProcWrite p); extern "C" void StdIO_PopOutput (void); extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void); extern "C" void StdIO_PushInput (StdIO_ProcRead p); extern "C" void StdIO_PopInput (void); extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void); extern "C" void mcPrintf_printf0 (const char *a_, unsigned int _a_high); extern "C" void mcPrintf_printf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); 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); 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); 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); extern "C" void mcPrintf_fprintf0 (FIO_File file, const char *a_, unsigned int _a_high); extern "C" void mcPrintf_fprintf1 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); 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); 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); 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); /* newNode - create and return a new node of kind k. */ static decl_node newNode (decl_nodeT k); /* disposeNode - dispose node, n. */ static void disposeNode (decl_node *n); /* isLocal - returns TRUE if symbol, n, is locally declared in a procedure. */ static unsigned int isLocal (decl_node n); /* importEnumFields - if, n, is an enumeration type import the all fields into module, m. */ static void importEnumFields (decl_node m, decl_node n); /* isComplex - returns TRUE if, n, is the complex type. */ static unsigned int isComplex (decl_node n); /* isLongComplex - returns TRUE if, n, is the longcomplex type. */ static unsigned int isLongComplex (decl_node n); /* isShortComplex - returns TRUE if, n, is the shortcomplex type. */ static unsigned int isShortComplex (decl_node n); /* isAProcType - returns TRUE if, n, is a proctype or proc node. */ static unsigned int isAProcType (decl_node n); /* initFixupInfo - initialize the fixupInfo record. */ static decl_fixupInfo initFixupInfo (void); /* makeDef - returns a definition module node named, n. */ static decl_node makeDef (nameKey_Name n); /* makeImp - returns an implementation module node named, n. */ static decl_node makeImp (nameKey_Name n); /* makeModule - returns a module node named, n. */ static decl_node makeModule (nameKey_Name n); /* isDefForC - returns TRUE if the definition module was defined FOR "C". */ static unsigned int isDefForC (decl_node n); /* initDecls - initialize the decls, scopeT. */ static void initDecls (decl_scopeT *decls); /* addTo - adds node, d, to scope decls and returns, d. It stores, d, in the symbols tree associated with decls. */ static decl_node addTo (decl_scopeT *decls, decl_node d); /* export - export node, n, from definition module, d. */ static void export_ (decl_node d, decl_node n); /* addToScope - adds node, n, to the current scope and returns, n. */ static decl_node addToScope (decl_node n); /* addModuleToScope - adds module, i, to module, m, scope. */ static void addModuleToScope (decl_node m, decl_node i); /* completedEnum - assign boolean enumsComplete to TRUE if a definition, implementation or module symbol. */ static void completedEnum (decl_node n); /* setUnary - sets a unary node to contain, arg, a, and type, t. */ static void setUnary (decl_node u, decl_nodeT k, decl_node a, decl_node t); /* putVarBool - assigns the four booleans associated with a variable. */ static void putVarBool (decl_node v, unsigned int init, unsigned int param, unsigned int isvar, unsigned int isused); /* checkPtr - in C++ we need to create a typedef for a pointer in case we need to use reinterpret_cast. */ static decl_node checkPtr (decl_node n); /* isVarDecl - returns TRUE if, n, is a vardecl node. */ static unsigned int isVarDecl (decl_node n); /* makeVariablesFromParameters - creates variables which are really parameters. */ static void makeVariablesFromParameters (decl_node proc, decl_node id, decl_node type, unsigned int isvar, unsigned int isused); /* addProcedureToScope - add a procedure name n and node d to the current scope. */ static decl_node addProcedureToScope (decl_node d, nameKey_Name n); /* putProcTypeReturn - sets the return type of, proc, to, type. */ static void putProcTypeReturn (decl_node proc, decl_node type); /* putProcTypeOptReturn - sets, proc, to have an optional return type. */ static void putProcTypeOptReturn (decl_node proc); /* makeOptParameter - creates and returns an optarg. */ static decl_node makeOptParameter (decl_node l, decl_node type, decl_node init); /* setwatch - assign the globalNode to n. */ static unsigned int setwatch (decl_node n); /* runwatch - set the globalNode to an identlist. */ static unsigned int runwatch (void); /* isIdentList - returns TRUE if, n, is an identlist. */ static unsigned int isIdentList (decl_node n); /* identListLen - returns the length of identlist. */ static unsigned int identListLen (decl_node n); /* checkParameters - placeholder for future parameter checking. */ static void checkParameters (decl_node p, decl_node i, decl_node type, unsigned int isvar, unsigned int isused); /* checkMakeVariables - create shadow local variables for parameters providing that procedure n has not already been built and we are compiling a module or an implementation module. */ static void checkMakeVariables (decl_node n, decl_node i, decl_node type, unsigned int isvar, unsigned int isused); /* makeVarientField - create a varient field within varient, v, The new varient field is returned. */ static decl_node makeVarientField (decl_node v, decl_node p); /* putFieldVarient - places the field varient, f, as a brother to, the varient symbol, v, and also tells, f, that its varient parent is, v. */ static void putFieldVarient (decl_node f, decl_node v); /* putFieldRecord - create a new recordfield and place it into record r. The new field has a tagname and type and can have a variant field v. */ static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type, decl_node v); /* ensureOrder - ensures that, a, and, b, exist in, i, and also ensure that, a, is before, b. */ static void ensureOrder (Indexing_Index i, decl_node a, decl_node b); /* putVarientTag - places tag into variant v. */ static void putVarientTag (decl_node v, decl_node tag); /* getParent - returns the parent field of recordfield or varientfield symbol, n. */ static decl_node getParent (decl_node n); /* getRecord - returns the record associated with node, n. (Parental record). */ static decl_node getRecord (decl_node n); /* isConstExp - return TRUE if the node kind is a constexp. */ static unsigned int isConstExp (decl_node c); /* addEnumToModule - adds enumeration type, e, into the list of enums in module, m. */ static void addEnumToModule (decl_node m, decl_node e); /* getNextFixup - return the next fixup from from f. */ static decl_node getNextFixup (decl_fixupInfo *f); /* doMakeEnum - create an enumeration type and add it to the current module. */ static decl_node doMakeEnum (void); /* doMakeEnumField - create an enumeration field name and add it to enumeration e. Return the new field. */ static decl_node doMakeEnumField (decl_node e, nameKey_Name n); /* getExpList - returns the, n, th argument in an explist. */ static decl_node getExpList (decl_node p, unsigned int n); /* expListLen - returns the length of explist, p. */ static unsigned int expListLen (decl_node p); /* getConstExpComplete - gets the field from the def or imp or module, n. */ static unsigned int getConstExpComplete (decl_node n); /* addConstToModule - adds const exp, e, into the list of constant expressions in module, m. */ static void addConstToModule (decl_node m, decl_node e); /* doMakeConstExp - create a constexp node and add it to the current module. */ static decl_node doMakeConstExp (void); /* isAnyType - return TRUE if node n is any type kind. */ static unsigned int isAnyType (decl_node n); /* makeVal - creates a VAL (type, expression) node. */ static decl_node makeVal (decl_node params); /* makeCast - creates a cast node TYPENAME (expr). */ static decl_node makeCast (decl_node c, decl_node p); static decl_node makeIntrinsicProc (decl_nodeT k, unsigned int noArgs, decl_node p); /* makeIntrinsicUnaryType - create an intrisic unary type. */ static decl_node makeIntrinsicUnaryType (decl_nodeT k, decl_node paramList, decl_node returnType); /* makeIntrinsicBinaryType - create an intrisic binary type. */ static decl_node makeIntrinsicBinaryType (decl_nodeT k, decl_node paramList, decl_node returnType); /* checkIntrinsic - checks to see if the function call to, c, with parameter list, n, is really an intrinic. If it is an intrinic then an intrinic node is created and returned. Otherwise NIL is returned. */ static decl_node checkIntrinsic (decl_node c, decl_node n); /* checkCHeaders - check to see if the function is a C system function and requires a header file included. */ static void checkCHeaders (decl_node c); /* isFuncCall - returns TRUE if, n, is a function/procedure call. */ static unsigned int isFuncCall (decl_node n); /* putTypeInternal - marks type, des, as being an internally generated type. */ static void putTypeInternal (decl_node des); /* isTypeInternal - returns TRUE if type, n, is internal. */ static unsigned int isTypeInternal (decl_node n); /* lookupBase - return node named n from the base symbol scope. */ static decl_node lookupBase (nameKey_Name n); /* dumpScopes - display the names of all the scopes stacked. */ static void dumpScopes (void); /* out0 - write string a to StdOut. */ static void out0 (const char *a_, unsigned int _a_high); /* out1 - write string a to StdOut using format specifier a. */ static void out1 (const char *a_, unsigned int _a_high, decl_node s); /* out2 - write string a to StdOut using format specifier a. */ static void out2 (const char *a_, unsigned int _a_high, unsigned int c, decl_node s); /* out3 - write string a to StdOut using format specifier a. */ static void out3 (const char *a_, unsigned int _a_high, unsigned int l, nameKey_Name n, decl_node s); /* isUnary - returns TRUE if, n, is an unary node. */ static unsigned int isUnary (decl_node n); /* isBinary - returns TRUE if, n, is an binary node. */ static unsigned int isBinary (decl_node n); /* makeUnary - create a unary expression node with, e, as the argument and res as the return type. */ static decl_node makeUnary (decl_nodeT k, decl_node e, decl_node res); /* isLeafString - returns TRUE if n is a leaf node which is a string constant. */ static unsigned int isLeafString (decl_node n); /* getLiteralStringContents - return the contents of a literal node as a string. */ static DynamicStrings_String getLiteralStringContents (decl_node n); /* getStringContents - return the string contents of a constant, literal, string or a constexp node. */ static DynamicStrings_String getStringContents (decl_node n); /* addNames - */ static nameKey_Name addNames (decl_node a, decl_node b); /* resolveString - */ static decl_node resolveString (decl_node n); /* foldBinary - */ static decl_node foldBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res); /* makeBinary - create a binary node with left/right/result type: l, r and resultType. */ static decl_node makeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node resultType); /* doMakeBinary - returns a binary node containing left/right/result values l, r, res, with a node operator, k. */ static decl_node doMakeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res); /* doMakeComponentRef - */ static decl_node doMakeComponentRef (decl_node rec, decl_node field); /* isComponentRef - */ static unsigned int isComponentRef (decl_node n); /* isArrayRef - returns TRUE if the node was an arrayref. */ static unsigned int isArrayRef (decl_node n); /* isDeref - returns TRUE if, n, is a deref node. */ static unsigned int isDeref (decl_node n); /* makeBase - create a base type or constant. It only supports the base types and constants enumerated below. */ static decl_node makeBase (decl_nodeT k); /* isOrdinal - returns TRUE if, n, is an ordinal type. */ static unsigned int isOrdinal (decl_node n); /* mixTypes - */ static decl_node mixTypes (decl_node a, decl_node b); /* doSetExprType - */ static decl_node doSetExprType (decl_node *t, decl_node n); /* getMaxMinType - */ static decl_node getMaxMinType (decl_node n); /* doGetFuncType - */ static decl_node doGetFuncType (decl_node n); /* doGetExprType - works out the type which is associated with node, n. */ static decl_node doGetExprType (decl_node n); /* getExprType - return the expression type. */ static decl_node getExprType (decl_node n); /* openOutput - */ static void openOutput (void); /* closeOutput - */ static void closeOutput (void); /* write - outputs a single char, ch. */ static void write_ (char ch); /* writeln - */ static void writeln (void); /* doIncludeC - include header file for definition module, n. */ static void doIncludeC (decl_node n); /* getSymScope - returns the scope where node, n, was declared. */ static decl_node getSymScope (decl_node n); /* isQualifiedForced - should the node be written with a module prefix? */ static unsigned int isQualifiedForced (decl_node n); /* getFQstring - */ static DynamicStrings_String getFQstring (decl_node n); /* getFQDstring - */ static DynamicStrings_String getFQDstring (decl_node n, unsigned int scopes); /* getString - returns the name as a string. */ static DynamicStrings_String getString (decl_node n); /* doNone - call HALT. */ static void doNone (decl_node n); /* doNothing - does nothing! */ static void doNothing (decl_node n); /* doConstC - */ static void doConstC (decl_node n); /* needsParen - returns TRUE if expression, n, needs to be enclosed in (). */ static unsigned int needsParen (decl_node n); /* doUnary - */ static void doUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr, decl_node type, unsigned int l, unsigned int r); /* doSetSub - perform l & (~ r) */ static void doSetSub (mcPretty_pretty p, decl_node left, decl_node right); /* doPolyBinary - */ static void doPolyBinary (mcPretty_pretty p, decl_nodeT op, decl_node left, decl_node right, unsigned int l, unsigned int r); /* doBinary - */ static void doBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r, unsigned int unpackProc); /* doPostUnary - */ static void doPostUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr); /* doDeRefC - */ static void doDeRefC (mcPretty_pretty p, decl_node expr); /* doGetLastOp - returns, a, if b is a terminal otherwise walk right. */ static decl_node doGetLastOp (decl_node a, decl_node b); /* doComponentRefC - */ static void doComponentRefC (mcPretty_pretty p, decl_node l, decl_node r); /* doPointerRefC - */ static void doPointerRefC (mcPretty_pretty p, decl_node l, decl_node r); /* doPreBinary - */ static void doPreBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r); /* doConstExpr - */ static void doConstExpr (mcPretty_pretty p, decl_node n); /* doEnumerationField - */ static void doEnumerationField (mcPretty_pretty p, decl_node n); /* isZero - returns TRUE if node, n, is zero. */ static unsigned int isZero (decl_node n); /* doArrayRef - */ static void doArrayRef (mcPretty_pretty p, decl_node n); /* doProcedure - */ static void doProcedure (mcPretty_pretty p, decl_node n); /* doRecordfield - */ static void doRecordfield (mcPretty_pretty p, decl_node n); /* doCastC - */ static void doCastC (mcPretty_pretty p, decl_node t, decl_node e); /* doSetValueC - */ static void doSetValueC (mcPretty_pretty p, decl_node n); /* getSetLow - returns the low value of the set type from expression, n. */ static decl_node getSetLow (decl_node n); /* doInC - performs (((1 << (l)) & (r)) != 0) */ static void doInC (mcPretty_pretty p, decl_node l, decl_node r); /* doThrowC - */ static void doThrowC (mcPretty_pretty p, decl_node n); /* doUnreachableC - */ static void doUnreachableC (mcPretty_pretty p, decl_node n); /* outNull - */ static void outNull (mcPretty_pretty p); /* outTrue - */ static void outTrue (mcPretty_pretty p); /* outFalse - */ static void outFalse (mcPretty_pretty p); /* doExprC - */ static void doExprC (mcPretty_pretty p, decl_node n); /* doExprCup - */ static void doExprCup (mcPretty_pretty p, decl_node n, unsigned int unpackProc); /* doExprM2 - */ static void doExprM2 (mcPretty_pretty p, decl_node n); /* doVar - */ static void doVar (mcPretty_pretty p, decl_node n); /* doLiteralC - */ static void doLiteralC (mcPretty_pretty p, decl_node n); /* doLiteral - */ static void doLiteral (mcPretty_pretty p, decl_node n); /* isString - returns TRUE if node, n, is a string. */ static unsigned int isString (decl_node n); /* doString - */ static void doString (mcPretty_pretty p, decl_node n); /* replaceChar - replace every occurance of, ch, by, a and return modified string, s. */ static DynamicStrings_String replaceChar (DynamicStrings_String s, char ch, const char *a_, unsigned int _a_high); /* toCstring - translates string, n, into a C string and returns the new String. */ static DynamicStrings_String toCstring (nameKey_Name n); /* toCchar - */ static DynamicStrings_String toCchar (nameKey_Name n); /* countChar - */ static unsigned int countChar (DynamicStrings_String s, char ch); /* lenCstring - */ static unsigned int lenCstring (DynamicStrings_String s); /* outCstring - */ static void outCstring (mcPretty_pretty p, decl_node s, unsigned int aString); /* doStringC - */ static void doStringC (mcPretty_pretty p, decl_node n); /* isPunct - */ static unsigned int isPunct (char ch); /* isWhite - */ static unsigned int isWhite (char ch); /* outText - */ static void outText (mcPretty_pretty p, const char *a_, unsigned int _a_high); /* outRawS - */ static void outRawS (mcPretty_pretty p, DynamicStrings_String s); /* outKm2 - */ static mcPretty_pretty outKm2 (mcPretty_pretty p, const char *a_, unsigned int _a_high); /* outKc - */ static mcPretty_pretty outKc (mcPretty_pretty p, const char *a_, unsigned int _a_high); /* outTextS - */ static void outTextS (mcPretty_pretty p, DynamicStrings_String s); /* outCard - */ static void outCard (mcPretty_pretty p, unsigned int c); /* outTextN - */ static void outTextN (mcPretty_pretty p, nameKey_Name n); /* doTypeAliasC - */ static void doTypeAliasC (mcPretty_pretty p, decl_node n, decl_node *m); /* doEnumerationC - */ static void doEnumerationC (mcPretty_pretty p, decl_node n); /* doNamesC - */ static void doNamesC (mcPretty_pretty p, nameKey_Name n); /* doNameC - */ static void doNameC (mcPretty_pretty p, decl_node n); /* initCname - */ static void initCname (decl_cnameT *c); /* doCname - */ static nameKey_Name doCname (nameKey_Name n, decl_cnameT *c, unsigned int scopes); /* getDName - */ static nameKey_Name getDName (decl_node n, unsigned int scopes); /* doDNameC - */ static void doDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes); /* doFQDNameC - */ static void doFQDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes); /* doFQNameC - */ static void doFQNameC (mcPretty_pretty p, decl_node n); /* doNameM2 - */ static void doNameM2 (mcPretty_pretty p, decl_node n); /* doUsed - */ static void doUsed (mcPretty_pretty p, unsigned int used); /* doHighC - */ static void doHighC (mcPretty_pretty p, decl_node a, nameKey_Name n, unsigned int isused); /* doParamConstCast - */ static void doParamConstCast (mcPretty_pretty p, decl_node n); /* getParameterVariable - returns the variable which shadows the parameter named, m, in parameter block, n. */ static decl_node getParameterVariable (decl_node n, nameKey_Name m); /* doParamTypeEmit - emit parameter type for C/C++. It checks to see if the parameter type is a procedure type and if it were declared in a definition module for "C" and if so it uses the "C" definition for a procedure type, rather than the mc C++ version. */ static void doParamTypeEmit (mcPretty_pretty p, decl_node paramnode, decl_node paramtype); /* doParamC - emit parameter for C/C++. */ static void doParamC (mcPretty_pretty p, decl_node n); /* doVarParamC - emit a VAR parameter for C/C++. */ static void doVarParamC (mcPretty_pretty p, decl_node n); /* doOptargC - */ static void doOptargC (mcPretty_pretty p, decl_node n); /* doParameterC - */ static void doParameterC (mcPretty_pretty p, decl_node n); /* doProcTypeC - */ static void doProcTypeC (mcPretty_pretty p, decl_node t, decl_node n); /* doTypesC - */ static void doTypesC (decl_node n); /* doCompletePartialC - */ static void doCompletePartialC (decl_node n); /* doCompletePartialRecord - */ static void doCompletePartialRecord (mcPretty_pretty p, decl_node t, decl_node r); /* doCompletePartialArray - */ static void doCompletePartialArray (mcPretty_pretty p, decl_node t, decl_node r); /* lookupConst - */ static decl_node lookupConst (decl_node type, nameKey_Name n); /* doMin - */ static decl_node doMin (decl_node n); /* doMax - */ static decl_node doMax (decl_node n); /* getMax - */ static decl_node getMax (decl_node n); /* getMin - */ static decl_node getMin (decl_node n); /* doSubtractC - */ static void doSubtractC (mcPretty_pretty p, decl_node s); /* doSubrC - */ static void doSubrC (mcPretty_pretty p, decl_node s); /* doCompletePartialProcType - */ static void doCompletePartialProcType (mcPretty_pretty p, decl_node t, decl_node n); /* isBase - */ static unsigned int isBase (decl_node n); /* doBaseC - */ static void doBaseC (mcPretty_pretty p, decl_node n); /* isSystem - */ static unsigned int isSystem (decl_node n); /* doSystemC - */ static void doSystemC (mcPretty_pretty p, decl_node n); /* doArrayC - */ static void doArrayC (mcPretty_pretty p, decl_node n); /* doPointerC - */ static void doPointerC (mcPretty_pretty p, decl_node n, decl_node *m); /* doRecordFieldC - */ static void doRecordFieldC (mcPretty_pretty p, decl_node f); /* doVarientFieldC - */ static void doVarientFieldC (mcPretty_pretty p, decl_node n); /* doVarientC - */ static void doVarientC (mcPretty_pretty p, decl_node n); /* doRecordC - */ static void doRecordC (mcPretty_pretty p, decl_node n, decl_node *m); /* isBitset - */ static unsigned int isBitset (decl_node n); /* isNegative - returns TRUE if expression, n, is negative. */ static unsigned int isNegative (decl_node n); /* doSubrangeC - */ static void doSubrangeC (mcPretty_pretty p, decl_node n); /* doSetC - generates a C type which holds the set. Currently we only support sets of size WORD. */ static void doSetC (mcPretty_pretty p, decl_node n); /* doTypeC - */ static void doTypeC (mcPretty_pretty p, decl_node n, decl_node *m); /* doArrayNameC - it displays the array declaration (it might be an unbounded). */ static void doArrayNameC (mcPretty_pretty p, decl_node n); /* doRecordNameC - emit the C/C++ record name "_r". */ static void doRecordNameC (mcPretty_pretty p, decl_node n); /* doPointerNameC - emit the C/C++ pointer type *. */ static void doPointerNameC (mcPretty_pretty p, decl_node n); /* doTypeNameC - */ static void doTypeNameC (mcPretty_pretty p, decl_node n); /* isExternal - returns TRUE if symbol, n, was declared in another module. */ static unsigned int isExternal (decl_node n); /* doVarC - */ static void doVarC (decl_node n); /* doExternCP - */ static void doExternCP (mcPretty_pretty p); /* doProcedureCommentText - */ static void doProcedureCommentText (mcPretty_pretty p, DynamicStrings_String s); /* doProcedureComment - */ static void doProcedureComment (mcPretty_pretty p, DynamicStrings_String s); /* doProcedureHeadingC - */ static void doProcedureHeadingC (decl_node n, unsigned int prototype); /* checkDeclareUnboundedParamCopyC - */ static unsigned int checkDeclareUnboundedParamCopyC (mcPretty_pretty p, decl_node n); /* checkUnboundedParamCopyC - */ static void checkUnboundedParamCopyC (mcPretty_pretty p, decl_node n); /* doUnboundedParamCopyC - */ static void doUnboundedParamCopyC (mcPretty_pretty p, decl_node n); /* doPrototypeC - */ static void doPrototypeC (decl_node n); /* addTodo - adds, n, to the todo list. */ static void addTodo (decl_node n); /* addVariablesTodo - */ static void addVariablesTodo (decl_node n); /* addTypesTodo - */ static void addTypesTodo (decl_node n); /* tempName - */ static DynamicStrings_String tempName (void); /* makeIntermediateType - */ static decl_node makeIntermediateType (DynamicStrings_String s, decl_node p); /* simplifyType - */ static void simplifyType (alists_alist l, decl_node *p); /* simplifyVar - */ static void simplifyVar (alists_alist l, decl_node n); /* simplifyRecord - */ static void simplifyRecord (alists_alist l, decl_node n); /* simplifyVarient - */ static void simplifyVarient (alists_alist l, decl_node n); /* simplifyVarientField - */ static void simplifyVarientField (alists_alist l, decl_node n); /* doSimplifyNode - */ static void doSimplifyNode (alists_alist l, decl_node n); /* simplifyNode - */ static void simplifyNode (alists_alist l, decl_node n); /* doSimplify - */ static void doSimplify (decl_node n); /* simplifyTypes - */ static void simplifyTypes (decl_scopeT s); /* outDeclsDefC - */ static void outDeclsDefC (mcPretty_pretty p, decl_node n); /* includeConstType - */ static void includeConstType (decl_scopeT s); /* includeVarProcedure - */ static void includeVarProcedure (decl_scopeT s); /* includeVar - */ static void includeVar (decl_scopeT s); /* includeExternals - */ static void includeExternals (decl_node n); /* checkSystemInclude - */ static void checkSystemInclude (decl_node n); /* addExported - */ static void addExported (decl_node n); /* addExternal - only adds, n, if this symbol is external to the implementation module and is not a hidden type. */ static void addExternal (decl_node n); /* includeDefConstType - */ static void includeDefConstType (decl_node n); /* runIncludeDefConstType - */ static void runIncludeDefConstType (decl_node n); /* joinProcedures - copies procedures from definition module, d, into implementation module, i. */ static void joinProcedures (decl_node i, decl_node d); /* includeDefVarProcedure - */ static void includeDefVarProcedure (decl_node n); /* foreachModuleDo - */ static void foreachModuleDo (decl_node n, symbolKey_performOperation p); /* outDeclsImpC - */ static void outDeclsImpC (mcPretty_pretty p, decl_scopeT s); /* doStatementSequenceC - */ static void doStatementSequenceC (mcPretty_pretty p, decl_node s); /* isStatementSequenceEmpty - */ static unsigned int isStatementSequenceEmpty (decl_node s); /* isSingleStatement - returns TRUE if the statement sequence, s, has only one statement. */ static unsigned int isSingleStatement (decl_node s); /* doCommentC - */ static void doCommentC (mcPretty_pretty p, decl_node s); /* doAfterCommentC - emit an after comment, c, or a newline if, c, is empty. */ static void doAfterCommentC (mcPretty_pretty p, decl_node c); /* doReturnC - issue a return statement and also place in an after comment if one exists. */ static void doReturnC (mcPretty_pretty p, decl_node s); /* isZtypeEquivalent - */ static unsigned int isZtypeEquivalent (decl_node type); /* isEquivalentType - returns TRUE if type1 and type2 are equivalent. */ static unsigned int isEquivalentType (decl_node type1, decl_node type2); /* doExprCastC - build a cast if necessary. */ static void doExprCastC (mcPretty_pretty p, decl_node e, decl_node type); /* requiresUnpackProc - returns TRUE if either the expr is a procedure or the proctypes differ. */ static unsigned int requiresUnpackProc (decl_node s); /* doAssignmentC - */ static void doAssignmentC (mcPretty_pretty p, decl_node s); /* containsStatement - */ static unsigned int containsStatement (decl_node s); /* doCompoundStmt - */ static void doCompoundStmt (mcPretty_pretty p, decl_node s); /* doElsifC - */ static void doElsifC (mcPretty_pretty p, decl_node s); /* noIfElse - */ static unsigned int noIfElse (decl_node n); /* noIfElseChained - returns TRUE if, n, is an IF statement which has no associated ELSE statement. An IF with an ELSIF is also checked for no ELSE and will result in a return value of TRUE. */ static unsigned int noIfElseChained (decl_node n); /* hasIfElse - */ static unsigned int hasIfElse (decl_node n); /* isIfElse - */ static unsigned int isIfElse (decl_node n); /* hasIfAndNoElse - returns TRUE if statement, n, is a single statement which is an IF and it has no else statement. */ static unsigned int hasIfAndNoElse (decl_node n); /* doIfC - issue an if statement and also place in an after comment if one exists. The if statement might contain an else or elsif which are also handled. */ static void doIfC (mcPretty_pretty p, decl_node s); /* doForIncCP - */ static void doForIncCP (mcPretty_pretty p, decl_node s); /* doForIncC - */ static void doForIncC (mcPretty_pretty p, decl_node s); /* doForInc - */ static void doForInc (mcPretty_pretty p, decl_node s); /* doForC - */ static void doForC (mcPretty_pretty p, decl_node s); /* doRepeatC - */ static void doRepeatC (mcPretty_pretty p, decl_node s); /* doWhileC - */ static void doWhileC (mcPretty_pretty p, decl_node s); /* doFuncHighC - */ static void doFuncHighC (mcPretty_pretty p, decl_node a); /* doMultiplyBySize - */ static void doMultiplyBySize (mcPretty_pretty p, decl_node a); /* doTotype - */ static void doTotype (mcPretty_pretty p, decl_node a, decl_node t); /* doFuncUnbounded - */ static void doFuncUnbounded (mcPretty_pretty p, decl_node actual, decl_node formalParam, decl_node formal, decl_node func); /* doProcedureParamC - */ static void doProcedureParamC (mcPretty_pretty p, decl_node actual, decl_node formal); /* doAdrExprC - */ static void doAdrExprC (mcPretty_pretty p, decl_node n); /* typePair - */ static unsigned int typePair (decl_node a, decl_node b, decl_node x, decl_node y); /* needsCast - return TRUE if the actual type parameter needs to be cast to the formal type. */ static unsigned int needsCast (decl_node at, decl_node ft); /* checkSystemCast - checks to see if we are passing to/from a system generic type (WORD, BYTE, ADDRESS) and if so emit a cast. It returns the number of open parenthesis. */ static unsigned int checkSystemCast (mcPretty_pretty p, decl_node actual, decl_node formal); /* emitN - */ static void emitN (mcPretty_pretty p, const char *a_, unsigned int _a_high, unsigned int n); /* isForC - return true if node n is a varparam, param or procedure which was declared inside a definition module for "C". */ static unsigned int isForC (decl_node n); /* isDefForCNode - return TRUE if node n was declared inside a definition module for "C". */ static unsigned int isDefForCNode (decl_node n); /* doFuncParamC - */ static void doFuncParamC (mcPretty_pretty p, decl_node actual, decl_node formal, decl_node func); /* getNthParamType - return the type of parameter, i, in list, l. If the parameter is a vararg NIL is returned. */ static decl_node getNthParamType (Indexing_Index l, unsigned int i); /* getNthParam - return the parameter, i, in list, l. If the parameter is a vararg NIL is returned. */ static decl_node getNthParam (Indexing_Index l, unsigned int i); /* doFuncArgsC - */ static void doFuncArgsC (mcPretty_pretty p, decl_node s, Indexing_Index l, unsigned int needParen); /* doProcTypeArgsC - */ static void doProcTypeArgsC (mcPretty_pretty p, decl_node s, Indexing_Index args, unsigned int needParen); /* doAdrArgC - */ static void doAdrArgC (mcPretty_pretty p, decl_node n); /* doAdrC - */ static void doAdrC (mcPretty_pretty p, decl_node n); /* doInc - */ static void doInc (mcPretty_pretty p, decl_node n); /* doDec - */ static void doDec (mcPretty_pretty p, decl_node n); /* doIncDecC - */ static void doIncDecC (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high); /* doIncDecCP - */ static void doIncDecCP (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high); /* doInclC - */ static void doInclC (mcPretty_pretty p, decl_node n); /* doExclC - */ static void doExclC (mcPretty_pretty p, decl_node n); /* doNewC - */ static void doNewC (mcPretty_pretty p, decl_node n); /* doDisposeC - */ static void doDisposeC (mcPretty_pretty p, decl_node n); /* doCapC - */ static void doCapC (mcPretty_pretty p, decl_node n); /* doLengthC - */ static void doLengthC (mcPretty_pretty p, decl_node n); /* doAbsC - */ static void doAbsC (mcPretty_pretty p, decl_node n); /* doValC - */ static void doValC (mcPretty_pretty p, decl_node n); /* doMinC - */ static void doMinC (mcPretty_pretty p, decl_node n); /* doMaxC - */ static void doMaxC (mcPretty_pretty p, decl_node n); /* isIntrinsic - returns if, n, is an intrinsic procedure. The intrinsic functions are represented as unary and binary nodes. */ static unsigned int isIntrinsic (decl_node n); /* doHalt - */ static void doHalt (mcPretty_pretty p, decl_node n); /* doCreal - emit the appropriate creal function. */ static void doCreal (mcPretty_pretty p, decl_node t); /* doCimag - emit the appropriate cimag function. */ static void doCimag (mcPretty_pretty p, decl_node t); /* doReC - */ static void doReC (mcPretty_pretty p, decl_node n); /* doImC - */ static void doImC (mcPretty_pretty p, decl_node n); /* doCmplx - */ static void doCmplx (mcPretty_pretty p, decl_node n); /* doIntrinsicC - */ static void doIntrinsicC (mcPretty_pretty p, decl_node n); /* isIntrinsicFunction - returns true if, n, is an instrinsic function. */ static unsigned int isIntrinsicFunction (decl_node n); /* doSizeC - */ static void doSizeC (mcPretty_pretty p, decl_node n); /* doConvertC - */ static void doConvertC (mcPretty_pretty p, decl_node n, const char *conversion_, unsigned int _conversion_high); /* getFuncFromExpr - */ static decl_node getFuncFromExpr (decl_node n); /* doFuncExprC - */ static void doFuncExprC (mcPretty_pretty p, decl_node n); /* doFuncCallC - */ static void doFuncCallC (mcPretty_pretty p, decl_node n); /* doCaseStatementC - */ static void doCaseStatementC (mcPretty_pretty p, decl_node n, unsigned int needBreak); /* doExceptionC - */ static void doExceptionC (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n); /* doExceptionCP - */ static void doExceptionCP (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n); /* doException - */ static void doException (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n); /* doRangeListC - */ static void doRangeListC (mcPretty_pretty p, decl_node c); /* doRangeIfListC - */ static void doRangeIfListC (mcPretty_pretty p, decl_node e, decl_node c); /* doCaseLabels - */ static void doCaseLabels (mcPretty_pretty p, decl_node n, unsigned int needBreak); /* doCaseLabelListC - */ static void doCaseLabelListC (mcPretty_pretty p, decl_node n, unsigned int haveElse); /* doCaseIfLabels - */ static void doCaseIfLabels (mcPretty_pretty p, decl_node e, decl_node n, unsigned int i, unsigned int h); /* doCaseIfLabelListC - */ static void doCaseIfLabelListC (mcPretty_pretty p, decl_node n); /* doCaseElseC - */ static void doCaseElseC (mcPretty_pretty p, decl_node n); /* doCaseIfElseC - */ static void doCaseIfElseC (mcPretty_pretty p, decl_node n); /* canUseSwitchCaseLabels - returns TRUE if all the case labels are single values and not ranges. */ static unsigned int canUseSwitchCaseLabels (decl_node n); /* canUseSwitch - returns TRUE if the case statement can be implement by a switch statement. This will be TRUE if all case selectors are single values rather than ranges. */ static unsigned int canUseSwitch (decl_node n); /* doCaseC - */ static void doCaseC (mcPretty_pretty p, decl_node n); /* doLoopC - */ static void doLoopC (mcPretty_pretty p, decl_node s); /* doExitC - */ static void doExitC (mcPretty_pretty p, decl_node s); /* doStatementsC - */ static void doStatementsC (mcPretty_pretty p, decl_node s); static void stop (void); /* doLocalVarC - */ static void doLocalVarC (mcPretty_pretty p, decl_scopeT s); /* doLocalConstTypesC - */ static void doLocalConstTypesC (mcPretty_pretty p, decl_scopeT s); /* addParamDone - */ static void addParamDone (decl_node n); /* includeParameters - */ static void includeParameters (decl_node n); /* isHalt - */ static unsigned int isHalt (decl_node n); /* isReturnOrHalt - */ static unsigned int isReturnOrHalt (decl_node n); /* isLastStatementReturn - */ static unsigned int isLastStatementReturn (decl_node n); /* isLastStatementSequence - */ static unsigned int isLastStatementSequence (decl_node n, decl_isNodeF q); /* isLastStatementIf - */ static unsigned int isLastStatementIf (decl_node n, decl_isNodeF q); /* isLastStatementElsif - */ static unsigned int isLastStatementElsif (decl_node n, decl_isNodeF q); /* isLastStatementCase - */ static unsigned int isLastStatementCase (decl_node n, decl_isNodeF q); /* isLastStatement - returns TRUE if the last statement in, n, is, q. */ static unsigned int isLastStatement (decl_node n, decl_isNodeF q); /* doProcedureC - */ static void doProcedureC (decl_node n); /* outProceduresC - */ static void outProceduresC (mcPretty_pretty p, decl_scopeT s); /* output - */ static void output (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v); /* allDependants - */ static decl_dependentState allDependants (decl_node n); /* walkDependants - */ static decl_dependentState walkDependants (alists_alist l, decl_node n); /* walkType - */ static decl_dependentState walkType (alists_alist l, decl_node n); /* db - */ static void db (const char *a_, unsigned int _a_high, decl_node n); /* dbt - */ static void dbt (const char *a_, unsigned int _a_high); /* dbs - */ static void dbs (decl_dependentState s, decl_node n); /* dbq - */ static void dbq (decl_node n); /* walkRecord - */ static decl_dependentState walkRecord (alists_alist l, decl_node n); /* walkVarient - */ static decl_dependentState walkVarient (alists_alist l, decl_node n); /* queueBlocked - */ static void queueBlocked (decl_node n); /* walkVar - */ static decl_dependentState walkVar (alists_alist l, decl_node n); /* walkEnumeration - */ static decl_dependentState walkEnumeration (alists_alist l, decl_node n); /* walkSubrange - */ static decl_dependentState walkSubrange (alists_alist l, decl_node n); /* walkSubscript - */ static decl_dependentState walkSubscript (alists_alist l, decl_node n); /* walkPointer - */ static decl_dependentState walkPointer (alists_alist l, decl_node n); /* walkArray - */ static decl_dependentState walkArray (alists_alist l, decl_node n); /* walkConst - */ static decl_dependentState walkConst (alists_alist l, decl_node n); /* walkVarParam - */ static decl_dependentState walkVarParam (alists_alist l, decl_node n); /* walkParam - */ static decl_dependentState walkParam (alists_alist l, decl_node n); /* walkOptarg - */ static decl_dependentState walkOptarg (alists_alist l, decl_node n); /* walkRecordField - */ static decl_dependentState walkRecordField (alists_alist l, decl_node n); /* walkVarientField - */ static decl_dependentState walkVarientField (alists_alist l, decl_node n); /* walkEnumerationField - */ static decl_dependentState walkEnumerationField (alists_alist l, decl_node n); /* walkSet - */ static decl_dependentState walkSet (alists_alist l, decl_node n); /* walkProcType - */ static decl_dependentState walkProcType (alists_alist l, decl_node n); /* walkProcedure - */ static decl_dependentState walkProcedure (alists_alist l, decl_node n); /* walkParameters - */ static decl_dependentState walkParameters (alists_alist l, Indexing_Index p); /* walkFuncCall - */ static decl_dependentState walkFuncCall (alists_alist l, decl_node n); /* walkUnary - */ static decl_dependentState walkUnary (alists_alist l, decl_node n); /* walkBinary - */ static decl_dependentState walkBinary (alists_alist l, decl_node n); /* walkComponentRef - */ static decl_dependentState walkComponentRef (alists_alist l, decl_node n); /* walkPointerRef - */ static decl_dependentState walkPointerRef (alists_alist l, decl_node n); /* walkSetValue - */ static decl_dependentState walkSetValue (alists_alist l, decl_node n); /* doDependants - return the dependentState depending upon whether all dependants have been declared. */ static decl_dependentState doDependants (alists_alist l, decl_node n); /* tryComplete - returns TRUE if node, n, can be and was completed. */ static unsigned int tryComplete (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v); /* tryCompleteFromPartial - */ static unsigned int tryCompleteFromPartial (decl_node n, decl_nodeProcedure t); /* visitIntrinsicFunction - */ static void visitIntrinsicFunction (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitUnary - */ static void visitUnary (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitBinary - */ static void visitBinary (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitBoolean - */ static void visitBoolean (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitScope - */ static void visitScope (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitType - */ static void visitType (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitIndex - */ static void visitIndex (alists_alist v, Indexing_Index i, decl_nodeProcedure p); /* visitRecord - */ static void visitRecord (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitVarient - */ static void visitVarient (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitVar - */ static void visitVar (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitEnumeration - */ static void visitEnumeration (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitSubrange - */ static void visitSubrange (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitPointer - */ static void visitPointer (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitArray - */ static void visitArray (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitConst - */ static void visitConst (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitVarParam - */ static void visitVarParam (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitParam - */ static void visitParam (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitOptarg - */ static void visitOptarg (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitRecordField - */ static void visitRecordField (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitVarientField - */ static void visitVarientField (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitEnumerationField - */ static void visitEnumerationField (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitSet - */ static void visitSet (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitProcType - */ static void visitProcType (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitSubscript - */ static void visitSubscript (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitDecls - */ static void visitDecls (alists_alist v, decl_scopeT s, decl_nodeProcedure p); /* visitProcedure - */ static void visitProcedure (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitDef - */ static void visitDef (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitImp - */ static void visitImp (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitModule - */ static void visitModule (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitLoop - */ static void visitLoop (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitWhile - */ static void visitWhile (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitRepeat - */ static void visitRepeat (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitCase - */ static void visitCase (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitCaseLabelList - */ static void visitCaseLabelList (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitCaseList - */ static void visitCaseList (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitRange - */ static void visitRange (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitIf - */ static void visitIf (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitElsif - */ static void visitElsif (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitFor - */ static void visitFor (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitAssignment - */ static void visitAssignment (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitComponentRef - */ static void visitComponentRef (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitPointerRef - */ static void visitPointerRef (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitArrayRef - */ static void visitArrayRef (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitFunccall - */ static void visitFunccall (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitVarDecl - */ static void visitVarDecl (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitExplist - */ static void visitExplist (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitExit - */ static void visitExit (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitReturn - */ static void visitReturn (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitStmtSeq - */ static void visitStmtSeq (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitVarargs - */ static void visitVarargs (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitSetValue - */ static void visitSetValue (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitIntrinsic - */ static void visitIntrinsic (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitDependants - helper procedure function called from visitNode. node n has just been visited, this procedure will visit node, n, dependants. */ static void visitDependants (alists_alist v, decl_node n, decl_nodeProcedure p); /* visitNode - visits node, n, if it is not already in the alist, v. It calls p(n) if the node is unvisited. */ static void visitNode (alists_alist v, decl_node n, decl_nodeProcedure p); /* genKind - returns a string depending upon the kind of node, n. */ static DynamicStrings_String genKind (decl_node n); /* gen - generate a small string describing node, n. */ static DynamicStrings_String gen (decl_node n); /* dumpQ - */ static void dumpQ (const char *q_, unsigned int _q_high, alists_alist l); /* dumpLists - */ static void dumpLists (void); /* outputHidden - */ static void outputHidden (decl_node n); /* outputHiddenComplete - */ static void outputHiddenComplete (decl_node n); /* tryPartial - */ static unsigned int tryPartial (decl_node n, decl_nodeProcedure pt); /* outputPartialRecordArrayProcType - */ static void outputPartialRecordArrayProcType (decl_node n, decl_node q, unsigned int indirection); /* outputPartial - */ static void outputPartial (decl_node n); /* tryOutputTodo - */ static void tryOutputTodo (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure pt); /* tryOutputPartial - */ static void tryOutputPartial (decl_nodeProcedure t); /* debugList - */ static void debugList (const char *a_, unsigned int _a_high, alists_alist l); /* debugLists - */ static void debugLists (void); /* addEnumConst - */ static void addEnumConst (decl_node n); /* populateTodo - */ static void populateTodo (decl_nodeProcedure p); /* topologicallyOut - */ static void topologicallyOut (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure tp, decl_nodeProcedure pc, decl_nodeProcedure pt, decl_nodeProcedure pv); /* scaffoldStatic - */ static void scaffoldStatic (mcPretty_pretty p, decl_node n); /* emitCtor - */ static void emitCtor (mcPretty_pretty p, decl_node n); /* scaffoldDynamic - */ static void scaffoldDynamic (mcPretty_pretty p, decl_node n); /* scaffoldMain - */ static void scaffoldMain (mcPretty_pretty p, decl_node n); /* outImpInitC - emit the init/fini functions and main function if required. */ static void outImpInitC (mcPretty_pretty p, decl_node n); /* runSimplifyTypes - */ static void runSimplifyTypes (decl_node n); /* outDefC - */ static void outDefC (mcPretty_pretty p, decl_node n); /* runPrototypeExported - */ static void runPrototypeExported (decl_node n); /* runPrototypeDefC - */ static void runPrototypeDefC (decl_node n); /* outImpC - */ static void outImpC (mcPretty_pretty p, decl_node n); /* outDeclsModuleC - */ static void outDeclsModuleC (mcPretty_pretty p, decl_scopeT s); /* outModuleInitC - */ static void outModuleInitC (mcPretty_pretty p, decl_node n); /* outModuleC - */ static void outModuleC (mcPretty_pretty p, decl_node n); /* outC - */ static void outC (mcPretty_pretty p, decl_node n); /* doIncludeM2 - include modules in module, n. */ static void doIncludeM2 (decl_node n); /* doConstM2 - */ static void doConstM2 (decl_node n); /* doProcTypeM2 - */ static void doProcTypeM2 (mcPretty_pretty p, decl_node n); /* doRecordFieldM2 - */ static void doRecordFieldM2 (mcPretty_pretty p, decl_node f); /* doVarientFieldM2 - */ static void doVarientFieldM2 (mcPretty_pretty p, decl_node n); /* doVarientM2 - */ static void doVarientM2 (mcPretty_pretty p, decl_node n); /* doRecordM2 - */ static void doRecordM2 (mcPretty_pretty p, decl_node n); /* doPointerM2 - */ static void doPointerM2 (mcPretty_pretty p, decl_node n); /* doTypeAliasM2 - */ static void doTypeAliasM2 (mcPretty_pretty p, decl_node n); /* doEnumerationM2 - */ static void doEnumerationM2 (mcPretty_pretty p, decl_node n); /* doBaseM2 - */ static void doBaseM2 (mcPretty_pretty p, decl_node n); /* doSystemM2 - */ static void doSystemM2 (mcPretty_pretty p, decl_node n); /* doTypeM2 - */ static void doTypeM2 (mcPretty_pretty p, decl_node n); /* doTypesM2 - */ static void doTypesM2 (decl_node n); /* doVarM2 - */ static void doVarM2 (decl_node n); /* doVarsM2 - */ static void doVarsM2 (decl_node n); /* doTypeNameM2 - */ static void doTypeNameM2 (mcPretty_pretty p, decl_node n); /* doParamM2 - */ static void doParamM2 (mcPretty_pretty p, decl_node n); /* doVarParamM2 - */ static void doVarParamM2 (mcPretty_pretty p, decl_node n); /* doParameterM2 - */ static void doParameterM2 (mcPretty_pretty p, decl_node n); /* doPrototypeM2 - */ static void doPrototypeM2 (decl_node n); /* outputPartialM2 - just writes out record, array, and proctypes. No need for forward declarations in Modula-2 but we need to keep topological sort happy. So when asked to output partial we emit the full type for these types and then do nothing when trying to complete partial to full. */ static void outputPartialM2 (decl_node n); /* outDeclsDefM2 - */ static void outDeclsDefM2 (mcPretty_pretty p, decl_scopeT s); /* outDefM2 - */ static void outDefM2 (mcPretty_pretty p, decl_node n); /* outDeclsImpM2 - */ static void outDeclsImpM2 (mcPretty_pretty p, decl_scopeT s); /* outImpM2 - */ static void outImpM2 (mcPretty_pretty p, decl_node n); /* outModuleM2 - */ static void outModuleM2 (mcPretty_pretty p, decl_node n); /* outM2 - */ static void outM2 (mcPretty_pretty p, decl_node n); /* addDone - adds node, n, to the doneQ. */ static void addDone (decl_node n); /* addDoneDef - adds node, n, to the doneQ providing it is not an opaque of the main module we are compiling. */ static void addDoneDef (decl_node n); /* dbgAdd - */ static decl_node dbgAdd (alists_alist l, decl_node n); /* dbgType - */ static void dbgType (alists_alist l, decl_node n); /* dbgPointer - */ static void dbgPointer (alists_alist l, decl_node n); /* dbgRecord - */ static void dbgRecord (alists_alist l, decl_node n); /* dbgVarient - */ static void dbgVarient (alists_alist l, decl_node n); /* dbgEnumeration - */ static void dbgEnumeration (alists_alist l, decl_node n); /* dbgVar - */ static void dbgVar (alists_alist l, decl_node n); /* dbgSubrange - */ static void dbgSubrange (alists_alist l, decl_node n); /* dbgArray - */ static void dbgArray (alists_alist l, decl_node n); /* doDbg - */ static void doDbg (alists_alist l, decl_node n); /* dbg - */ static void dbg (decl_node n); /* addGenericBody - adds comment node to funccall, return, assignment nodes. */ static void addGenericBody (decl_node n, decl_node c); /* addGenericAfter - adds comment node to funccall, return, assignment nodes. */ static void addGenericAfter (decl_node n, decl_node c); /* isAssignment - */ static unsigned int isAssignment (decl_node n); /* isComment - returns TRUE if node, n, is a comment. */ static unsigned int isComment (decl_node n); /* initPair - initialise the commentPair, c. */ static void initPair (decl_commentPair *c); /* dupExplist - */ static decl_node dupExplist (decl_node n); /* dupArrayref - */ static decl_node dupArrayref (decl_node n); /* dupPointerref - */ static decl_node dupPointerref (decl_node n); /* dupComponentref - */ static decl_node dupComponentref (decl_node n); /* dupBinary - */ static decl_node dupBinary (decl_node n); /* dupUnary - */ static decl_node dupUnary (decl_node n); /* dupFunccall - */ static decl_node dupFunccall (decl_node n); /* dupSetValue - */ static decl_node dupSetValue (decl_node n); /* doDupExpr - */ static decl_node doDupExpr (decl_node n); /* makeSystem - */ static void makeSystem (void); /* makeM2rts - */ static void makeM2rts (void); /* makeBitnum - */ static decl_node makeBitnum (void); /* makeBaseSymbols - */ static void makeBaseSymbols (void); /* makeBuiltins - */ static void makeBuiltins (void); /* init - */ static void init (void); /* newNode - create and return a new node of kind k. */ static decl_node newNode (decl_nodeT k) { decl_node d; Storage_ALLOCATE ((void **) &d, sizeof (decl_nodeRec)); if (enableMemsetOnAllocation) { d = static_cast (libc_memset (reinterpret_cast (d), 0, static_cast (sizeof ((*d))))); } if (d == NULL) { M2RTS_HALT (-1); __builtin_unreachable (); } else { d->kind = k; d->at.defDeclared = 0; d->at.modDeclared = 0; d->at.firstUsed = 0; return d; } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* disposeNode - dispose node, n. */ static void disposeNode (decl_node *n) { Storage_DEALLOCATE ((void **) &(*n), sizeof (decl_nodeRec)); (*n) = NULL; } /* isLocal - returns TRUE if symbol, n, is locally declared in a procedure. */ static unsigned int isLocal (decl_node n) { decl_node s; s = decl_getScope (n); if (s != NULL) { return decl_isProcedure (s); } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* importEnumFields - if, n, is an enumeration type import the all fields into module, m. */ static void importEnumFields (decl_node m, decl_node n) { decl_node r; decl_node e; unsigned int i; unsigned int h; mcDebug_assert (((decl_isDef (m)) || (decl_isModule (m))) || (decl_isImp (m))); n = decl_skipType (n); if ((n != NULL) && (decl_isEnumeration (n))) { i = Indexing_LowIndice (n->enumerationF.listOfSons); h = Indexing_HighIndice (n->enumerationF.listOfSons); while (i <= h) { e = static_cast (Indexing_GetIndice (n->enumerationF.listOfSons, i)); r = decl_import (m, e); if (e != r) { 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)); } i += 1; } } } /* isComplex - returns TRUE if, n, is the complex type. */ static unsigned int isComplex (decl_node n) { return n == complexN; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isLongComplex - returns TRUE if, n, is the longcomplex type. */ static unsigned int isLongComplex (decl_node n) { return n == longcomplexN; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isShortComplex - returns TRUE if, n, is the shortcomplex type. */ static unsigned int isShortComplex (decl_node n) { return n == shortcomplexN; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isAProcType - returns TRUE if, n, is a proctype or proc node. */ static unsigned int isAProcType (decl_node n) { mcDebug_assert (n != NULL); return (decl_isProcType (n)) || (n == procN); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* initFixupInfo - initialize the fixupInfo record. */ static decl_fixupInfo initFixupInfo (void) { decl_fixupInfo f; f.count = 0; f.info = Indexing_InitIndex (1); return f; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeDef - returns a definition module node named, n. */ static decl_node makeDef (nameKey_Name n) { decl_node d; d = newNode (decl_def); d->defF.name = n; d->defF.source = nameKey_NulName; d->defF.hasHidden = FALSE; d->defF.forC = FALSE; d->defF.exported = Indexing_InitIndex (1); d->defF.importedModules = Indexing_InitIndex (1); d->defF.constFixup = initFixupInfo (); d->defF.enumFixup = initFixupInfo (); initDecls (&d->defF.decls); d->defF.enumsComplete = FALSE; d->defF.constsComplete = FALSE; d->defF.visited = FALSE; initPair (&d->defF.com); return d; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeImp - returns an implementation module node named, n. */ static decl_node makeImp (nameKey_Name n) { decl_node d; d = newNode (decl_imp); d->impF.name = n; d->impF.source = nameKey_NulName; d->impF.importedModules = Indexing_InitIndex (1); d->impF.constFixup = initFixupInfo (); d->impF.enumFixup = initFixupInfo (); initDecls (&d->impF.decls); d->impF.beginStatements = NULL; d->impF.finallyStatements = NULL; d->impF.definitionModule = NULL; d->impF.enumsComplete = FALSE; d->impF.constsComplete = FALSE; d->impF.visited = FALSE; initPair (&d->impF.com); return d; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeModule - returns a module node named, n. */ static decl_node makeModule (nameKey_Name n) { decl_node d; d = newNode (decl_module); d->moduleF.name = n; d->moduleF.source = nameKey_NulName; d->moduleF.importedModules = Indexing_InitIndex (1); d->moduleF.constFixup = initFixupInfo (); d->moduleF.enumFixup = initFixupInfo (); initDecls (&d->moduleF.decls); d->moduleF.beginStatements = NULL; d->moduleF.finallyStatements = NULL; d->moduleF.enumsComplete = FALSE; d->moduleF.constsComplete = FALSE; d->moduleF.visited = FALSE; initPair (&d->moduleF.com); return d; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isDefForC - returns TRUE if the definition module was defined FOR "C". */ static unsigned int isDefForC (decl_node n) { return (decl_isDef (n)) && n->defF.forC; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* initDecls - initialize the decls, scopeT. */ static void initDecls (decl_scopeT *decls) { (*decls).symbols = symbolKey_initTree (); (*decls).constants = Indexing_InitIndex (1); (*decls).types = Indexing_InitIndex (1); (*decls).procedures = Indexing_InitIndex (1); (*decls).variables = Indexing_InitIndex (1); } /* addTo - adds node, d, to scope decls and returns, d. It stores, d, in the symbols tree associated with decls. */ static decl_node addTo (decl_scopeT *decls, decl_node d) { nameKey_Name n; n = decl_getSymName (d); if (n != nameKey_NulName) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if ((symbolKey_getSymKey ((*decls).symbols, n)) == NULL) { symbolKey_putSymKey ((*decls).symbols, n, reinterpret_cast (d)); } else { mcMetaError_metaError1 ((const char *) "{%1DMad} was declared", 21, (const unsigned char *) &d, (sizeof (d)-1)); mcMetaError_metaError1 ((const char *) "{%1k} and is being declared again", 33, (const unsigned char *) &n, (sizeof (n)-1)); } } if (decl_isConst (d)) { Indexing_IncludeIndiceIntoIndex ((*decls).constants, reinterpret_cast (d)); } else if (decl_isVar (d)) { /* avoid dangling else. */ Indexing_IncludeIndiceIntoIndex ((*decls).variables, reinterpret_cast (d)); } else if (decl_isType (d)) { /* avoid dangling else. */ Indexing_IncludeIndiceIntoIndex ((*decls).types, reinterpret_cast (d)); } else if (decl_isProcedure (d)) { /* avoid dangling else. */ Indexing_IncludeIndiceIntoIndex ((*decls).procedures, reinterpret_cast (d)); if (debugDecl) { libc_printf ((const char *) "%d procedures on the dynamic array\\n", 36, Indexing_HighIndice ((*decls).procedures)); } } return d; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* export - export node, n, from definition module, d. */ static void export_ (decl_node d, decl_node n) { mcDebug_assert (decl_isDef (d)); Indexing_IncludeIndiceIntoIndex (d->defF.exported, reinterpret_cast (n)); } /* addToScope - adds node, n, to the current scope and returns, n. */ static decl_node addToScope (decl_node n) { decl_node s; unsigned int i; i = Indexing_HighIndice (scopeStack); s = static_cast (Indexing_GetIndice (scopeStack, i)); if (decl_isProcedure (s)) { if (debugDecl) { outText (doP, (const char *) "adding ", 7); doNameC (doP, n); outText (doP, (const char *) " to procedure\\n", 15); } return addTo (&s->procedureF.decls, n); } else if (decl_isModule (s)) { /* avoid dangling else. */ if (debugDecl) { outText (doP, (const char *) "adding ", 7); doNameC (doP, n); outText (doP, (const char *) " to module\\n", 12); } return addTo (&s->moduleF.decls, n); } else if (decl_isDef (s)) { /* avoid dangling else. */ if (debugDecl) { outText (doP, (const char *) "adding ", 7); doNameC (doP, n); outText (doP, (const char *) " to definition module\\n", 23); } export_ (s, n); return addTo (&s->defF.decls, n); } else if (decl_isImp (s)) { /* avoid dangling else. */ if (debugDecl) { outText (doP, (const char *) "adding ", 7); doNameC (doP, n); outText (doP, (const char *) " to implementation module\\n", 27); } return addTo (&s->impF.decls, n); } M2RTS_HALT (-1); __builtin_unreachable (); ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* addModuleToScope - adds module, i, to module, m, scope. */ static void addModuleToScope (decl_node m, decl_node i) { mcDebug_assert ((decl_getDeclScope ()) == m); if ((decl_lookupSym (decl_getSymName (i))) == NULL) { i = addToScope (i); } } /* completedEnum - assign boolean enumsComplete to TRUE if a definition, implementation or module symbol. */ static void completedEnum (decl_node n) { mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n))); if (decl_isDef (n)) { n->defF.enumsComplete = TRUE; } else if (decl_isImp (n)) { /* avoid dangling else. */ n->impF.enumsComplete = TRUE; } else if (decl_isModule (n)) { /* avoid dangling else. */ n->moduleF.enumsComplete = TRUE; } } /* setUnary - sets a unary node to contain, arg, a, and type, t. */ static void setUnary (decl_node u, decl_nodeT k, decl_node a, decl_node t) { switch (k) { case decl_constexp: case decl_deref: case decl_chr: case decl_cap: case decl_abs: case decl_float: case decl_trunc: case decl_ord: case decl_high: case decl_throw: case decl_re: case decl_im: case decl_not: case decl_neg: case decl_adr: case decl_size: case decl_tsize: case decl_min: case decl_max: u->kind = k; u->unaryF.arg = a; u->unaryF.resultType = t; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* putVarBool - assigns the four booleans associated with a variable. */ static void putVarBool (decl_node v, unsigned int init, unsigned int param, unsigned int isvar, unsigned int isused) { mcDebug_assert (decl_isVar (v)); v->varF.isInitialised = init; v->varF.isParameter = param; v->varF.isVarParameter = isvar; v->varF.isUsed = isused; } /* checkPtr - in C++ we need to create a typedef for a pointer in case we need to use reinterpret_cast. */ static decl_node checkPtr (decl_node n) { DynamicStrings_String s; decl_node p; if (lang == decl_ansiCP) { if (decl_isPointer (n)) { s = tempName (); p = decl_makeType (nameKey_makekey (DynamicStrings_string (s))); decl_putType (p, n); s = DynamicStrings_KillString (s); return p; } } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isVarDecl - returns TRUE if, n, is a vardecl node. */ static unsigned int isVarDecl (decl_node n) { return n->kind == decl_vardecl; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeVariablesFromParameters - creates variables which are really parameters. */ static void makeVariablesFromParameters (decl_node proc, decl_node id, decl_node type, unsigned int isvar, unsigned int isused) { decl_node v; unsigned int i; unsigned int n; nameKey_Name m; DynamicStrings_String s; mcDebug_assert (decl_isProcedure (proc)); mcDebug_assert (isIdentList (id)); i = 1; n = wlists_noOfItemsInList (id->identlistF.names); while (i <= n) { m = static_cast (wlists_getItemFromList (id->identlistF.names, i)); v = decl_makeVar (m); decl_putVar (v, type, NULL); putVarBool (v, TRUE, TRUE, isvar, isused); if (debugScopes) { libc_printf ((const char *) "adding parameter variable into top scope\\n", 42); dumpScopes (); libc_printf ((const char *) " variable name is: ", 19); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (m)); if ((DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, s))) == NULL) {} /* empty. */ libc_printf ((const char *) "\\n", 2); } i += 1; } } /* addProcedureToScope - add a procedure name n and node d to the current scope. */ static decl_node addProcedureToScope (decl_node d, nameKey_Name n) { decl_node m; unsigned int i; i = Indexing_HighIndice (scopeStack); m = static_cast (Indexing_GetIndice (scopeStack, i)); if (((decl_isDef (m)) && ((decl_getSymName (m)) == (nameKey_makeKey ((const char *) "M2RTS", 5)))) && ((decl_getSymName (d)) == (nameKey_makeKey ((const char *) "HALT", 4)))) { haltN = d; symbolKey_putSymKey (baseSymbols, n, reinterpret_cast (haltN)); } return addToScope (d); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putProcTypeReturn - sets the return type of, proc, to, type. */ static void putProcTypeReturn (decl_node proc, decl_node type) { mcDebug_assert (decl_isProcType (proc)); proc->proctypeF.returnType = type; } /* putProcTypeOptReturn - sets, proc, to have an optional return type. */ static void putProcTypeOptReturn (decl_node proc) { mcDebug_assert (decl_isProcType (proc)); proc->proctypeF.returnopt = TRUE; } /* makeOptParameter - creates and returns an optarg. */ static decl_node makeOptParameter (decl_node l, decl_node type, decl_node init) { decl_node n; n = newNode (decl_optarg); n->optargF.namelist = l; n->optargF.type = type; n->optargF.init = init; n->optargF.scope = NULL; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* setwatch - assign the globalNode to n. */ static unsigned int setwatch (decl_node n) { globalNode = n; return TRUE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* runwatch - set the globalNode to an identlist. */ static unsigned int runwatch (void) { return globalNode->kind == decl_identlist; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isIdentList - returns TRUE if, n, is an identlist. */ static unsigned int isIdentList (decl_node n) { return n->kind == decl_identlist; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* identListLen - returns the length of identlist. */ static unsigned int identListLen (decl_node n) { if (n == NULL) { return 0; } else { mcDebug_assert (isIdentList (n)); return wlists_noOfItemsInList (n->identlistF.names); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* checkParameters - placeholder for future parameter checking. */ static void checkParameters (decl_node p, decl_node i, decl_node type, unsigned int isvar, unsigned int isused) { /* do check. */ disposeNode (&i); } /* checkMakeVariables - create shadow local variables for parameters providing that procedure n has not already been built and we are compiling a module or an implementation module. */ static void checkMakeVariables (decl_node n, decl_node i, decl_node type, unsigned int isvar, unsigned int isused) { if (((decl_isImp (currentModule)) || (decl_isModule (currentModule))) && ! n->procedureF.built) { makeVariablesFromParameters (n, i, type, isvar, isused); } } /* makeVarientField - create a varient field within varient, v, The new varient field is returned. */ static decl_node makeVarientField (decl_node v, decl_node p) { decl_node n; n = newNode (decl_varientfield); n->varientfieldF.name = nameKey_NulName; n->varientfieldF.parent = p; n->varientfieldF.varient = v; n->varientfieldF.simple = FALSE; n->varientfieldF.listOfSons = Indexing_InitIndex (1); n->varientfieldF.scope = decl_getDeclScope (); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putFieldVarient - places the field varient, f, as a brother to, the varient symbol, v, and also tells, f, that its varient parent is, v. */ static void putFieldVarient (decl_node f, decl_node v) { mcDebug_assert (decl_isVarient (v)); mcDebug_assert (decl_isVarientField (f)); switch (v->kind) { case decl_varient: Indexing_IncludeIndiceIntoIndex (v->varientF.listOfSons, reinterpret_cast (f)); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } switch (f->kind) { case decl_varientfield: f->varientfieldF.varient = v; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* putFieldRecord - create a new recordfield and place it into record r. The new field has a tagname and type and can have a variant field v. */ static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type, decl_node v) { decl_node f; decl_node n; decl_node p; n = newNode (decl_recordfield); switch (r->kind) { case decl_record: Indexing_IncludeIndiceIntoIndex (r->recordF.listOfSons, reinterpret_cast (n)); /* ensure that field, n, is in the parents Local Symbols. */ if (tag != nameKey_NulName) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if ((symbolKey_getSymKey (r->recordF.localSymbols, tag)) == symbolKey_NulKey) { symbolKey_putSymKey (r->recordF.localSymbols, tag, reinterpret_cast (n)); } else { f = static_cast (symbolKey_getSymKey (r->recordF.localSymbols, tag)); 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)); } } break; case decl_varientfield: Indexing_IncludeIndiceIntoIndex (r->varientfieldF.listOfSons, reinterpret_cast (n)); p = getParent (r); mcDebug_assert (p->kind == decl_record); if (tag != nameKey_NulName) { symbolKey_putSymKey (p->recordF.localSymbols, tag, reinterpret_cast (n)); } break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* fill in, n. */ n->recordfieldF.type = type; n->recordfieldF.name = tag; n->recordfieldF.parent = r; n->recordfieldF.varient = v; n->recordfieldF.tag = FALSE; n->recordfieldF.scope = NULL; initCname (&n->recordfieldF.cname); /* IF r^.kind=record THEN doRecordM2 (doP, r) END ; */ return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* ensureOrder - ensures that, a, and, b, exist in, i, and also ensure that, a, is before, b. */ static void ensureOrder (Indexing_Index i, decl_node a, decl_node b) { mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast (a))); mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast (b))); Indexing_RemoveIndiceFromIndex (i, reinterpret_cast (a)); Indexing_RemoveIndiceFromIndex (i, reinterpret_cast (b)); Indexing_IncludeIndiceIntoIndex (i, reinterpret_cast (a)); Indexing_IncludeIndiceIntoIndex (i, reinterpret_cast (b)); mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast (a))); mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast (b))); } /* putVarientTag - places tag into variant v. */ static void putVarientTag (decl_node v, decl_node tag) { decl_node p; mcDebug_assert (decl_isVarient (v)); switch (v->kind) { case decl_varient: v->varientF.tag = tag; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* getParent - returns the parent field of recordfield or varientfield symbol, n. */ static decl_node getParent (decl_node n) { switch (n->kind) { case decl_recordfield: return n->recordfieldF.parent; break; case decl_varientfield: return n->varientfieldF.parent; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getRecord - returns the record associated with node, n. (Parental record). */ static decl_node getRecord (decl_node n) { mcDebug_assert (n->kind != decl_varient); /* if this fails then we need to add parent field to varient. */ switch (n->kind) { case decl_record: return n; /* if this fails then we need to add parent field to varient. */ break; case decl_varientfield: return getRecord (getParent (n)); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isConstExp - return TRUE if the node kind is a constexp. */ static unsigned int isConstExp (decl_node c) { mcDebug_assert (c != NULL); return c->kind == decl_constexp; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* addEnumToModule - adds enumeration type, e, into the list of enums in module, m. */ static void addEnumToModule (decl_node m, decl_node e) { mcDebug_assert ((decl_isEnumeration (e)) || (decl_isEnumerationField (e))); mcDebug_assert (((decl_isModule (m)) || (decl_isDef (m))) || (decl_isImp (m))); if (decl_isModule (m)) { Indexing_IncludeIndiceIntoIndex (m->moduleF.enumFixup.info, reinterpret_cast (e)); } else if (decl_isDef (m)) { /* avoid dangling else. */ Indexing_IncludeIndiceIntoIndex (m->defF.enumFixup.info, reinterpret_cast (e)); } else if (decl_isImp (m)) { /* avoid dangling else. */ Indexing_IncludeIndiceIntoIndex (m->impF.enumFixup.info, reinterpret_cast (e)); } } /* getNextFixup - return the next fixup from from f. */ static decl_node getNextFixup (decl_fixupInfo *f) { (*f).count += 1; return static_cast (Indexing_GetIndice ((*f).info, (*f).count)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doMakeEnum - create an enumeration type and add it to the current module. */ static decl_node doMakeEnum (void) { decl_node e; e = newNode (decl_enumeration); e->enumerationF.noOfElements = 0; e->enumerationF.localSymbols = symbolKey_initTree (); e->enumerationF.scope = decl_getDeclScope (); e->enumerationF.listOfSons = Indexing_InitIndex (1); e->enumerationF.low = NULL; e->enumerationF.high = NULL; addEnumToModule (currentModule, e); return e; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doMakeEnumField - create an enumeration field name and add it to enumeration e. Return the new field. */ static decl_node doMakeEnumField (decl_node e, nameKey_Name n) { decl_node f; mcDebug_assert (decl_isEnumeration (e)); f = decl_lookupSym (n); if (f == NULL) { f = newNode (decl_enumerationfield); symbolKey_putSymKey (e->enumerationF.localSymbols, n, reinterpret_cast (f)); Indexing_IncludeIndiceIntoIndex (e->enumerationF.listOfSons, reinterpret_cast (f)); f->enumerationfieldF.name = n; f->enumerationfieldF.type = e; f->enumerationfieldF.scope = decl_getDeclScope (); f->enumerationfieldF.value = e->enumerationF.noOfElements; initCname (&f->enumerationfieldF.cname); e->enumerationF.noOfElements += 1; mcDebug_assert ((Indexing_GetIndice (e->enumerationF.listOfSons, e->enumerationF.noOfElements)) == f); addEnumToModule (currentModule, f); if (e->enumerationF.low == NULL) { e->enumerationF.low = f; } e->enumerationF.high = f; return addToScope (f); } else { 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)); } return f; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getExpList - returns the, n, th argument in an explist. */ static decl_node getExpList (decl_node p, unsigned int n) { mcDebug_assert (p != NULL); mcDebug_assert (decl_isExpList (p)); mcDebug_assert (n <= (Indexing_HighIndice (p->explistF.exp))); return static_cast (Indexing_GetIndice (p->explistF.exp, n)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* expListLen - returns the length of explist, p. */ static unsigned int expListLen (decl_node p) { if (p == NULL) { return 0; } else { mcDebug_assert (decl_isExpList (p)); return Indexing_HighIndice (p->explistF.exp); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getConstExpComplete - gets the field from the def or imp or module, n. */ static unsigned int getConstExpComplete (decl_node n) { switch (n->kind) { case decl_def: return n->defF.constsComplete; break; case decl_imp: return n->impF.constsComplete; break; case decl_module: return n->moduleF.constsComplete; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* addConstToModule - adds const exp, e, into the list of constant expressions in module, m. */ static void addConstToModule (decl_node m, decl_node e) { mcDebug_assert (((decl_isModule (m)) || (decl_isDef (m))) || (decl_isImp (m))); if (decl_isModule (m)) { Indexing_IncludeIndiceIntoIndex (m->moduleF.constFixup.info, reinterpret_cast (e)); } else if (decl_isDef (m)) { /* avoid dangling else. */ Indexing_IncludeIndiceIntoIndex (m->defF.constFixup.info, reinterpret_cast (e)); } else if (decl_isImp (m)) { /* avoid dangling else. */ Indexing_IncludeIndiceIntoIndex (m->impF.constFixup.info, reinterpret_cast (e)); } } /* doMakeConstExp - create a constexp node and add it to the current module. */ static decl_node doMakeConstExp (void) { decl_node c; c = makeUnary (decl_constexp, NULL, NULL); addConstToModule (currentModule, c); return c; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isAnyType - return TRUE if node n is any type kind. */ static unsigned int isAnyType (decl_node n) { mcDebug_assert (n != NULL); switch (n->kind) { case decl_address: case decl_loc: case decl_byte: case decl_word: case decl_char: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_complex: case decl_longcomplex: case decl_shortcomplex: case decl_bitset: case decl_boolean: case decl_proc: case decl_type: return TRUE; break; default: return FALSE; break; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeVal - creates a VAL (type, expression) node. */ static decl_node makeVal (decl_node params) { mcDebug_assert (decl_isExpList (params)); if ((expListLen (params)) == 2) { return makeBinary (decl_val, getExpList (params, 1), getExpList (params, 2), getExpList (params, 1)); } else { M2RTS_HALT (-1); __builtin_unreachable (); } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* makeCast - creates a cast node TYPENAME (expr). */ static decl_node makeCast (decl_node c, decl_node p) { mcDebug_assert (decl_isExpList (p)); if ((expListLen (p)) == 1) { return makeBinary (decl_cast, c, getExpList (p, 1), c); } else { M2RTS_HALT (-1); __builtin_unreachable (); } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } static decl_node makeIntrinsicProc (decl_nodeT k, unsigned int noArgs, decl_node p) { decl_node f; /* makeIntrisicProc - create an intrinsic node. */ f = newNode (k); f->intrinsicF.args = p; f->intrinsicF.noArgs = noArgs; f->intrinsicF.type = NULL; f->intrinsicF.postUnreachable = k == decl_halt; initPair (&f->intrinsicF.intrinsicComment); return f; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeIntrinsicUnaryType - create an intrisic unary type. */ static decl_node makeIntrinsicUnaryType (decl_nodeT k, decl_node paramList, decl_node returnType) { return makeUnary (k, getExpList (paramList, 1), returnType); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeIntrinsicBinaryType - create an intrisic binary type. */ static decl_node makeIntrinsicBinaryType (decl_nodeT k, decl_node paramList, decl_node returnType) { return makeBinary (k, getExpList (paramList, 1), getExpList (paramList, 2), returnType); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* checkIntrinsic - checks to see if the function call to, c, with parameter list, n, is really an intrinic. If it is an intrinic then an intrinic node is created and returned. Otherwise NIL is returned. */ static decl_node checkIntrinsic (decl_node c, decl_node n) { if (isAnyType (c)) { return makeCast (c, n); } else if (c == maxN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_max, n, NULL); } else if (c == minN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_min, n, NULL); } else if (c == haltN) { /* avoid dangling else. */ return makeIntrinsicProc (decl_halt, expListLen (n), n); } else if (c == valN) { /* avoid dangling else. */ return makeVal (n); } else if (c == adrN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_adr, n, addressN); } else if (c == sizeN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_size, n, cardinalN); } else if (c == tsizeN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_tsize, n, cardinalN); } else if (c == floatN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_float, n, realN); } else if (c == truncN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_trunc, n, integerN); } else if (c == ordN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_ord, n, cardinalN); } else if (c == chrN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_chr, n, charN); } else if (c == capN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_cap, n, charN); } else if (c == absN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_abs, n, NULL); } else if (c == imN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_im, n, NULL); } else if (c == reN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_re, n, NULL); } else if (c == cmplxN) { /* avoid dangling else. */ return makeIntrinsicBinaryType (decl_cmplx, n, NULL); } else if (c == highN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_high, n, cardinalN); } else if (c == incN) { /* avoid dangling else. */ return makeIntrinsicProc (decl_inc, expListLen (n), n); } else if (c == decN) { /* avoid dangling else. */ return makeIntrinsicProc (decl_dec, expListLen (n), n); } else if (c == inclN) { /* avoid dangling else. */ return makeIntrinsicProc (decl_incl, expListLen (n), n); } else if (c == exclN) { /* avoid dangling else. */ return makeIntrinsicProc (decl_excl, expListLen (n), n); } else if (c == newN) { /* avoid dangling else. */ return makeIntrinsicProc (decl_new, 1, n); } else if (c == disposeN) { /* avoid dangling else. */ return makeIntrinsicProc (decl_dispose, 1, n); } else if (c == lengthN) { /* avoid dangling else. */ return makeIntrinsicUnaryType (decl_length, n, cardinalN); } else if (c == throwN) { /* avoid dangling else. */ keyc_useThrow (); return makeIntrinsicProc (decl_throw, 1, n); } return NULL; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* checkCHeaders - check to see if the function is a C system function and requires a header file included. */ static void checkCHeaders (decl_node c) { nameKey_Name name; decl_node s; if (decl_isProcedure (c)) { s = decl_getScope (c); if ((decl_getSymName (s)) == (nameKey_makeKey ((const char *) "libc", 4))) { name = decl_getSymName (c); 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)))) { keyc_useUnistd (); } } } } /* isFuncCall - returns TRUE if, n, is a function/procedure call. */ static unsigned int isFuncCall (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_funccall; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putTypeInternal - marks type, des, as being an internally generated type. */ static void putTypeInternal (decl_node des) { mcDebug_assert (des != NULL); mcDebug_assert (decl_isType (des)); des->typeF.isInternal = TRUE; } /* isTypeInternal - returns TRUE if type, n, is internal. */ static unsigned int isTypeInternal (decl_node n) { mcDebug_assert (n != NULL); mcDebug_assert (decl_isType (n)); return n->typeF.isInternal; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* lookupBase - return node named n from the base symbol scope. */ static decl_node lookupBase (nameKey_Name n) { decl_node m; m = static_cast (symbolKey_getSymKey (baseSymbols, n)); if (m == procN) { keyc_useProc (); } else if (((m == complexN) || (m == longcomplexN)) || (m == shortcomplexN)) { /* avoid dangling else. */ keyc_useComplex (); } return m; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* dumpScopes - display the names of all the scopes stacked. */ static void dumpScopes (void) { unsigned int h; decl_node s; h = Indexing_HighIndice (scopeStack); libc_printf ((const char *) "total scopes stacked %d\\n", 25, h); while (h >= 1) { s = static_cast (Indexing_GetIndice (scopeStack, h)); out2 ((const char *) " scope [%d] is %s\\n", 19, h, s); h -= 1; } } /* out0 - write string a to StdOut. */ static void out0 (const char *a_, unsigned int _a_high) { DynamicStrings_String m; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) a, _a_high)); m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); } /* out1 - write string a to StdOut using format specifier a. */ static void out1 (const char *a_, unsigned int _a_high, decl_node s) { DynamicStrings_String m; unsigned int d; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); m = getFQstring (s); if (DynamicStrings_EqualArray (m, (const char *) "", 0)) { d = (unsigned int ) ((long unsigned int ) (s)); m = DynamicStrings_KillString (m); m = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "[%d]", 4), (const unsigned char *) &d, (sizeof (d)-1)); } m = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &m, (sizeof (m)-1)); m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); } /* out2 - write string a to StdOut using format specifier a. */ static void out2 (const char *a_, unsigned int _a_high, unsigned int c, decl_node s) { DynamicStrings_String m; DynamicStrings_String m1; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); m1 = getString (s); m = FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) &m1, (sizeof (m1)-1)); m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); m1 = DynamicStrings_KillString (m1); } /* out3 - write string a to StdOut using format specifier a. */ static void out3 (const char *a_, unsigned int _a_high, unsigned int l, nameKey_Name n, decl_node s) { DynamicStrings_String m; DynamicStrings_String m1; DynamicStrings_String m2; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); m1 = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); m2 = getString (s); 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)); m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); m1 = DynamicStrings_KillString (m1); m2 = DynamicStrings_KillString (m2); } /* isUnary - returns TRUE if, n, is an unary node. */ static unsigned int isUnary (decl_node n) { mcDebug_assert (n != NULL); switch (n->kind) { case decl_length: case decl_re: case decl_im: case decl_deref: case decl_high: case decl_chr: case decl_cap: case decl_abs: case decl_ord: case decl_float: case decl_trunc: case decl_constexp: case decl_not: case decl_neg: case decl_adr: case decl_size: case decl_tsize: case decl_min: case decl_max: return TRUE; break; default: return FALSE; break; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isBinary - returns TRUE if, n, is an binary node. */ static unsigned int isBinary (decl_node n) { mcDebug_assert (n != NULL); switch (n->kind) { case decl_cmplx: case decl_and: case decl_or: case decl_equal: case decl_notequal: case decl_less: case decl_greater: case decl_greequal: case decl_lessequal: case decl_val: case decl_cast: case decl_plus: case decl_sub: case decl_div: case decl_mod: case decl_mult: case decl_divide: case decl_in: return TRUE; break; default: return FALSE; break; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeUnary - create a unary expression node with, e, as the argument and res as the return type. */ static decl_node makeUnary (decl_nodeT k, decl_node e, decl_node res) { decl_node n; if (k == decl_plus) { return e; } else { n = newNode (k); switch (n->kind) { case decl_min: case decl_max: case decl_throw: case decl_re: case decl_im: case decl_deref: case decl_high: case decl_chr: case decl_cap: case decl_abs: case decl_ord: case decl_float: case decl_trunc: case decl_length: case decl_constexp: case decl_not: case decl_neg: case decl_adr: case decl_size: case decl_tsize: n->unaryF.arg = e; n->unaryF.resultType = res; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isLeafString - returns TRUE if n is a leaf node which is a string constant. */ static unsigned int isLeafString (decl_node n) { return ((isString (n)) || ((decl_isLiteral (n)) && ((decl_getType (n)) == charN))) || ((decl_isConst (n)) && ((getExprType (n)) == charN)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getLiteralStringContents - return the contents of a literal node as a string. */ static DynamicStrings_String getLiteralStringContents (decl_node n) { DynamicStrings_String number; DynamicStrings_String content; DynamicStrings_String s; mcDebug_assert (n->kind == decl_literal); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n->literalF.name)); content = NULL; if (n->literalF.type == charN) { if ((DynamicStrings_char (s, -1)) == 'C') { if ((DynamicStrings_Length (s)) > 1) { number = DynamicStrings_Slice (s, 0, -1); content = DynamicStrings_InitStringChar ((char ) (StringConvert_ostoc (number))); number = DynamicStrings_KillString (number); } else { content = DynamicStrings_InitStringChar ('C'); } } else { content = DynamicStrings_Dup (s); } } else { mcMetaError_metaError1 ((const char *) "cannot obtain string contents from {%1k}", 40, (const unsigned char *) &n->literalF.name, (sizeof (n->literalF.name)-1)); } s = DynamicStrings_KillString (s); return content; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getStringContents - return the string contents of a constant, literal, string or a constexp node. */ static DynamicStrings_String getStringContents (decl_node n) { if (decl_isConst (n)) { return getStringContents (n->constF.value); } else if (decl_isLiteral (n)) { /* avoid dangling else. */ return getLiteralStringContents (n); } else if (isString (n)) { /* avoid dangling else. */ return getString (n); } else if (isConstExp (n)) { /* avoid dangling else. */ return getStringContents (n->unaryF.arg); } M2RTS_HALT (-1); __builtin_unreachable (); ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* addNames - */ static nameKey_Name addNames (decl_node a, decl_node b) { DynamicStrings_String sa; DynamicStrings_String sb; nameKey_Name n; sa = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (a))); sb = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (b))); sa = DynamicStrings_ConCat (sa, sb); n = nameKey_makekey (DynamicStrings_string (sa)); sa = DynamicStrings_KillString (sa); sb = DynamicStrings_KillString (sb); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* resolveString - */ static decl_node resolveString (decl_node n) { while ((decl_isConst (n)) || (isConstExp (n))) { if (decl_isConst (n)) { n = n->constF.value; } else { n = n->unaryF.arg; } } if (n->kind == decl_plus) { n = decl_makeString (addNames (resolveString (n->binaryF.left), resolveString (n->binaryF.right))); } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* foldBinary - */ static decl_node foldBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res) { decl_node n; DynamicStrings_String ls; DynamicStrings_String rs; n = NULL; if (((k == decl_plus) && (isLeafString (l))) && (isLeafString (r))) { ls = getStringContents (l); rs = getStringContents (r); ls = DynamicStrings_Add (ls, rs); n = decl_makeString (nameKey_makekey (DynamicStrings_string (ls))); ls = DynamicStrings_KillString (ls); rs = DynamicStrings_KillString (rs); } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeBinary - create a binary node with left/right/result type: l, r and resultType. */ static decl_node makeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node resultType) { decl_node n; n = foldBinary (k, l, r, resultType); if (n == NULL) { n = doMakeBinary (k, l, r, resultType); } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doMakeBinary - returns a binary node containing left/right/result values l, r, res, with a node operator, k. */ static decl_node doMakeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res) { decl_node n; n = newNode (k); switch (n->kind) { case decl_cmplx: case decl_equal: case decl_notequal: case decl_less: case decl_greater: case decl_greequal: case decl_lessequal: case decl_and: case decl_or: case decl_cast: case decl_val: case decl_plus: case decl_sub: case decl_div: case decl_mod: case decl_mult: case decl_divide: case decl_in: n->binaryF.left = l; n->binaryF.right = r; n->binaryF.resultType = res; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doMakeComponentRef - */ static decl_node doMakeComponentRef (decl_node rec, decl_node field) { decl_node n; n = newNode (decl_componentref); n->componentrefF.rec = rec; n->componentrefF.field = field; n->componentrefF.resultType = decl_getType (field); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isComponentRef - */ static unsigned int isComponentRef (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_componentref; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isArrayRef - returns TRUE if the node was an arrayref. */ static unsigned int isArrayRef (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_arrayref; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isDeref - returns TRUE if, n, is a deref node. */ static unsigned int isDeref (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_deref; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeBase - create a base type or constant. It only supports the base types and constants enumerated below. */ static decl_node makeBase (decl_nodeT k) { decl_node n; n = newNode (k); switch (k) { case decl_new: case decl_dispose: case decl_length: case decl_inc: case decl_dec: case decl_incl: case decl_excl: case decl_nil: case decl_true: case decl_false: case decl_address: case decl_loc: case decl_byte: case decl_word: case decl_csizet: case decl_cssizet: case decl_char: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_real: case decl_longreal: case decl_shortreal: case decl_bitset: case decl_boolean: case decl_proc: case decl_ztype: case decl_rtype: case decl_complex: case decl_longcomplex: case decl_shortcomplex: case decl_adr: case decl_chr: case decl_cap: case decl_abs: case decl_float: case decl_trunc: case decl_ord: case decl_high: case decl_throw: case decl_re: case decl_im: case decl_cmplx: case decl_size: case decl_tsize: case decl_val: case decl_min: case decl_max: break; default: M2RTS_HALT (-1); /* legal kind. */ __builtin_unreachable (); break; } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isOrdinal - returns TRUE if, n, is an ordinal type. */ static unsigned int isOrdinal (decl_node n) { switch (n->kind) { case decl_address: case decl_loc: case decl_byte: case decl_word: case decl_csizet: case decl_cssizet: case decl_char: case decl_integer: case decl_longint: case decl_shortint: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_bitset: return TRUE; break; default: return FALSE; break; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* mixTypes - */ static decl_node mixTypes (decl_node a, decl_node b) { if ((a == addressN) || (b == addressN)) { return addressN; } return a; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doSetExprType - */ static decl_node doSetExprType (decl_node *t, decl_node n) { if ((*t) == NULL) { (*t) = n; } return (*t); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getMaxMinType - */ static decl_node getMaxMinType (decl_node n) { if ((decl_isVar (n)) || (decl_isConst (n))) { return decl_getType (n); } else if (isConstExp (n)) { /* avoid dangling else. */ n = getExprType (n->unaryF.arg); if (n == bitsetN) { return ztypeN; } else { return n; } } else { /* avoid dangling else. */ return n; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doGetFuncType - */ static decl_node doGetFuncType (decl_node n) { mcDebug_assert (isFuncCall (n)); return doSetExprType (&n->funccallF.type, decl_getType (n->funccallF.function)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doGetExprType - works out the type which is associated with node, n. */ static decl_node doGetExprType (decl_node n) { switch (n->kind) { case decl_max: case decl_min: return getMaxMinType (n->unaryF.arg); break; case decl_cast: case decl_val: return doSetExprType (&n->binaryF.resultType, n->binaryF.left); break; case decl_halt: case decl_new: case decl_dispose: return NULL; break; case decl_inc: case decl_dec: case decl_incl: case decl_excl: return NULL; break; case decl_nil: return addressN; break; case decl_true: case decl_false: return booleanN; break; case decl_address: return n; break; case decl_loc: return n; break; case decl_byte: return n; break; case decl_word: return n; break; case decl_csizet: return n; break; case decl_cssizet: return n; break; case decl_boolean: /* base types. */ return n; break; case decl_proc: return n; break; case decl_char: return n; break; case decl_cardinal: return n; break; case decl_longcard: return n; break; case decl_shortcard: return n; break; case decl_integer: return n; break; case decl_longint: return n; break; case decl_shortint: return n; break; case decl_real: return n; break; case decl_longreal: return n; break; case decl_shortreal: return n; break; case decl_bitset: return n; break; case decl_ztype: return n; break; case decl_rtype: return n; break; case decl_complex: return n; break; case decl_longcomplex: return n; break; case decl_shortcomplex: return n; break; case decl_type: /* language features and compound type attributes. */ return n->typeF.type; break; case decl_record: return n; break; case decl_varient: return n; break; case decl_var: return n->varF.type; break; case decl_enumeration: return n; break; case decl_subrange: return n->subrangeF.type; break; case decl_array: return n->arrayF.type; break; case decl_string: return charN; break; case decl_const: return doSetExprType (&n->constF.type, getExprType (n->constF.value)); break; case decl_literal: return n->literalF.type; break; case decl_varparam: return n->varparamF.type; break; case decl_param: return n->paramF.type; break; case decl_optarg: return n->optargF.type; break; case decl_pointer: return n->pointerF.type; break; case decl_recordfield: return n->recordfieldF.type; break; case decl_varientfield: return n; break; case decl_enumerationfield: return n->enumerationfieldF.type; break; case decl_set: return n->setF.type; break; case decl_proctype: return n->proctypeF.returnType; break; case decl_subscript: return n->subscriptF.type; break; case decl_procedure: /* blocks. */ return n->procedureF.returnType; break; case decl_throw: return NULL; break; case decl_unreachable: return NULL; break; case decl_def: case decl_imp: case decl_module: case decl_loop: case decl_while: case decl_for: case decl_repeat: case decl_if: case decl_elsif: case decl_assignment: /* statements. */ M2RTS_HALT (-1); __builtin_unreachable (); break; case decl_plus: case decl_sub: case decl_div: case decl_mod: case decl_mult: case decl_divide: /* expressions. */ return doSetExprType (&n->binaryF.resultType, mixTypes (getExprType (n->binaryF.left), getExprType (n->binaryF.right))); break; case decl_in: case decl_and: case decl_or: case decl_equal: case decl_notequal: case decl_less: case decl_greater: case decl_greequal: case decl_lessequal: return doSetExprType (&n->binaryF.resultType, booleanN); break; case decl_cmplx: return doSetExprType (&n->binaryF.resultType, complexN); break; case decl_abs: case decl_constexp: case decl_deref: case decl_neg: return doSetExprType (&n->unaryF.resultType, getExprType (n->unaryF.arg)); break; case decl_adr: return doSetExprType (&n->unaryF.resultType, addressN); break; case decl_size: case decl_tsize: return doSetExprType (&n->unaryF.resultType, cardinalN); break; case decl_high: case decl_ord: return doSetExprType (&n->unaryF.resultType, cardinalN); break; case decl_float: return doSetExprType (&n->unaryF.resultType, realN); break; case decl_trunc: return doSetExprType (&n->unaryF.resultType, integerN); break; case decl_chr: return doSetExprType (&n->unaryF.resultType, charN); break; case decl_cap: return doSetExprType (&n->unaryF.resultType, charN); break; case decl_not: return doSetExprType (&n->unaryF.resultType, booleanN); break; case decl_re: return doSetExprType (&n->unaryF.resultType, realN); break; case decl_im: return doSetExprType (&n->unaryF.resultType, realN); break; case decl_arrayref: return n->arrayrefF.resultType; break; case decl_componentref: return n->componentrefF.resultType; break; case decl_pointerref: return n->pointerrefF.resultType; break; case decl_funccall: return doSetExprType (&n->funccallF.type, doGetFuncType (n)); break; case decl_setvalue: return n->setvalueF.type; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } M2RTS_HALT (-1); __builtin_unreachable (); ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* getExprType - return the expression type. */ static decl_node getExprType (decl_node n) { decl_node t; if (((isFuncCall (n)) && ((decl_getType (n)) != NULL)) && (decl_isProcType (decl_skipType (decl_getType (n))))) { return decl_getType (decl_skipType (decl_getType (n))); } t = decl_getType (n); if (t == NULL) { t = doGetExprType (n); } return t; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* openOutput - */ static void openOutput (void) { DynamicStrings_String s; s = mcOptions_getOutputFile (); if (DynamicStrings_EqualArray (s, (const char *) "-", 1)) { outputFile = FIO_StdOut; } else { outputFile = SFIO_OpenToWrite (s); } mcStream_setDest (outputFile); } /* closeOutput - */ static void closeOutput (void) { DynamicStrings_String s; s = mcOptions_getOutputFile (); outputFile = mcStream_combine (); if (! (DynamicStrings_EqualArray (s, (const char *) "-", 1))) { FIO_Close (outputFile); } } /* write - outputs a single char, ch. */ static void write_ (char ch) { FIO_WriteChar (outputFile, ch); FIO_FlushBuffer (outputFile); } /* writeln - */ static void writeln (void) { FIO_WriteLine (outputFile); FIO_FlushBuffer (outputFile); } /* doIncludeC - include header file for definition module, n. */ static void doIncludeC (decl_node n) { DynamicStrings_String s; s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); if (mcOptions_getExtendedOpaque ()) {} /* empty. */ /* no include in this case. */ else if (decl_isDef (n)) { /* avoid dangling else. */ mcPretty_print (doP, (const char *) "# include \"", 13); mcPretty_prints (doP, mcOptions_getHPrefix ()); mcPretty_prints (doP, s); mcPretty_print (doP, (const char *) ".h\"\\n", 5); symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDoneDef}); } s = DynamicStrings_KillString (s); } /* getSymScope - returns the scope where node, n, was declared. */ static decl_node getSymScope (decl_node n) { switch (n->kind) { case decl_const: return n->constF.scope; break; case decl_type: return n->typeF.scope; break; case decl_var: return n->varF.scope; break; case decl_procedure: return n->procedureF.scope; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } M2RTS_HALT (-1); __builtin_unreachable (); ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* isQualifiedForced - should the node be written with a module prefix? */ static unsigned int isQualifiedForced (decl_node n) { return forceQualified && (((((decl_isType (n)) || (decl_isRecord (n))) || (decl_isArray (n))) || (decl_isEnumeration (n))) || (decl_isEnumerationField (n))); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getFQstring - */ static DynamicStrings_String getFQstring (decl_node n) { DynamicStrings_String i; DynamicStrings_String s; if ((decl_getScope (n)) == NULL) { return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); } else if (isQualifiedForced (n)) { /* avoid dangling else. */ i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n)))); return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1)); } else if ((! (decl_isExported (n))) || (mcOptions_getIgnoreFQ ())) { /* avoid dangling else. */ return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); } else { /* avoid dangling else. */ i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n)))); return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1)); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getFQDstring - */ static DynamicStrings_String getFQDstring (decl_node n, unsigned int scopes) { DynamicStrings_String i; DynamicStrings_String s; if ((decl_getScope (n)) == NULL) { return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (getDName (n, scopes))); } else if (isQualifiedForced (n)) { /* avoid dangling else. */ /* we assume a qualified name will never conflict. */ i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n)))); return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1)); } else if ((! (decl_isExported (n))) || (mcOptions_getIgnoreFQ ())) { /* avoid dangling else. */ return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (getDName (n, scopes))); } else { /* avoid dangling else. */ /* we assume a qualified name will never conflict. */ i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n)))); return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1)); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getString - returns the name as a string. */ static DynamicStrings_String getString (decl_node n) { if ((decl_getSymName (n)) == nameKey_NulName) { return DynamicStrings_InitString ((const char *) "", 0); } else { return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doNone - call HALT. */ static void doNone (decl_node n) { M2RTS_HALT (-1); __builtin_unreachable (); } /* doNothing - does nothing! */ static void doNothing (decl_node n) { } /* doConstC - */ static void doConstC (decl_node n) { if (! (alists_isItemInList (doneQ, reinterpret_cast (n)))) { mcPretty_print (doP, (const char *) "# define ", 11); doFQNameC (doP, n); mcPretty_setNeedSpace (doP); doExprC (doP, n->constF.value); mcPretty_print (doP, (const char *) "\\n", 2); alists_includeItemIntoList (doneQ, reinterpret_cast (n)); } } /* needsParen - returns TRUE if expression, n, needs to be enclosed in (). */ static unsigned int needsParen (decl_node n) { mcDebug_assert (n != NULL); switch (n->kind) { case decl_nil: case decl_true: case decl_false: return FALSE; break; case decl_constexp: return needsParen (n->unaryF.arg); break; case decl_neg: return needsParen (n->unaryF.arg); break; case decl_not: return needsParen (n->unaryF.arg); break; case decl_adr: case decl_size: case decl_tsize: case decl_ord: case decl_float: case decl_trunc: case decl_chr: case decl_cap: case decl_high: return FALSE; break; case decl_deref: return FALSE; break; case decl_equal: case decl_notequal: case decl_less: case decl_greater: case decl_greequal: case decl_lessequal: return TRUE; break; case decl_componentref: return FALSE; break; case decl_pointerref: return FALSE; break; case decl_cast: return TRUE; break; case decl_val: return TRUE; break; case decl_abs: return FALSE; break; case decl_plus: case decl_sub: case decl_div: case decl_mod: case decl_mult: case decl_divide: case decl_in: return TRUE; break; case decl_literal: case decl_const: case decl_enumerationfield: case decl_string: return FALSE; break; case decl_max: return TRUE; break; case decl_min: return TRUE; break; case decl_var: return FALSE; break; case decl_arrayref: return FALSE; break; case decl_and: case decl_or: return TRUE; break; case decl_funccall: return TRUE; break; case decl_recordfield: return FALSE; break; case decl_loc: case decl_byte: case decl_word: case decl_type: case decl_char: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_real: case decl_longreal: case decl_shortreal: case decl_complex: case decl_longcomplex: case decl_shortcomplex: case decl_bitset: case decl_boolean: case decl_proc: return FALSE; break; case decl_setvalue: return FALSE; break; case decl_address: return TRUE; break; case decl_procedure: return FALSE; break; case decl_length: case decl_cmplx: case decl_re: case decl_im: return TRUE; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } return TRUE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doUnary - */ static void doUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr, decl_node type, unsigned int l, unsigned int r) { char op[_op_high+1]; /* make a local copy of each unbounded array. */ memcpy (op, op_, _op_high+1); if (l) { mcPretty_setNeedSpace (p); } mcPretty_print (p, (const char *) op, _op_high); if (r) { mcPretty_setNeedSpace (p); } if (needsParen (expr)) { outText (p, (const char *) "(", 1); doExprC (p, expr); outText (p, (const char *) ")", 1); } else { doExprC (p, expr); } } /* doSetSub - perform l & (~ r) */ static void doSetSub (mcPretty_pretty p, decl_node left, decl_node right) { if (needsParen (left)) { outText (p, (const char *) "(", 1); doExprC (p, left); outText (p, (const char *) ")", 1); } else { doExprC (p, left); } mcPretty_setNeedSpace (p); outText (p, (const char *) "&", 1); mcPretty_setNeedSpace (p); if (needsParen (right)) { outText (p, (const char *) "(~(", 3); doExprC (p, right); outText (p, (const char *) "))", 2); } else { outText (p, (const char *) "(~", 2); doExprC (p, right); outText (p, (const char *) ")", 1); } } /* doPolyBinary - */ static void doPolyBinary (mcPretty_pretty p, decl_nodeT op, decl_node left, decl_node right, unsigned int l, unsigned int r) { decl_node lt; decl_node rt; lt = decl_skipType (getExprType (left)); rt = decl_skipType (getExprType (right)); if (((lt != NULL) && ((decl_isSet (lt)) || (isBitset (lt)))) || ((rt != NULL) && ((decl_isSet (rt)) || (isBitset (rt))))) { switch (op) { case decl_plus: doBinary (p, (const char *) "|", 1, left, right, l, r, FALSE); break; case decl_sub: doSetSub (p, left, right); break; case decl_mult: doBinary (p, (const char *) "&", 1, left, right, l, r, FALSE); break; case decl_divide: doBinary (p, (const char *) "^", 1, left, right, l, r, FALSE); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } else { switch (op) { case decl_plus: doBinary (p, (const char *) "+", 1, left, right, l, r, FALSE); break; case decl_sub: doBinary (p, (const char *) "-", 1, left, right, l, r, FALSE); break; case decl_mult: doBinary (p, (const char *) "*", 1, left, right, l, r, FALSE); break; case decl_divide: doBinary (p, (const char *) "/", 1, left, right, l, r, FALSE); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } } /* doBinary - */ static void doBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r, unsigned int unpackProc) { char op[_op_high+1]; /* make a local copy of each unbounded array. */ memcpy (op, op_, _op_high+1); if (needsParen (left)) { outText (p, (const char *) "(", 1); doExprCup (p, left, unpackProc); outText (p, (const char *) ")", 1); } else { doExprCup (p, left, unpackProc); } if (l) { mcPretty_setNeedSpace (p); } outText (p, (const char *) op, _op_high); if (r) { mcPretty_setNeedSpace (p); } if (needsParen (right)) { outText (p, (const char *) "(", 1); doExprCup (p, right, unpackProc); outText (p, (const char *) ")", 1); } else { doExprCup (p, right, unpackProc); } } /* doPostUnary - */ static void doPostUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr) { char op[_op_high+1]; /* make a local copy of each unbounded array. */ memcpy (op, op_, _op_high+1); doExprC (p, expr); outText (p, (const char *) op, _op_high); } /* doDeRefC - */ static void doDeRefC (mcPretty_pretty p, decl_node expr) { outText (p, (const char *) "(*", 2); doExprC (p, expr); outText (p, (const char *) ")", 1); } /* doGetLastOp - returns, a, if b is a terminal otherwise walk right. */ static decl_node doGetLastOp (decl_node a, decl_node b) { switch (b->kind) { case decl_nil: return a; break; case decl_true: return a; break; case decl_false: return a; break; case decl_constexp: return doGetLastOp (b, b->unaryF.arg); break; case decl_neg: return doGetLastOp (b, b->unaryF.arg); break; case decl_not: return doGetLastOp (b, b->unaryF.arg); break; case decl_adr: return doGetLastOp (b, b->unaryF.arg); break; case decl_size: return doGetLastOp (b, b->unaryF.arg); break; case decl_tsize: return doGetLastOp (b, b->unaryF.arg); break; case decl_ord: return doGetLastOp (b, b->unaryF.arg); break; case decl_float: case decl_trunc: return doGetLastOp (b, b->unaryF.arg); break; case decl_chr: return doGetLastOp (b, b->unaryF.arg); break; case decl_cap: return doGetLastOp (b, b->unaryF.arg); break; case decl_high: return doGetLastOp (b, b->unaryF.arg); break; case decl_deref: return doGetLastOp (b, b->unaryF.arg); break; case decl_re: case decl_im: return doGetLastOp (b, b->unaryF.arg); break; case decl_equal: return doGetLastOp (b, b->binaryF.right); break; case decl_notequal: return doGetLastOp (b, b->binaryF.right); break; case decl_less: return doGetLastOp (b, b->binaryF.right); break; case decl_greater: return doGetLastOp (b, b->binaryF.right); break; case decl_greequal: return doGetLastOp (b, b->binaryF.right); break; case decl_lessequal: return doGetLastOp (b, b->binaryF.right); break; case decl_componentref: return doGetLastOp (b, b->componentrefF.field); break; case decl_pointerref: return doGetLastOp (b, b->pointerrefF.field); break; case decl_cast: return doGetLastOp (b, b->binaryF.right); break; case decl_val: return doGetLastOp (b, b->binaryF.right); break; case decl_plus: return doGetLastOp (b, b->binaryF.right); break; case decl_sub: return doGetLastOp (b, b->binaryF.right); break; case decl_div: return doGetLastOp (b, b->binaryF.right); break; case decl_mod: return doGetLastOp (b, b->binaryF.right); break; case decl_mult: return doGetLastOp (b, b->binaryF.right); break; case decl_divide: return doGetLastOp (b, b->binaryF.right); break; case decl_in: return doGetLastOp (b, b->binaryF.right); break; case decl_and: return doGetLastOp (b, b->binaryF.right); break; case decl_or: return doGetLastOp (b, b->binaryF.right); break; case decl_cmplx: return doGetLastOp (b, b->binaryF.right); break; case decl_literal: return a; break; case decl_const: return a; break; case decl_enumerationfield: return a; break; case decl_string: return a; break; case decl_max: return doGetLastOp (b, b->unaryF.arg); break; case decl_min: return doGetLastOp (b, b->unaryF.arg); break; case decl_var: return a; break; case decl_arrayref: return a; break; case decl_funccall: return a; break; case decl_procedure: return a; break; case decl_recordfield: return a; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doComponentRefC - */ static void doComponentRefC (mcPretty_pretty p, decl_node l, decl_node r) { doExprC (p, l); outText (p, (const char *) ".", 1); doExprC (p, r); } /* doPointerRefC - */ static void doPointerRefC (mcPretty_pretty p, decl_node l, decl_node r) { doExprC (p, l); outText (p, (const char *) "->", 2); doExprC (p, r); } /* doPreBinary - */ static void doPreBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r) { char op[_op_high+1]; /* make a local copy of each unbounded array. */ memcpy (op, op_, _op_high+1); if (l) { mcPretty_setNeedSpace (p); } outText (p, (const char *) op, _op_high); if (r) { mcPretty_setNeedSpace (p); } outText (p, (const char *) "(", 1); doExprC (p, left); outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); doExprC (p, right); outText (p, (const char *) ")", 1); } /* doConstExpr - */ static void doConstExpr (mcPretty_pretty p, decl_node n) { doFQNameC (p, n); } /* doEnumerationField - */ static void doEnumerationField (mcPretty_pretty p, decl_node n) { doFQDNameC (p, n, FALSE); } /* isZero - returns TRUE if node, n, is zero. */ static unsigned int isZero (decl_node n) { if (isConstExp (n)) { return isZero (n->unaryF.arg); } return (decl_getSymName (n)) == (nameKey_makeKey ((const char *) "0", 1)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doArrayRef - */ static void doArrayRef (mcPretty_pretty p, decl_node n) { decl_node t; unsigned int i; unsigned int c; mcDebug_assert (n != NULL); mcDebug_assert (isArrayRef (n)); t = decl_skipType (decl_getType (n->arrayrefF.array)); if (decl_isUnbounded (t)) { outTextN (p, decl_getSymName (n->arrayrefF.array)); } else { doExprC (p, n->arrayrefF.array); mcDebug_assert (decl_isArray (t)); outText (p, (const char *) ".array", 6); } outText (p, (const char *) "[", 1); i = 1; c = expListLen (n->arrayrefF.index); while (i <= c) { doExprC (p, getExpList (n->arrayrefF.index, i)); if (decl_isUnbounded (t)) { mcDebug_assert (c == 1); } else { doSubtractC (p, getMin (t->arrayF.subr)); if (i < c) { mcDebug_assert (decl_isArray (t)); outText (p, (const char *) "].array[", 8); t = decl_skipType (decl_getType (t)); } } i += 1; } outText (p, (const char *) "]", 1); } /* doProcedure - */ static void doProcedure (mcPretty_pretty p, decl_node n) { mcDebug_assert (decl_isProcedure (n)); doFQDNameC (p, n, TRUE); } /* doRecordfield - */ static void doRecordfield (mcPretty_pretty p, decl_node n) { doDNameC (p, n, FALSE); } /* doCastC - */ static void doCastC (mcPretty_pretty p, decl_node t, decl_node e) { decl_node et; outText (p, (const char *) "(", 1); doTypeNameC (p, t); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); et = decl_skipType (decl_getType (e)); if (((et != NULL) && (isAProcType (et))) && (isAProcType (decl_skipType (t)))) { outText (p, (const char *) "{(", 2); doFQNameC (p, t); outText (p, (const char *) "_t)", 3); mcPretty_setNeedSpace (p); doExprC (p, e); outText (p, (const char *) ".proc}", 6); } else { outText (p, (const char *) "(", 1); doExprC (p, e); outText (p, (const char *) ")", 1); } } /* doSetValueC - */ static void doSetValueC (mcPretty_pretty p, decl_node n) { decl_node lo; unsigned int i; unsigned int h; mcDebug_assert (decl_isSetValue (n)); lo = getSetLow (n); if (n->setvalueF.type != NULL) { outText (p, (const char *) "(", 1); doTypeNameC (p, n->setvalueF.type); mcPretty_noSpace (p); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); } if ((Indexing_HighIndice (n->setvalueF.values)) == 0) { outText (p, (const char *) "0", 1); } else { i = Indexing_LowIndice (n->setvalueF.values); h = Indexing_HighIndice (n->setvalueF.values); outText (p, (const char *) "(", 1); while (i <= h) { outText (p, (const char *) "(1", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "<<", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, reinterpret_cast (Indexing_GetIndice (n->setvalueF.values, i))); doSubtractC (p, lo); outText (p, (const char *) ")", 1); outText (p, (const char *) ")", 1); if (i < h) { mcPretty_setNeedSpace (p); outText (p, (const char *) "|", 1); mcPretty_setNeedSpace (p); } i += 1; } outText (p, (const char *) ")", 1); } } /* getSetLow - returns the low value of the set type from expression, n. */ static decl_node getSetLow (decl_node n) { decl_node type; if ((decl_getType (n)) == NULL) { return decl_makeLiteralInt (nameKey_makeKey ((const char *) "0", 1)); } else { type = decl_skipType (decl_getType (n)); if (decl_isSet (type)) { return getMin (decl_skipType (decl_getType (type))); } else { return decl_makeLiteralInt (nameKey_makeKey ((const char *) "0", 1)); } } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doInC - performs (((1 << (l)) & (r)) != 0) */ static void doInC (mcPretty_pretty p, decl_node l, decl_node r) { decl_node lo; lo = getSetLow (r); outText (p, (const char *) "(((1", 4); mcPretty_setNeedSpace (p); outText (p, (const char *) "<<", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, l); doSubtractC (p, lo); outText (p, (const char *) "))", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "&", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, r); outText (p, (const char *) "))", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "!=", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "0)", 2); } /* doThrowC - */ static void doThrowC (mcPretty_pretty p, decl_node n) { mcDebug_assert (isIntrinsic (n)); outText (p, (const char *) "throw", 5); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); if ((expListLen (n->intrinsicF.args)) == 1) { doExprC (p, getExpList (n->intrinsicF.args, 1)); } outText (p, (const char *) ")", 1); } /* doUnreachableC - */ static void doUnreachableC (mcPretty_pretty p, decl_node n) { mcDebug_assert (isIntrinsic (n)); outText (p, (const char *) "__builtin_unreachable", 21); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); mcDebug_assert ((expListLen (n->intrinsicF.args)) == 0); outText (p, (const char *) ")", 1); } /* outNull - */ static void outNull (mcPretty_pretty p) { keyc_useNull (); outText (p, (const char *) "NULL", 4); } /* outTrue - */ static void outTrue (mcPretty_pretty p) { keyc_useTrue (); outText (p, (const char *) "TRUE", 4); } /* outFalse - */ static void outFalse (mcPretty_pretty p) { keyc_useFalse (); outText (p, (const char *) "FALSE", 5); } /* doExprC - */ static void doExprC (mcPretty_pretty p, decl_node n) { decl_node t; mcDebug_assert (n != NULL); t = getExprType (n); switch (n->kind) { case decl_nil: outNull (p); break; case decl_true: outTrue (p); break; case decl_false: outFalse (p); break; case decl_constexp: doUnary (p, (const char *) "", 0, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE); break; case decl_neg: doUnary (p, (const char *) "-", 1, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE); break; case decl_not: doUnary (p, (const char *) "!", 1, n->unaryF.arg, n->unaryF.resultType, FALSE, TRUE); break; case decl_val: doValC (p, n); break; case decl_adr: doAdrC (p, n); break; case decl_size: case decl_tsize: doSizeC (p, n); break; case decl_float: doConvertC (p, n, (const char *) "(double)", 8); break; case decl_trunc: doConvertC (p, n, (const char *) "(int)", 5); break; case decl_ord: doConvertC (p, n, (const char *) "(unsigned int)", 14); break; case decl_chr: doConvertC (p, n, (const char *) "(char)", 6); break; case decl_cap: doCapC (p, n); break; case decl_abs: doAbsC (p, n); break; case decl_high: doFuncHighC (p, n->unaryF.arg); break; case decl_length: doLengthC (p, n); break; case decl_min: doMinC (p, n); break; case decl_max: doMaxC (p, n); break; case decl_throw: doThrowC (p, n); break; case decl_unreachable: doUnreachableC (p, n); break; case decl_re: doReC (p, n); break; case decl_im: doImC (p, n); break; case decl_cmplx: doCmplx (p, n); break; case decl_deref: doDeRefC (p, n->unaryF.arg); break; case decl_equal: doBinary (p, (const char *) "==", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, TRUE); break; case decl_notequal: doBinary (p, (const char *) "!=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, TRUE); break; case decl_less: doBinary (p, (const char *) "<", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_greater: doBinary (p, (const char *) ">", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_greequal: doBinary (p, (const char *) ">=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_lessequal: doBinary (p, (const char *) "<=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_componentref: doComponentRefC (p, n->componentrefF.rec, n->componentrefF.field); break; case decl_pointerref: doPointerRefC (p, n->pointerrefF.ptr, n->pointerrefF.field); break; case decl_cast: doCastC (p, n->binaryF.left, n->binaryF.right); break; case decl_plus: doPolyBinary (p, decl_plus, n->binaryF.left, n->binaryF.right, FALSE, FALSE); break; case decl_sub: doPolyBinary (p, decl_sub, n->binaryF.left, n->binaryF.right, FALSE, FALSE); break; case decl_div: doBinary (p, (const char *) "/", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_mod: doBinary (p, (const char *) "%", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_mult: doPolyBinary (p, decl_mult, n->binaryF.left, n->binaryF.right, FALSE, FALSE); break; case decl_divide: doPolyBinary (p, decl_divide, n->binaryF.left, n->binaryF.right, FALSE, FALSE); break; case decl_in: doInC (p, n->binaryF.left, n->binaryF.right); break; case decl_and: doBinary (p, (const char *) "&&", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_or: doBinary (p, (const char *) "||", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_literal: doLiteralC (p, n); break; case decl_const: doConstExpr (p, n); break; case decl_enumerationfield: doEnumerationField (p, n); break; case decl_string: doStringC (p, n); break; case decl_var: doVar (p, n); break; case decl_arrayref: doArrayRef (p, n); break; case decl_funccall: doFuncExprC (p, n); break; case decl_procedure: doProcedure (p, n); break; case decl_recordfield: doRecordfield (p, n); break; case decl_setvalue: doSetValueC (p, n); break; case decl_char: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_complex: case decl_longcomplex: case decl_shortcomplex: case decl_real: case decl_longreal: case decl_shortreal: case decl_bitset: case decl_boolean: case decl_proc: doBaseC (p, n); break; case decl_address: case decl_loc: case decl_byte: case decl_word: case decl_csizet: case decl_cssizet: doSystemC (p, n); break; case decl_type: doTypeNameC (p, n); break; case decl_pointer: doTypeNameC (p, n); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* doExprCup - */ static void doExprCup (mcPretty_pretty p, decl_node n, unsigned int unpackProc) { decl_node t; doExprC (p, n); if (unpackProc) { t = decl_skipType (getExprType (n)); if ((t != NULL) && (isAProcType (t))) { outText (p, (const char *) ".proc", 5); } } } /* doExprM2 - */ static void doExprM2 (mcPretty_pretty p, decl_node n) { mcDebug_assert (n != NULL); switch (n->kind) { case decl_nil: outText (p, (const char *) "NIL", 3); break; case decl_true: outText (p, (const char *) "TRUE", 4); break; case decl_false: outText (p, (const char *) "FALSE", 5); break; case decl_constexp: doUnary (p, (const char *) "", 0, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE); break; case decl_neg: doUnary (p, (const char *) "-", 1, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE); break; case decl_not: doUnary (p, (const char *) "NOT", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_adr: doUnary (p, (const char *) "ADR", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_size: doUnary (p, (const char *) "SIZE", 4, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_tsize: doUnary (p, (const char *) "TSIZE", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_float: doUnary (p, (const char *) "FLOAT", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_trunc: doUnary (p, (const char *) "TRUNC", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_ord: doUnary (p, (const char *) "ORD", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_chr: doUnary (p, (const char *) "CHR", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_cap: doUnary (p, (const char *) "CAP", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_high: doUnary (p, (const char *) "HIGH", 4, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_re: doUnary (p, (const char *) "RE", 2, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_im: doUnary (p, (const char *) "IM", 2, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_deref: doPostUnary (p, (const char *) "^", 1, n->unaryF.arg); break; case decl_equal: doBinary (p, (const char *) "=", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_notequal: doBinary (p, (const char *) "#", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_less: doBinary (p, (const char *) "<", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_greater: doBinary (p, (const char *) ">", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_greequal: doBinary (p, (const char *) ">=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_lessequal: doBinary (p, (const char *) "<=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_componentref: doBinary (p, (const char *) ".", 1, n->componentrefF.rec, n->componentrefF.field, FALSE, FALSE, FALSE); break; case decl_pointerref: doBinary (p, (const char *) "^.", 2, n->pointerrefF.ptr, n->pointerrefF.field, FALSE, FALSE, FALSE); break; case decl_cast: doPreBinary (p, (const char *) "CAST", 4, n->binaryF.left, n->binaryF.right, TRUE, TRUE); break; case decl_val: doPreBinary (p, (const char *) "VAL", 3, n->binaryF.left, n->binaryF.right, TRUE, TRUE); break; case decl_cmplx: doPreBinary (p, (const char *) "CMPLX", 5, n->binaryF.left, n->binaryF.right, TRUE, TRUE); break; case decl_plus: doBinary (p, (const char *) "+", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE); break; case decl_sub: doBinary (p, (const char *) "-", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE); break; case decl_div: doBinary (p, (const char *) "DIV", 3, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_mod: doBinary (p, (const char *) "MOD", 3, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); break; case decl_mult: doBinary (p, (const char *) "*", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE); break; case decl_divide: doBinary (p, (const char *) "/", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE); break; case decl_literal: doLiteral (p, n); break; case decl_const: doConstExpr (p, n); break; case decl_enumerationfield: doEnumerationField (p, n); break; case decl_string: doString (p, n); break; case decl_max: doUnary (p, (const char *) "MAX", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_min: doUnary (p, (const char *) "MIN", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); break; case decl_var: doVar (p, n); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* doVar - */ static void doVar (mcPretty_pretty p, decl_node n) { mcDebug_assert (decl_isVar (n)); if (n->varF.isVarParameter) { outText (p, (const char *) "(*", 2); doFQDNameC (p, n, TRUE); outText (p, (const char *) ")", 1); } else { doFQDNameC (p, n, TRUE); } } /* doLiteralC - */ static void doLiteralC (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; mcDebug_assert (decl_isLiteral (n)); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); if (n->literalF.type == charN) { if ((DynamicStrings_char (s, -1)) == 'C') { s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); if ((DynamicStrings_char (s, 0)) != '0') { s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0", 1), DynamicStrings_Mark (s)); } } outText (p, (const char *) "(char)", 6); mcPretty_setNeedSpace (p); } else if ((DynamicStrings_char (s, -1)) == 'H') { /* avoid dangling else. */ outText (p, (const char *) "0x", 2); s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); } else if ((DynamicStrings_char (s, -1)) == 'B') { /* avoid dangling else. */ outText (p, (const char *) "0", 1); s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); } outTextS (p, s); s = DynamicStrings_KillString (s); } /* doLiteral - */ static void doLiteral (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; mcDebug_assert (decl_isLiteral (n)); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); if (n->literalF.type == charN) { if ((DynamicStrings_char (s, -1)) == 'C') { s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); if ((DynamicStrings_char (s, 0)) != '0') { s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0", 1), DynamicStrings_Mark (s)); } } outText (p, (const char *) "(char)", 6); mcPretty_setNeedSpace (p); } outTextS (p, s); s = DynamicStrings_KillString (s); } /* isString - returns TRUE if node, n, is a string. */ static unsigned int isString (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_string; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doString - */ static void doString (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; mcDebug_assert (isString (n)); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); outTextS (p, s); s = DynamicStrings_KillString (s); /* IF DynamicStrings.Index (s, '"', 0)=-1 THEN outText (p, '"') ; outTextS (p, s) ; outText (p, '"') ELSIF DynamicStrings.Index (s, "'", 0)=-1 THEN outText (p, '"') ; outTextS (p, s) ; outText (p, '"') ELSE metaError1 ('illegal string {%1k}', n) END */ M2RTS_HALT (-1); __builtin_unreachable (); } /* replaceChar - replace every occurance of, ch, by, a and return modified string, s. */ static DynamicStrings_String replaceChar (DynamicStrings_String s, char ch, const char *a_, unsigned int _a_high) { int i; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); i = 0; for (;;) { i = DynamicStrings_Index (s, ch, static_cast (i)); if (i == 0) { s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) a, _a_high), DynamicStrings_Slice (s, 1, 0)); i = StrLib_StrLen ((const char *) a, _a_high); } else if (i > 0) { /* avoid dangling else. */ 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)); i += StrLib_StrLen ((const char *) a, _a_high); } else { /* avoid dangling else. */ return s; } } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* toCstring - translates string, n, into a C string and returns the new String. */ static DynamicStrings_String toCstring (nameKey_Name n) { DynamicStrings_String s; s = DynamicStrings_Slice (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)), 1, -1); return replaceChar (replaceChar (s, '\\', (const char *) "\\\\", 2), '"', (const char *) "\\\"", 2); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* toCchar - */ static DynamicStrings_String toCchar (nameKey_Name n) { DynamicStrings_String s; s = DynamicStrings_Slice (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)), 1, -1); return replaceChar (replaceChar (s, '\\', (const char *) "\\\\", 2), '\'', (const char *) "\\'", 2); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* countChar - */ static unsigned int countChar (DynamicStrings_String s, char ch) { int i; unsigned int c; c = 0; i = 0; for (;;) { i = DynamicStrings_Index (s, ch, static_cast (i)); if (i >= 0) { i += 1; c += 1; } else { return c; } } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* lenCstring - */ static unsigned int lenCstring (DynamicStrings_String s) { return (DynamicStrings_Length (s))-(countChar (s, '\\')); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* outCstring - */ static void outCstring (mcPretty_pretty p, decl_node s, unsigned int aString) { if (aString) { outText (p, (const char *) "\"", 1); outRawS (p, s->stringF.cstring); outText (p, (const char *) "\"", 1); } else { outText (p, (const char *) "'", 1); outRawS (p, s->stringF.cchar); outText (p, (const char *) "'", 1); } } /* doStringC - */ static void doStringC (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; mcDebug_assert (isString (n)); /* s := InitStringCharStar (keyToCharStar (getSymName (n))) ; IF DynamicStrings.Length (s)>3 THEN IF DynamicStrings.Index (s, '"', 0)=-1 THEN s := DynamicStrings.Slice (s, 1, -1) ; outText (p, '"') ; outCstring (p, s) ; outText (p, '"') ELSIF DynamicStrings.Index (s, "'", 0)=-1 THEN s := DynamicStrings.Slice (s, 1, -1) ; outText (p, '"') ; outCstring (p, s) ; outText (p, '"') ELSE metaError1 ('illegal string {%1k}', n) END ELSIF DynamicStrings.Length (s) = 3 THEN s := DynamicStrings.Slice (s, 1, -1) ; outText (p, "'") ; IF DynamicStrings.char (s, 0) = "'" THEN outText (p, "\'") ELSIF DynamicStrings.char (s, 0) = "\" THEN outText (p, "\\") ELSE outTextS (p, s) END ; outText (p, "'") ELSE outText (p, "'\0'") END ; s := KillString (s) */ outCstring (p, n, ! n->stringF.isCharCompatible); } /* isPunct - */ static unsigned int isPunct (char ch) { return (((((((((ch == '.') || (ch == '(')) || (ch == ')')) || (ch == '^')) || (ch == ':')) || (ch == ';')) || (ch == '{')) || (ch == '}')) || (ch == ',')) || (ch == '*'); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isWhite - */ static unsigned int isWhite (char ch) { return ((ch == ' ') || (ch == ASCII_tab)) || (ch == ASCII_lf); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* outText - */ static void outText (mcPretty_pretty p, const char *a_, unsigned int _a_high) { DynamicStrings_String s; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); s = DynamicStrings_InitString ((const char *) a, _a_high); outTextS (p, s); s = DynamicStrings_KillString (s); } /* outRawS - */ static void outRawS (mcPretty_pretty p, DynamicStrings_String s) { mcPretty_raw (p, s); } /* outKm2 - */ static mcPretty_pretty outKm2 (mcPretty_pretty p, const char *a_, unsigned int _a_high) { unsigned int i; DynamicStrings_String s; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); if (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "RECORD", 6)) { p = mcPretty_pushPretty (p); i = mcPretty_getcurpos (p); mcPretty_setindent (p, i); outText (p, (const char *) a, _a_high); p = mcPretty_pushPretty (p); mcPretty_setindent (p, i+indentation); } else if (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "END", 3)) { /* avoid dangling else. */ p = mcPretty_popPretty (p); outText (p, (const char *) a, _a_high); p = mcPretty_popPretty (p); } return p; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* outKc - */ static mcPretty_pretty outKc (mcPretty_pretty p, const char *a_, unsigned int _a_high) { int i; unsigned int c; DynamicStrings_String s; DynamicStrings_String t; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); s = DynamicStrings_InitString ((const char *) a, _a_high); i = DynamicStrings_Index (s, '\\', 0); if (i == -1) { t = NULL; } else { t = DynamicStrings_Slice (s, i, 0); s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i); } if ((DynamicStrings_char (s, 0)) == '{') { p = mcPretty_pushPretty (p); c = mcPretty_getcurpos (p); mcPretty_setindent (p, c); outTextS (p, s); p = mcPretty_pushPretty (p); mcPretty_setindent (p, c+indentationC); } else if ((DynamicStrings_char (s, 0)) == '}') { /* avoid dangling else. */ p = mcPretty_popPretty (p); outTextS (p, s); p = mcPretty_popPretty (p); } outTextS (p, t); t = DynamicStrings_KillString (t); s = DynamicStrings_KillString (s); return p; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* outTextS - */ static void outTextS (mcPretty_pretty p, DynamicStrings_String s) { if (s != NULL) { mcPretty_prints (p, s); } } /* outCard - */ static void outCard (mcPretty_pretty p, unsigned int c) { DynamicStrings_String s; s = StringConvert_CardinalToString (c, 0, ' ', 10, FALSE); outTextS (p, s); s = DynamicStrings_KillString (s); } /* outTextN - */ static void outTextN (mcPretty_pretty p, nameKey_Name n) { DynamicStrings_String s; s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); mcPretty_prints (p, s); s = DynamicStrings_KillString (s); } /* doTypeAliasC - */ static void doTypeAliasC (mcPretty_pretty p, decl_node n, decl_node *m) { mcPretty_print (p, (const char *) "typedef", 7); mcPretty_setNeedSpace (p); if ((decl_isTypeHidden (n)) && ((decl_isDef (decl_getMainModule ())) || ((decl_getScope (n)) != (decl_getMainModule ())))) { outText (p, (const char *) "void *", 6); } else { doTypeC (p, decl_getType (n), m); } if ((*m) != NULL) { doFQNameC (p, (*m)); } mcPretty_print (p, (const char *) ";\\n\\n", 5); } /* doEnumerationC - */ static void doEnumerationC (mcPretty_pretty p, decl_node n) { unsigned int i; unsigned int h; decl_node s; DynamicStrings_String t; outText (p, (const char *) "enum {", 6); i = Indexing_LowIndice (n->enumerationF.listOfSons); h = Indexing_HighIndice (n->enumerationF.listOfSons); while (i <= h) { s = static_cast (Indexing_GetIndice (n->enumerationF.listOfSons, i)); doFQDNameC (p, s, FALSE); if (i < h) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); } i += 1; } outText (p, (const char *) "}", 1); } /* doNamesC - */ static void doNamesC (mcPretty_pretty p, nameKey_Name n) { DynamicStrings_String s; s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); outTextS (p, s); s = DynamicStrings_KillString (s); } /* doNameC - */ static void doNameC (mcPretty_pretty p, decl_node n) { if ((n != NULL) && ((decl_getSymName (n)) != nameKey_NulName)) { doNamesC (p, decl_getSymName (n)); } } /* initCname - */ static void initCname (decl_cnameT *c) { (*c).init = FALSE; } /* doCname - */ static nameKey_Name doCname (nameKey_Name n, decl_cnameT *c, unsigned int scopes) { DynamicStrings_String s; if ((*c).init) { return (*c).name; } else { (*c).init = TRUE; s = keyc_cname (n, scopes); if (s == NULL) { (*c).name = n; } else { (*c).name = nameKey_makekey (DynamicStrings_string (s)); s = DynamicStrings_KillString (s); } return (*c).name; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getDName - */ static nameKey_Name getDName (decl_node n, unsigned int scopes) { nameKey_Name m; m = decl_getSymName (n); switch (n->kind) { case decl_procedure: return doCname (m, &n->procedureF.cname, scopes); break; case decl_var: return doCname (m, &n->varF.cname, scopes); break; case decl_recordfield: return doCname (m, &n->recordfieldF.cname, scopes); break; case decl_enumerationfield: return doCname (m, &n->enumerationfieldF.cname, scopes); break; default: break; } return m; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doDNameC - */ static void doDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes) { if ((n != NULL) && ((decl_getSymName (n)) != nameKey_NulName)) { doNamesC (p, getDName (n, scopes)); } } /* doFQDNameC - */ static void doFQDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes) { DynamicStrings_String s; s = getFQDstring (n, scopes); outTextS (p, s); s = DynamicStrings_KillString (s); } /* doFQNameC - */ static void doFQNameC (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; s = getFQstring (n); outTextS (p, s); s = DynamicStrings_KillString (s); } /* doNameM2 - */ static void doNameM2 (mcPretty_pretty p, decl_node n) { doNameC (p, n); } /* doUsed - */ static void doUsed (mcPretty_pretty p, unsigned int used) { if (! used) { mcPretty_setNeedSpace (p); outText (p, (const char *) "__attribute__((unused))", 23); } } /* doHighC - */ static void doHighC (mcPretty_pretty p, decl_node a, nameKey_Name n, unsigned int isused) { if ((decl_isArray (a)) && (decl_isUnbounded (a))) { /* need to display high. */ mcPretty_print (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); doTypeNameC (p, cardinalN); mcPretty_setNeedSpace (p); mcPretty_print (p, (const char *) "_", 1); outTextN (p, n); mcPretty_print (p, (const char *) "_high", 5); doUsed (p, isused); } } /* doParamConstCast - */ static void doParamConstCast (mcPretty_pretty p, decl_node n) { decl_node ptype; ptype = decl_getType (n); if (((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) && (lang == decl_ansiCP)) { outText (p, (const char *) "const", 5); mcPretty_setNeedSpace (p); } } /* getParameterVariable - returns the variable which shadows the parameter named, m, in parameter block, n. */ static decl_node getParameterVariable (decl_node n, nameKey_Name m) { decl_node p; mcDebug_assert ((decl_isParam (n)) || (decl_isVarParam (n))); if (decl_isParam (n)) { p = n->paramF.scope; } else { p = n->varparamF.scope; } mcDebug_assert (decl_isProcedure (p)); return decl_lookupInScope (p, m); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doParamTypeEmit - emit parameter type for C/C++. It checks to see if the parameter type is a procedure type and if it were declared in a definition module for "C" and if so it uses the "C" definition for a procedure type, rather than the mc C++ version. */ static void doParamTypeEmit (mcPretty_pretty p, decl_node paramnode, decl_node paramtype) { mcDebug_assert ((decl_isParam (paramnode)) || (decl_isVarParam (paramnode))); if ((isForC (paramnode)) && (decl_isProcType (decl_skipType (paramtype)))) { doFQNameC (p, paramtype); outText (p, (const char *) "_C", 2); } else { doTypeNameC (p, paramtype); } } /* doParamC - emit parameter for C/C++. */ static void doParamC (mcPretty_pretty p, decl_node n) { decl_node v; decl_node ptype; nameKey_Name i; unsigned int c; unsigned int t; wlists_wlist l; mcDebug_assert (decl_isParam (n)); ptype = decl_getType (n); if (n->paramF.namelist == NULL) { /* avoid dangling else. */ doParamConstCast (p, n); doTypeNameC (p, ptype); doUsed (p, n->paramF.isUsed); if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "unsigned int", 12); } } else { mcDebug_assert (isIdentList (n->paramF.namelist)); l = n->paramF.namelist->identlistF.names; if (l == NULL) { /* avoid dangling else. */ doParamConstCast (p, n); doParamTypeEmit (p, n, ptype); if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) { doUsed (p, n->paramF.isUsed); outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "unsigned int", 12); } } else { t = wlists_noOfItemsInList (l); c = 1; while (c <= t) { doParamConstCast (p, n); doParamTypeEmit (p, n, ptype); i = static_cast (wlists_getItemFromList (l, c)); if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) { mcPretty_noSpace (p); } else { mcPretty_setNeedSpace (p); } v = getParameterVariable (n, i); if (v == NULL) { doNamesC (p, keyc_cnamen (i, TRUE)); } else { doFQDNameC (p, v, TRUE); } if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) { outText (p, (const char *) "_", 1); } doUsed (p, n->paramF.isUsed); doHighC (p, ptype, i, n->paramF.isUsed); if (c < t) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); } c += 1; } } } } /* doVarParamC - emit a VAR parameter for C/C++. */ static void doVarParamC (mcPretty_pretty p, decl_node n) { decl_node v; decl_node ptype; nameKey_Name i; unsigned int c; unsigned int t; wlists_wlist l; mcDebug_assert (decl_isVarParam (n)); ptype = decl_getType (n); if (n->varparamF.namelist == NULL) { /* avoid dangling else. */ doTypeNameC (p, ptype); /* doTypeC (p, ptype, n) ; */ if (! (decl_isArray (ptype))) { mcPretty_setNeedSpace (p); outText (p, (const char *) "*", 1); } doUsed (p, n->varparamF.isUsed); if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "unsigned int", 12); } } else { mcDebug_assert (isIdentList (n->varparamF.namelist)); l = n->varparamF.namelist->identlistF.names; if (l == NULL) { doParamTypeEmit (p, n, ptype); doUsed (p, n->varparamF.isUsed); } else { t = wlists_noOfItemsInList (l); c = 1; while (c <= t) { doParamTypeEmit (p, n, ptype); if (! (decl_isArray (ptype))) { mcPretty_setNeedSpace (p); outText (p, (const char *) "*", 1); } i = static_cast (wlists_getItemFromList (l, c)); v = getParameterVariable (n, i); if (v == NULL) { doNamesC (p, keyc_cnamen (i, TRUE)); } else { doFQDNameC (p, v, TRUE); } doUsed (p, n->varparamF.isUsed); doHighC (p, ptype, i, n->varparamF.isUsed); if (c < t) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); } c += 1; } } } } /* doOptargC - */ static void doOptargC (mcPretty_pretty p, decl_node n) { decl_node ptype; nameKey_Name i; unsigned int t; wlists_wlist l; mcDebug_assert (decl_isOptarg (n)); ptype = decl_getType (n); mcDebug_assert (n->optargF.namelist != NULL); mcDebug_assert (isIdentList (n->paramF.namelist)); l = n->paramF.namelist->identlistF.names; mcDebug_assert (l != NULL); t = wlists_noOfItemsInList (l); mcDebug_assert (t == 1); doTypeNameC (p, ptype); i = static_cast (wlists_getItemFromList (l, 1)); mcPretty_setNeedSpace (p); doNamesC (p, i); } /* doParameterC - */ static void doParameterC (mcPretty_pretty p, decl_node n) { if (decl_isParam (n)) { doParamC (p, n); } else if (decl_isVarParam (n)) { /* avoid dangling else. */ doVarParamC (p, n); } else if (decl_isVarargs (n)) { /* avoid dangling else. */ mcPretty_print (p, (const char *) "...", 3); } else if (decl_isOptarg (n)) { /* avoid dangling else. */ doOptargC (p, n); } } /* doProcTypeC - */ static void doProcTypeC (mcPretty_pretty p, decl_node t, decl_node n) { mcDebug_assert (decl_isType (t)); outputPartial (t); doCompletePartialProcType (p, t, n); } /* doTypesC - */ static void doTypesC (decl_node n) { decl_node m; if (decl_isType (n)) { m = decl_getType (n); if (decl_isProcType (m)) { doProcTypeC (doP, n, m); } else if ((decl_isType (m)) || (decl_isPointer (m))) { /* avoid dangling else. */ outText (doP, (const char *) "typedef", 7); mcPretty_setNeedSpace (doP); doTypeC (doP, m, &m); if (decl_isType (m)) { mcPretty_setNeedSpace (doP); } doTypeNameC (doP, n); outText (doP, (const char *) ";\\n\\n", 5); } else if (decl_isEnumeration (m)) { /* avoid dangling else. */ outText (doP, (const char *) "typedef", 7); mcPretty_setNeedSpace (doP); doTypeC (doP, m, &m); mcPretty_setNeedSpace (doP); doTypeNameC (doP, n); outText (doP, (const char *) ";\\n\\n", 5); } else { /* avoid dangling else. */ outText (doP, (const char *) "typedef", 7); mcPretty_setNeedSpace (doP); doTypeC (doP, m, &m); if (decl_isType (m)) { mcPretty_setNeedSpace (doP); } doTypeNameC (doP, n); outText (doP, (const char *) ";\\n\\n", 5); } } } /* doCompletePartialC - */ static void doCompletePartialC (decl_node n) { decl_node m; if (decl_isType (n)) { m = decl_getType (n); if (decl_isRecord (m)) { doCompletePartialRecord (doP, n, m); } else if (decl_isArray (m)) { /* avoid dangling else. */ doCompletePartialArray (doP, n, m); } else if (decl_isProcType (m)) { /* avoid dangling else. */ doCompletePartialProcType (doP, n, m); } } } /* doCompletePartialRecord - */ static void doCompletePartialRecord (mcPretty_pretty p, decl_node t, decl_node r) { unsigned int i; unsigned int h; decl_node f; mcDebug_assert (decl_isRecord (r)); mcDebug_assert (decl_isType (t)); outText (p, (const char *) "struct", 6); mcPretty_setNeedSpace (p); doFQNameC (p, t); outText (p, (const char *) "_r", 2); mcPretty_setNeedSpace (p); p = outKc (p, (const char *) "{\\n", 3); i = Indexing_LowIndice (r->recordF.listOfSons); h = Indexing_HighIndice (r->recordF.listOfSons); while (i <= h) { f = static_cast (Indexing_GetIndice (r->recordF.listOfSons, i)); if (decl_isRecordField (f)) { /* avoid dangling else. */ if (! f->recordfieldF.tag) { mcPretty_setNeedSpace (p); doRecordFieldC (p, f); outText (p, (const char *) ";\\n", 3); } } else if (decl_isVarient (f)) { /* avoid dangling else. */ doVarientC (p, f); outText (p, (const char *) ";\\n", 3); } else if (decl_isVarientField (f)) { /* avoid dangling else. */ doVarientFieldC (p, f); } i += 1; } p = outKc (p, (const char *) "};\\n\\n", 6); } /* doCompletePartialArray - */ static void doCompletePartialArray (mcPretty_pretty p, decl_node t, decl_node r) { decl_node type; decl_node s; mcDebug_assert (decl_isArray (r)); type = r->arrayF.type; s = NULL; outText (p, (const char *) "struct", 6); mcPretty_setNeedSpace (p); doFQNameC (p, t); outText (p, (const char *) "_a {", 4); mcPretty_setNeedSpace (p); doTypeC (p, type, &s); mcPretty_setNeedSpace (p); outText (p, (const char *) "array[", 6); doSubrC (p, r->arrayF.subr); outText (p, (const char *) "];", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "};\\n", 4); } /* lookupConst - */ static decl_node lookupConst (decl_node type, nameKey_Name n) { return decl_makeLiteralInt (n); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doMin - */ static decl_node doMin (decl_node n) { if (n == booleanN) { return falseN; } else if (n == integerN) { /* avoid dangling else. */ keyc_useIntMin (); return lookupConst (integerN, nameKey_makeKey ((const char *) "INT_MIN", 7)); } else if (n == cardinalN) { /* avoid dangling else. */ keyc_useUIntMin (); return lookupConst (cardinalN, nameKey_makeKey ((const char *) "UINT_MIN", 8)); } else if (n == longintN) { /* avoid dangling else. */ keyc_useLongMin (); return lookupConst (longintN, nameKey_makeKey ((const char *) "LONG_MIN", 8)); } else if (n == longcardN) { /* avoid dangling else. */ keyc_useULongMin (); return lookupConst (longcardN, nameKey_makeKey ((const char *) "LONG_MIN", 8)); } else if (n == charN) { /* avoid dangling else. */ keyc_useCharMin (); return lookupConst (charN, nameKey_makeKey ((const char *) "CHAR_MIN", 8)); } else if (n == bitsetN) { /* avoid dangling else. */ mcDebug_assert (decl_isSubrange (bitnumN)); return bitnumN->subrangeF.low; } else if (n == locN) { /* avoid dangling else. */ keyc_useUCharMin (); return lookupConst (locN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9)); } else if (n == byteN) { /* avoid dangling else. */ keyc_useUCharMin (); return lookupConst (byteN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9)); } else if (n == wordN) { /* avoid dangling else. */ keyc_useUIntMin (); return lookupConst (wordN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9)); } else if (n == addressN) { /* avoid dangling else. */ return lookupConst (addressN, nameKey_makeKey ((const char *) "((void *) 0)", 12)); } else { /* avoid dangling else. */ M2RTS_HALT (-1); /* finish the cacading elsif statement. */ __builtin_unreachable (); } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* doMax - */ static decl_node doMax (decl_node n) { if (n == booleanN) { return trueN; } else if (n == integerN) { /* avoid dangling else. */ keyc_useIntMax (); return lookupConst (integerN, nameKey_makeKey ((const char *) "INT_MAX", 7)); } else if (n == cardinalN) { /* avoid dangling else. */ keyc_useUIntMax (); return lookupConst (cardinalN, nameKey_makeKey ((const char *) "UINT_MAX", 8)); } else if (n == longintN) { /* avoid dangling else. */ keyc_useLongMax (); return lookupConst (longintN, nameKey_makeKey ((const char *) "LONG_MAX", 8)); } else if (n == longcardN) { /* avoid dangling else. */ keyc_useULongMax (); return lookupConst (longcardN, nameKey_makeKey ((const char *) "ULONG_MAX", 9)); } else if (n == charN) { /* avoid dangling else. */ keyc_useCharMax (); return lookupConst (charN, nameKey_makeKey ((const char *) "CHAR_MAX", 8)); } else if (n == bitsetN) { /* avoid dangling else. */ mcDebug_assert (decl_isSubrange (bitnumN)); return bitnumN->subrangeF.high; } else if (n == locN) { /* avoid dangling else. */ keyc_useUCharMax (); return lookupConst (locN, nameKey_makeKey ((const char *) "UCHAR_MAX", 9)); } else if (n == byteN) { /* avoid dangling else. */ keyc_useUCharMax (); return lookupConst (byteN, nameKey_makeKey ((const char *) "UCHAR_MAX", 9)); } else if (n == wordN) { /* avoid dangling else. */ keyc_useUIntMax (); return lookupConst (wordN, nameKey_makeKey ((const char *) "UINT_MAX", 8)); } else if (n == addressN) { /* avoid dangling else. */ mcMetaError_metaError1 ((const char *) "trying to obtain MAX ({%1ad}) is illegal", 40, (const unsigned char *) &n, (sizeof (n)-1)); return NULL; } else { /* avoid dangling else. */ M2RTS_HALT (-1); /* finish the cacading elsif statement. */ __builtin_unreachable (); } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* getMax - */ static decl_node getMax (decl_node n) { n = decl_skipType (n); if (decl_isSubrange (n)) { return n->subrangeF.high; } else if (decl_isEnumeration (n)) { /* avoid dangling else. */ return n->enumerationF.high; } else { /* avoid dangling else. */ mcDebug_assert (isOrdinal (n)); return doMax (n); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getMin - */ static decl_node getMin (decl_node n) { n = decl_skipType (n); if (decl_isSubrange (n)) { return n->subrangeF.low; } else if (decl_isEnumeration (n)) { /* avoid dangling else. */ return n->enumerationF.low; } else { /* avoid dangling else. */ mcDebug_assert (isOrdinal (n)); return doMin (n); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doSubtractC - */ static void doSubtractC (mcPretty_pretty p, decl_node s) { if (! (isZero (s))) { outText (p, (const char *) "-", 1); doExprC (p, s); } } /* doSubrC - */ static void doSubrC (mcPretty_pretty p, decl_node s) { decl_node low; decl_node high; s = decl_skipType (s); if (isOrdinal (s)) { low = getMin (s); high = getMax (s); doExprC (p, high); doSubtractC (p, low); outText (p, (const char *) "+1", 2); } else if (decl_isEnumeration (s)) { /* avoid dangling else. */ low = getMin (s); high = getMax (s); doExprC (p, high); doSubtractC (p, low); outText (p, (const char *) "+1", 2); } else { /* avoid dangling else. */ mcDebug_assert (decl_isSubrange (s)); if ((s->subrangeF.high == NULL) || (s->subrangeF.low == NULL)) { doSubrC (p, decl_getType (s)); } else { doExprC (p, s->subrangeF.high); doSubtractC (p, s->subrangeF.low); outText (p, (const char *) "+1", 2); } } } /* doCompletePartialProcType - */ static void doCompletePartialProcType (mcPretty_pretty p, decl_node t, decl_node n) { unsigned int i; unsigned int h; decl_node v; decl_node u; mcDebug_assert (decl_isProcType (n)); u = NULL; outText (p, (const char *) "typedef", 7); mcPretty_setNeedSpace (p); doTypeC (p, n->proctypeF.returnType, &u); mcPretty_setNeedSpace (p); outText (p, (const char *) "(*", 2); doFQNameC (p, t); outText (p, (const char *) "_t) (", 5); i = Indexing_LowIndice (n->proctypeF.parameters); h = Indexing_HighIndice (n->proctypeF.parameters); while (i <= h) { v = static_cast (Indexing_GetIndice (n->proctypeF.parameters, i)); doParameterC (p, v); mcPretty_noSpace (p); if (i < h) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); } i += 1; } if (h == 0) { outText (p, (const char *) "void", 4); } outText (p, (const char *) ");\\n", 4); if (isDefForCNode (n)) { /* emit a C named type which differs from the m2 proctype. */ outText (p, (const char *) "typedef", 7); mcPretty_setNeedSpace (p); doFQNameC (p, t); outText (p, (const char *) "_t", 2); mcPretty_setNeedSpace (p); doFQNameC (p, t); outText (p, (const char *) "_C;\\n\\n", 7); } outText (p, (const char *) "struct", 6); mcPretty_setNeedSpace (p); doFQNameC (p, t); outText (p, (const char *) "_p {", 4); mcPretty_setNeedSpace (p); doFQNameC (p, t); outText (p, (const char *) "_t proc; };\\n\\n", 15); } /* isBase - */ static unsigned int isBase (decl_node n) { switch (n->kind) { case decl_char: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_complex: case decl_longcomplex: case decl_shortcomplex: case decl_real: case decl_longreal: case decl_shortreal: case decl_bitset: case decl_boolean: case decl_proc: return TRUE; break; default: return FALSE; break; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doBaseC - */ static void doBaseC (mcPretty_pretty p, decl_node n) { switch (n->kind) { case decl_char: outText (p, (const char *) "char", 4); break; case decl_cardinal: outText (p, (const char *) "unsigned int", 12); break; case decl_longcard: outText (p, (const char *) "long unsigned int", 17); break; case decl_shortcard: outText (p, (const char *) "short unsigned int", 18); break; case decl_integer: outText (p, (const char *) "int", 3); break; case decl_longint: outText (p, (const char *) "long int", 8); break; case decl_shortint: outText (p, (const char *) "short int", 9); break; case decl_complex: outText (p, (const char *) "double complex", 14); break; case decl_longcomplex: outText (p, (const char *) "long double complex", 19); break; case decl_shortcomplex: outText (p, (const char *) "float complex", 13); break; case decl_real: outText (p, (const char *) "double", 6); break; case decl_longreal: outText (p, (const char *) "long double", 11); break; case decl_shortreal: outText (p, (const char *) "float", 5); break; case decl_bitset: outText (p, (const char *) "unsigned int", 12); break; case decl_boolean: outText (p, (const char *) "unsigned int", 12); break; case decl_proc: outText (p, (const char *) "PROC", 4); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } mcPretty_setNeedSpace (p); } /* isSystem - */ static unsigned int isSystem (decl_node n) { switch (n->kind) { case decl_address: return TRUE; break; case decl_loc: return TRUE; break; case decl_byte: return TRUE; break; case decl_word: return TRUE; break; case decl_csizet: return TRUE; break; case decl_cssizet: return TRUE; break; default: return FALSE; break; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doSystemC - */ static void doSystemC (mcPretty_pretty p, decl_node n) { switch (n->kind) { case decl_address: outText (p, (const char *) "void *", 6); break; case decl_loc: outText (p, (const char *) "unsigned char", 13); mcPretty_setNeedSpace (p); break; case decl_byte: outText (p, (const char *) "unsigned char", 13); mcPretty_setNeedSpace (p); break; case decl_word: outText (p, (const char *) "unsigned int", 12); mcPretty_setNeedSpace (p); break; case decl_csizet: outText (p, (const char *) "size_t", 6); mcPretty_setNeedSpace (p); keyc_useSize_t (); break; case decl_cssizet: outText (p, (const char *) "ssize_t", 7); mcPretty_setNeedSpace (p); keyc_useSSize_t (); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* doArrayC - */ static void doArrayC (mcPretty_pretty p, decl_node n) { decl_node t; decl_node s; decl_node u; mcDebug_assert (decl_isArray (n)); t = n->arrayF.type; s = n->arrayF.subr; u = NULL; if (s == NULL) { doTypeC (p, t, &u); mcPretty_setNeedSpace (p); outText (p, (const char *) "*", 1); } else { outText (p, (const char *) "struct", 6); mcPretty_setNeedSpace (p); outText (p, (const char *) "{", 1); mcPretty_setNeedSpace (p); doTypeC (p, t, &u); mcPretty_setNeedSpace (p); outText (p, (const char *) "array[", 6); if (isZero (getMin (s))) { doExprC (p, getMax (s)); } else { doExprC (p, getMax (s)); doSubtractC (p, getMin (s)); } outText (p, (const char *) "];", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "}", 1); mcPretty_setNeedSpace (p); } } /* doPointerC - */ static void doPointerC (mcPretty_pretty p, decl_node n, decl_node *m) { decl_node t; decl_node s; t = n->pointerF.type; s = NULL; doTypeC (p, t, &s); mcPretty_setNeedSpace (p); outText (p, (const char *) "*", 1); } /* doRecordFieldC - */ static void doRecordFieldC (mcPretty_pretty p, decl_node f) { decl_node m; m = NULL; mcPretty_setNeedSpace (p); doTypeC (p, f->recordfieldF.type, &m); doDNameC (p, f, FALSE); } /* doVarientFieldC - */ static void doVarientFieldC (mcPretty_pretty p, decl_node n) { unsigned int i; unsigned int t; decl_node q; mcDebug_assert (decl_isVarientField (n)); if (! n->varientfieldF.simple) { outText (p, (const char *) "struct", 6); mcPretty_setNeedSpace (p); p = outKc (p, (const char *) "{\\n", 3); } i = Indexing_LowIndice (n->varientfieldF.listOfSons); t = Indexing_HighIndice (n->varientfieldF.listOfSons); while (i <= t) { q = static_cast (Indexing_GetIndice (n->varientfieldF.listOfSons, i)); if (decl_isRecordField (q)) { /* avoid dangling else. */ if (! q->recordfieldF.tag) { doRecordFieldC (p, q); outText (p, (const char *) ";\\n", 3); } } else if (decl_isVarient (q)) { /* avoid dangling else. */ doVarientC (p, q); outText (p, (const char *) ";\\n", 3); } else { /* avoid dangling else. */ M2RTS_HALT (-1); __builtin_unreachable (); } i += 1; } if (! n->varientfieldF.simple) { p = outKc (p, (const char *) "};\\n", 4); } } /* doVarientC - */ static void doVarientC (mcPretty_pretty p, decl_node n) { unsigned int i; unsigned int t; decl_node q; mcDebug_assert (decl_isVarient (n)); if (n->varientF.tag != NULL) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if (decl_isRecordField (n->varientF.tag)) { doRecordFieldC (p, n->varientF.tag); outText (p, (const char *) "; /* case tag */\\n", 19); } else if (decl_isVarientField (n->varientF.tag)) { /* avoid dangling else. */ /* doVarientFieldC (p, n^.varientF.tag) */ M2RTS_HALT (-1); __builtin_unreachable (); } else { /* avoid dangling else. */ M2RTS_HALT (-1); __builtin_unreachable (); } } outText (p, (const char *) "union", 5); mcPretty_setNeedSpace (p); p = outKc (p, (const char *) "{\\n", 3); i = Indexing_LowIndice (n->varientF.listOfSons); t = Indexing_HighIndice (n->varientF.listOfSons); while (i <= t) { q = static_cast (Indexing_GetIndice (n->varientF.listOfSons, i)); if (decl_isRecordField (q)) { /* avoid dangling else. */ if (! q->recordfieldF.tag) { doRecordFieldC (p, q); outText (p, (const char *) ";\\n", 3); } } else if (decl_isVarientField (q)) { /* avoid dangling else. */ doVarientFieldC (p, q); } else { /* avoid dangling else. */ M2RTS_HALT (-1); __builtin_unreachable (); } i += 1; } p = outKc (p, (const char *) "}", 1); } /* doRecordC - */ static void doRecordC (mcPretty_pretty p, decl_node n, decl_node *m) { unsigned int i; unsigned int h; decl_node f; mcDebug_assert (decl_isRecord (n)); outText (p, (const char *) "struct", 6); mcPretty_setNeedSpace (p); p = outKc (p, (const char *) "{", 1); i = Indexing_LowIndice (n->recordF.listOfSons); h = Indexing_HighIndice (n->recordF.listOfSons); mcPretty_setindent (p, (mcPretty_getcurpos (p))+indentation); outText (p, (const char *) "\\n", 2); while (i <= h) { f = static_cast (Indexing_GetIndice (n->recordF.listOfSons, i)); if (decl_isRecordField (f)) { /* avoid dangling else. */ if (! f->recordfieldF.tag) { doRecordFieldC (p, f); outText (p, (const char *) ";\\n", 3); } } else if (decl_isVarient (f)) { /* avoid dangling else. */ doVarientC (p, f); outText (p, (const char *) ";\\n", 3); } else if (decl_isVarientField (f)) { /* avoid dangling else. */ doVarientFieldC (p, f); } i += 1; } p = outKc (p, (const char *) "}", 1); mcPretty_setNeedSpace (p); } /* isBitset - */ static unsigned int isBitset (decl_node n) { return n == bitsetN; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isNegative - returns TRUE if expression, n, is negative. */ static unsigned int isNegative (decl_node n) { /* --fixme-- needs to be completed. */ return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doSubrangeC - */ static void doSubrangeC (mcPretty_pretty p, decl_node n) { mcDebug_assert (decl_isSubrange (n)); if (isNegative (n->subrangeF.low)) { outText (p, (const char *) "int", 3); mcPretty_setNeedSpace (p); } else { outText (p, (const char *) "unsigned int", 12); mcPretty_setNeedSpace (p); } } /* doSetC - generates a C type which holds the set. Currently we only support sets of size WORD. */ static void doSetC (mcPretty_pretty p, decl_node n) { mcDebug_assert (decl_isSet (n)); outText (p, (const char *) "unsigned int", 12); mcPretty_setNeedSpace (p); } /* doTypeC - */ static void doTypeC (mcPretty_pretty p, decl_node n, decl_node *m) { if (n == NULL) { outText (p, (const char *) "void", 4); } else if (isBase (n)) { /* avoid dangling else. */ doBaseC (p, n); } else if (isSystem (n)) { /* avoid dangling else. */ doSystemC (p, n); } else if (decl_isEnumeration (n)) { /* avoid dangling else. */ doEnumerationC (p, n); } else if (decl_isType (n)) { /* avoid dangling else. */ doFQNameC (p, n); /* ELSIF isProcType (n) OR isArray (n) OR isRecord (n) THEN HALT n should have been simplified. */ mcPretty_setNeedSpace (p); } else if (decl_isProcType (n)) { /* avoid dangling else. */ doProcTypeC (p, n, (*m)); } else if (decl_isArray (n)) { /* avoid dangling else. */ doArrayC (p, n); } else if (decl_isRecord (n)) { /* avoid dangling else. */ doRecordC (p, n, m); } else if (decl_isPointer (n)) { /* avoid dangling else. */ doPointerC (p, n, m); } else if (decl_isSubrange (n)) { /* avoid dangling else. */ doSubrangeC (p, n); } else if (decl_isSet (n)) { /* avoid dangling else. */ doSetC (p, n); } else { /* avoid dangling else. */ /* --fixme-- */ mcPretty_print (p, (const char *) "to do ... typedef etc etc ", 27); doFQNameC (p, n); mcPretty_print (p, (const char *) ";\\n", 3); M2RTS_HALT (-1); __builtin_unreachable (); } } /* doArrayNameC - it displays the array declaration (it might be an unbounded). */ static void doArrayNameC (mcPretty_pretty p, decl_node n) { doTypeNameC (p, decl_getType (n)); mcPretty_setNeedSpace (p); outText (p, (const char *) "*", 1); } /* doRecordNameC - emit the C/C++ record name "_r". */ static void doRecordNameC (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; s = getFQstring (n); s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_r", 2))); outTextS (p, s); s = DynamicStrings_KillString (s); } /* doPointerNameC - emit the C/C++ pointer type *. */ static void doPointerNameC (mcPretty_pretty p, decl_node n) { doTypeNameC (p, decl_getType (n)); mcPretty_setNeedSpace (p); outText (p, (const char *) "*", 1); } /* doTypeNameC - */ static void doTypeNameC (mcPretty_pretty p, decl_node n) { DynamicStrings_String t; if (n == NULL) { outText (p, (const char *) "void", 4); mcPretty_setNeedSpace (p); } else if (isBase (n)) { /* avoid dangling else. */ doBaseC (p, n); } else if (isSystem (n)) { /* avoid dangling else. */ doSystemC (p, n); } else if (decl_isEnumeration (n)) { /* avoid dangling else. */ mcPretty_print (p, (const char *) "is enumeration type name required\\n", 35); } else if (decl_isType (n)) { /* avoid dangling else. */ doFQNameC (p, n); } else if (decl_isProcType (n)) { /* avoid dangling else. */ doFQNameC (p, n); outText (p, (const char *) "_t", 2); } else if (decl_isArray (n)) { /* avoid dangling else. */ doArrayNameC (p, n); } else if (decl_isRecord (n)) { /* avoid dangling else. */ doRecordNameC (p, n); } else if (decl_isPointer (n)) { /* avoid dangling else. */ doPointerNameC (p, n); } else if (decl_isSubrange (n)) { /* avoid dangling else. */ doSubrangeC (p, n); } else { /* avoid dangling else. */ mcPretty_print (p, (const char *) "is type unknown required\\n", 26); stop (); } } /* isExternal - returns TRUE if symbol, n, was declared in another module. */ static unsigned int isExternal (decl_node n) { decl_node s; s = decl_getScope (n); return ((s != NULL) && (decl_isDef (s))) && (((decl_isImp (decl_getMainModule ())) && (s != (decl_lookupDef (decl_getSymName (decl_getMainModule ()))))) || (decl_isModule (decl_getMainModule ()))); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doVarC - */ static void doVarC (decl_node n) { decl_node s; if (decl_isDef (decl_getMainModule ())) { mcPretty_print (doP, (const char *) "EXTERN", 6); mcPretty_setNeedSpace (doP); } else if ((! (decl_isExported (n))) && (! (isLocal (n)))) { /* avoid dangling else. */ mcPretty_print (doP, (const char *) "static", 6); mcPretty_setNeedSpace (doP); } else if (mcOptions_getExtendedOpaque ()) { /* avoid dangling else. */ if (isExternal (n)) { /* different module declared this variable, therefore it is extern. */ mcPretty_print (doP, (const char *) "extern", 6); mcPretty_setNeedSpace (doP); } } s = NULL; doTypeC (doP, decl_getType (n), &s); mcPretty_setNeedSpace (doP); doFQDNameC (doP, n, FALSE); mcPretty_print (doP, (const char *) ";\\n", 3); } /* doExternCP - */ static void doExternCP (mcPretty_pretty p) { if (lang == decl_ansiCP) { outText (p, (const char *) "extern \"C\"", 10); mcPretty_setNeedSpace (p); } } /* doProcedureCommentText - */ static void doProcedureCommentText (mcPretty_pretty p, DynamicStrings_String s) { /* remove from the start of the comment. */ while (((DynamicStrings_Length (s)) > 0) && ((DynamicStrings_char (s, 0)) == ASCII_lf)) { s = DynamicStrings_Slice (s, 1, 0); } outTextS (p, s); } /* doProcedureComment - */ static void doProcedureComment (mcPretty_pretty p, DynamicStrings_String s) { if (s != NULL) { outText (p, (const char *) "\\n/*\\n", 6); doProcedureCommentText (p, s); outText (p, (const char *) "*/\\n\\n", 6); } } /* doProcedureHeadingC - */ static void doProcedureHeadingC (decl_node n, unsigned int prototype) { unsigned int i; unsigned int h; decl_node p; decl_node q; mcDebug_assert (decl_isProcedure (n)); mcPretty_noSpace (doP); if (decl_isDef (decl_getMainModule ())) { doProcedureComment (doP, mcComment_getContent (n->procedureF.defComment)); outText (doP, (const char *) "EXTERN", 6); mcPretty_setNeedSpace (doP); } else if (decl_isExported (n)) { /* avoid dangling else. */ doProcedureComment (doP, mcComment_getContent (n->procedureF.modComment)); doExternCP (doP); } else { /* avoid dangling else. */ doProcedureComment (doP, mcComment_getContent (n->procedureF.modComment)); outText (doP, (const char *) "static", 6); mcPretty_setNeedSpace (doP); } q = NULL; doTypeC (doP, n->procedureF.returnType, &q); mcPretty_setNeedSpace (doP); doFQDNameC (doP, n, FALSE); mcPretty_setNeedSpace (doP); outText (doP, (const char *) "(", 1); i = Indexing_LowIndice (n->procedureF.parameters); h = Indexing_HighIndice (n->procedureF.parameters); while (i <= h) { p = static_cast (Indexing_GetIndice (n->procedureF.parameters, i)); doParameterC (doP, p); mcPretty_noSpace (doP); if (i < h) { mcPretty_print (doP, (const char *) ",", 1); mcPretty_setNeedSpace (doP); } i += 1; } if (h == 0) { outText (doP, (const char *) "void", 4); } mcPretty_print (doP, (const char *) ")", 1); if (n->procedureF.noreturn && prototype) { mcPretty_setNeedSpace (doP); outText (doP, (const char *) "__attribute__ ((noreturn))", 26); } } /* checkDeclareUnboundedParamCopyC - */ static unsigned int checkDeclareUnboundedParamCopyC (mcPretty_pretty p, decl_node n) { decl_node t; unsigned int i; unsigned int c; wlists_wlist l; unsigned int seen; seen = FALSE; t = decl_getType (n); l = n->paramF.namelist->identlistF.names; if (((decl_isArray (t)) && (decl_isUnbounded (t))) && (l != NULL)) { t = decl_getType (t); c = wlists_noOfItemsInList (l); i = 1; while (i <= c) { doTypeNameC (p, t); mcPretty_setNeedSpace (p); doNamesC (p, wlists_getItemFromList (l, i)); outText (p, (const char *) "[_", 2); doNamesC (p, wlists_getItemFromList (l, i)); outText (p, (const char *) "_high+1];\\n", 11); seen = TRUE; i += 1; } } return seen; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* checkUnboundedParamCopyC - */ static void checkUnboundedParamCopyC (mcPretty_pretty p, decl_node n) { decl_node t; decl_node s; unsigned int i; unsigned int c; wlists_wlist l; t = decl_getType (n); l = n->paramF.namelist->identlistF.names; if (((decl_isArray (t)) && (decl_isUnbounded (t))) && (l != NULL)) { c = wlists_noOfItemsInList (l); i = 1; t = decl_getType (t); s = decl_skipType (t); while (i <= c) { keyc_useMemcpy (); outText (p, (const char *) "memcpy (", 8); doNamesC (p, wlists_getItemFromList (l, i)); outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); doNamesC (p, wlists_getItemFromList (l, i)); outText (p, (const char *) "_, ", 3); if (((s == charN) || (s == byteN)) || (s == locN)) { outText (p, (const char *) "_", 1); doNamesC (p, wlists_getItemFromList (l, i)); outText (p, (const char *) "_high+1);\\n", 11); } else { outText (p, (const char *) "(_", 2); doNamesC (p, wlists_getItemFromList (l, i)); outText (p, (const char *) "_high+1)", 8); mcPretty_setNeedSpace (p); doMultiplyBySize (p, t); outText (p, (const char *) ");\\n", 4); } i += 1; } } } /* doUnboundedParamCopyC - */ static void doUnboundedParamCopyC (mcPretty_pretty p, decl_node n) { unsigned int i; unsigned int h; decl_node q; unsigned int seen; mcDebug_assert (decl_isProcedure (n)); i = Indexing_LowIndice (n->procedureF.parameters); h = Indexing_HighIndice (n->procedureF.parameters); seen = FALSE; while (i <= h) { q = static_cast (Indexing_GetIndice (n->procedureF.parameters, i)); if (decl_isParam (q)) { seen = (checkDeclareUnboundedParamCopyC (p, q)) || seen; } i += 1; } if (seen) { outText (p, (const char *) "\\n", 2); outText (p, (const char *) "/* make a local copy of each unbounded array. */\\n", 51); i = Indexing_LowIndice (n->procedureF.parameters); while (i <= h) { q = static_cast (Indexing_GetIndice (n->procedureF.parameters, i)); if (decl_isParam (q)) { checkUnboundedParamCopyC (p, q); } i += 1; } } } /* doPrototypeC - */ static void doPrototypeC (decl_node n) { if (! (decl_isExported (n))) { keyc_enterScope (n); doProcedureHeadingC (n, TRUE); mcPretty_print (doP, (const char *) ";\\n", 3); keyc_leaveScope (n); } } /* addTodo - adds, n, to the todo list. */ static void addTodo (decl_node n) { if (((n != NULL) && (! (alists_isItemInList (partialQ, reinterpret_cast (n))))) && (! (alists_isItemInList (doneQ, reinterpret_cast (n))))) { mcDebug_assert (! (decl_isVarient (n))); mcDebug_assert (! (decl_isVarientField (n))); mcDebug_assert (! (decl_isDef (n))); alists_includeItemIntoList (todoQ, reinterpret_cast (n)); } } /* addVariablesTodo - */ static void addVariablesTodo (decl_node n) { if (decl_isVar (n)) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if (n->varF.isParameter || n->varF.isVarParameter) { addDone (n); addTodo (decl_getType (n)); } else { addTodo (n); } } } /* addTypesTodo - */ static void addTypesTodo (decl_node n) { if (decl_isUnbounded (n)) { addDone (n); } else { addTodo (n); } } /* tempName - */ static DynamicStrings_String tempName (void) { tempCount += 1; return FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "_T%d", 4), (const unsigned char *) &tempCount, (sizeof (tempCount)-1)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeIntermediateType - */ static decl_node makeIntermediateType (DynamicStrings_String s, decl_node p) { nameKey_Name n; decl_node o; n = nameKey_makekey (DynamicStrings_string (s)); decl_enterScope (decl_getScope (p)); o = p; p = decl_makeType (nameKey_makekey (DynamicStrings_string (s))); decl_putType (p, o); putTypeInternal (p); decl_leaveScope (); return p; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* simplifyType - */ static void simplifyType (alists_alist l, decl_node *p) { DynamicStrings_String s; if ((((*p) != NULL) && (((decl_isRecord ((*p))) || (decl_isArray ((*p)))) || (decl_isProcType ((*p))))) && (! (decl_isUnbounded ((*p))))) { s = tempName (); (*p) = makeIntermediateType (s, (*p)); s = DynamicStrings_KillString (s); simplified = FALSE; } simplifyNode (l, (*p)); } /* simplifyVar - */ static void simplifyVar (alists_alist l, decl_node n) { unsigned int i; unsigned int t; decl_node v; decl_node d; decl_node o; mcDebug_assert (decl_isVar (n)); o = n->varF.type; simplifyType (l, &n->varF.type); if (o != n->varF.type) { /* simplification has occurred, make sure that all other variables of this type use the new type. */ d = n->varF.decl; mcDebug_assert (isVarDecl (d)); t = wlists_noOfItemsInList (d->vardeclF.names); i = 1; while (i <= t) { v = decl_lookupInScope (n->varF.scope, wlists_getItemFromList (d->vardeclF.names, i)); mcDebug_assert (decl_isVar (v)); v->varF.type = n->varF.type; i += 1; } } } /* simplifyRecord - */ static void simplifyRecord (alists_alist l, decl_node n) { unsigned int i; unsigned int t; decl_node q; i = Indexing_LowIndice (n->recordF.listOfSons); t = Indexing_HighIndice (n->recordF.listOfSons); while (i <= t) { q = static_cast (Indexing_GetIndice (n->recordF.listOfSons, i)); simplifyNode (l, q); i += 1; } } /* simplifyVarient - */ static void simplifyVarient (alists_alist l, decl_node n) { unsigned int i; unsigned int t; decl_node q; simplifyNode (l, n->varientF.tag); i = Indexing_LowIndice (n->varientF.listOfSons); t = Indexing_HighIndice (n->varientF.listOfSons); while (i <= t) { q = static_cast (Indexing_GetIndice (n->varientF.listOfSons, i)); simplifyNode (l, q); i += 1; } } /* simplifyVarientField - */ static void simplifyVarientField (alists_alist l, decl_node n) { unsigned int i; unsigned int t; decl_node q; i = Indexing_LowIndice (n->varientfieldF.listOfSons); t = Indexing_HighIndice (n->varientfieldF.listOfSons); while (i <= t) { q = static_cast (Indexing_GetIndice (n->varientfieldF.listOfSons, i)); simplifyNode (l, q); i += 1; } } /* doSimplifyNode - */ static void doSimplifyNode (alists_alist l, decl_node n) { if (n == NULL) {} /* empty. */ else if (decl_isType (n)) { /* avoid dangling else. */ /* no need to simplify a type. */ simplifyNode (l, decl_getType (n)); } else if (decl_isVar (n)) { /* avoid dangling else. */ simplifyVar (l, n); } else if (decl_isRecord (n)) { /* avoid dangling else. */ simplifyRecord (l, n); } else if (decl_isRecordField (n)) { /* avoid dangling else. */ simplifyType (l, &n->recordfieldF.type); } else if (decl_isArray (n)) { /* avoid dangling else. */ simplifyType (l, &n->arrayF.type); } else if (decl_isVarient (n)) { /* avoid dangling else. */ simplifyVarient (l, n); } else if (decl_isVarientField (n)) { /* avoid dangling else. */ simplifyVarientField (l, n); } else if (decl_isPointer (n)) { /* avoid dangling else. */ simplifyType (l, &n->pointerF.type); } } /* simplifyNode - */ static void simplifyNode (alists_alist l, decl_node n) { if (! (alists_isItemInList (l, reinterpret_cast (n)))) { alists_includeItemIntoList (l, reinterpret_cast (n)); doSimplifyNode (l, n); } } /* doSimplify - */ static void doSimplify (decl_node n) { alists_alist l; l = alists_initList (); simplifyNode (l, n); alists_killList (&l); } /* simplifyTypes - */ static void simplifyTypes (decl_scopeT s) { do { simplified = TRUE; Indexing_ForeachIndiceInIndexDo (s.types, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doSimplify}); Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doSimplify}); } while (! (simplified)); } /* outDeclsDefC - */ static void outDeclsDefC (mcPretty_pretty p, decl_node n) { decl_scopeT s; s = n->defF.decls; simplifyTypes (s); includeConstType (s); doP = p; 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}); /* try and output types, constants before variables and procedures. */ includeDefVarProcedure (n); 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}); Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC}); } /* includeConstType - */ static void includeConstType (decl_scopeT s) { Indexing_ForeachIndiceInIndexDo (s.constants, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo}); Indexing_ForeachIndiceInIndexDo (s.types, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTypesTodo}); } /* includeVarProcedure - */ static void includeVarProcedure (decl_scopeT s) { Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo}); Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addVariablesTodo}); } /* includeVar - */ static void includeVar (decl_scopeT s) { Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo}); } /* includeExternals - */ static void includeExternals (decl_node n) { alists_alist l; l = alists_initList (); visitNode (l, n, (decl_nodeProcedure) {(decl_nodeProcedure_t) addExported}); alists_killList (&l); } /* checkSystemInclude - */ static void checkSystemInclude (decl_node n) { } /* addExported - */ static void addExported (decl_node n) { decl_node s; s = decl_getScope (n); if (((s != NULL) && (decl_isDef (s))) && (s != defModule)) { if (((decl_isType (n)) || (decl_isVar (n))) || (decl_isConst (n))) { addTodo (n); } } } /* addExternal - only adds, n, if this symbol is external to the implementation module and is not a hidden type. */ static void addExternal (decl_node n) { if (((((decl_getScope (n)) == defModule) && (decl_isType (n))) && (decl_isTypeHidden (n))) && (! (mcOptions_getExtendedOpaque ()))) {} /* empty. */ /* do nothing. */ else if (! (decl_isDef (n))) { /* avoid dangling else. */ addTodo (n); } } /* includeDefConstType - */ static void includeDefConstType (decl_node n) { decl_node d; if (decl_isImp (n)) { defModule = decl_lookupDef (decl_getSymName (n)); if (defModule != NULL) { simplifyTypes (defModule->defF.decls); includeConstType (defModule->defF.decls); symbolKey_foreachNodeDo (defModule->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addExternal}); } } } /* runIncludeDefConstType - */ static void runIncludeDefConstType (decl_node n) { decl_node d; if (decl_isDef (n)) { simplifyTypes (n->defF.decls); includeConstType (n->defF.decls); symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addExternal}); } } /* joinProcedures - copies procedures from definition module, d, into implementation module, i. */ static void joinProcedures (decl_node i, decl_node d) { unsigned int h; unsigned int j; mcDebug_assert (decl_isDef (d)); mcDebug_assert (decl_isImp (i)); j = 1; h = Indexing_HighIndice (d->defF.decls.procedures); while (j <= h) { Indexing_IncludeIndiceIntoIndex (i->impF.decls.procedures, Indexing_GetIndice (d->defF.decls.procedures, j)); j += 1; } } /* includeDefVarProcedure - */ static void includeDefVarProcedure (decl_node n) { decl_node d; if (decl_isImp (n)) { /* avoid dangling else. */ defModule = decl_lookupDef (decl_getSymName (n)); if (defModule != NULL) { /* includeVar (defModule^.defF.decls) ; simplifyTypes (defModule^.defF.decls) ; */ joinProcedures (n, defModule); } } else if (decl_isDef (n)) { /* avoid dangling else. */ includeVar (n->defF.decls); simplifyTypes (n->defF.decls); } } /* foreachModuleDo - */ static void foreachModuleDo (decl_node n, symbolKey_performOperation p) { decl_foreachDefModuleDo (p); decl_foreachModModuleDo (p); } /* outDeclsImpC - */ static void outDeclsImpC (mcPretty_pretty p, decl_scopeT s) { simplifyTypes (s); includeConstType (s); doP = p; 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}); /* try and output types, constants before variables and procedures. */ includeVarProcedure (s); 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}); } /* doStatementSequenceC - */ static void doStatementSequenceC (mcPretty_pretty p, decl_node s) { unsigned int i; unsigned int h; mcDebug_assert (decl_isStatementSequence (s)); h = Indexing_HighIndice (s->stmtF.statements); i = 1; while (i <= h) { doStatementsC (p, reinterpret_cast (Indexing_GetIndice (s->stmtF.statements, i))); i += 1; } } /* isStatementSequenceEmpty - */ static unsigned int isStatementSequenceEmpty (decl_node s) { mcDebug_assert (decl_isStatementSequence (s)); return (Indexing_HighIndice (s->stmtF.statements)) == 0; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isSingleStatement - returns TRUE if the statement sequence, s, has only one statement. */ static unsigned int isSingleStatement (decl_node s) { unsigned int h; mcDebug_assert (decl_isStatementSequence (s)); h = Indexing_HighIndice (s->stmtF.statements); if ((h == 0) || (h > 1)) { return FALSE; } s = static_cast (Indexing_GetIndice (s->stmtF.statements, 1)); return (! (decl_isStatementSequence (s))) || (isSingleStatement (s)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doCommentC - */ static void doCommentC (mcPretty_pretty p, decl_node s) { DynamicStrings_String c; if (s != NULL) { mcDebug_assert (isComment (s)); if (! (mcComment_isProcedureComment (s->commentF.content))) { if (mcComment_isAfterComment (s->commentF.content)) { mcPretty_setNeedSpace (p); outText (p, (const char *) " /* ", 4); } else { outText (p, (const char *) "/* ", 3); } c = mcComment_getContent (s->commentF.content); c = DynamicStrings_RemoveWhitePrefix (DynamicStrings_RemoveWhitePostfix (c)); outTextS (p, c); outText (p, (const char *) " */\\n", 6); } } } /* doAfterCommentC - emit an after comment, c, or a newline if, c, is empty. */ static void doAfterCommentC (mcPretty_pretty p, decl_node c) { if (c == NULL) { outText (p, (const char *) "\\n", 2); } else { doCommentC (p, c); } } /* doReturnC - issue a return statement and also place in an after comment if one exists. */ static void doReturnC (mcPretty_pretty p, decl_node s) { mcDebug_assert (decl_isReturn (s)); doCommentC (p, s->returnF.returnComment.body); outText (p, (const char *) "return", 6); if (s->returnF.scope != NULL) { mcPretty_setNeedSpace (p); if ((! (decl_isProcedure (s->returnF.scope))) || ((decl_getType (s->returnF.scope)) == NULL)) { mcMetaError_metaError1 ((const char *) "{%1DMad} has no return type", 27, (const unsigned char *) &s->returnF.scope, (sizeof (s->returnF.scope)-1)); } else { doExprCastC (p, s->returnF.exp, decl_getType (s->returnF.scope)); } } outText (p, (const char *) ";", 1); doAfterCommentC (p, s->returnF.returnComment.after); } /* isZtypeEquivalent - */ static unsigned int isZtypeEquivalent (decl_node type) { switch (type->kind) { case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_ztype: return TRUE; break; default: return FALSE; break; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isEquivalentType - returns TRUE if type1 and type2 are equivalent. */ static unsigned int isEquivalentType (decl_node type1, decl_node type2) { type1 = decl_skipType (type1); type2 = decl_skipType (type2); return (type1 == type2) || ((isZtypeEquivalent (type1)) && (isZtypeEquivalent (type2))); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doExprCastC - build a cast if necessary. */ static void doExprCastC (mcPretty_pretty p, decl_node e, decl_node type) { decl_node stype; stype = decl_skipType (type); if ((! (isEquivalentType (type, getExprType (e)))) && (! ((e->kind == decl_nil) && ((decl_isPointer (stype)) || (stype->kind == decl_address))))) { if (lang == decl_ansiCP) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ /* potentially a cast is required. */ if ((decl_isPointer (type)) || (type == addressN)) { outText (p, (const char *) "reinterpret_cast<", 17); doTypeNameC (p, type); mcPretty_noSpace (p); outText (p, (const char *) "> (", 3); doExprC (p, e); outText (p, (const char *) ")", 1); return ; } else { outText (p, (const char *) "static_cast<", 12); if (decl_isProcType (decl_skipType (type))) { doTypeNameC (p, type); outText (p, (const char *) "_t", 2); } else { doTypeNameC (p, type); } mcPretty_noSpace (p); outText (p, (const char *) "> (", 3); doExprC (p, e); outText (p, (const char *) ")", 1); return ; } } } doExprC (p, e); } /* requiresUnpackProc - returns TRUE if either the expr is a procedure or the proctypes differ. */ static unsigned int requiresUnpackProc (decl_node s) { mcDebug_assert (isAssignment (s)); return (decl_isProcedure (s->assignmentF.expr)) || ((decl_skipType (decl_getType (s->assignmentF.des))) != (decl_skipType (decl_getType (s->assignmentF.expr)))); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doAssignmentC - */ static void doAssignmentC (mcPretty_pretty p, decl_node s) { mcDebug_assert (isAssignment (s)); doCommentC (p, s->assignmentF.assignComment.body); doExprCup (p, s->assignmentF.des, requiresUnpackProc (s)); mcPretty_setNeedSpace (p); outText (p, (const char *) "=", 1); mcPretty_setNeedSpace (p); doExprCastC (p, s->assignmentF.expr, decl_getType (s->assignmentF.des)); outText (p, (const char *) ";", 1); doAfterCommentC (p, s->assignmentF.assignComment.after); } /* containsStatement - */ static unsigned int containsStatement (decl_node s) { return ((s != NULL) && (decl_isStatementSequence (s))) && (! (isStatementSequenceEmpty (s))); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doCompoundStmt - */ static void doCompoundStmt (mcPretty_pretty p, decl_node s) { if ((s == NULL) || ((decl_isStatementSequence (s)) && (isStatementSequenceEmpty (s)))) { p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); outText (p, (const char *) "{} /* empty. */\\n", 19); p = mcPretty_popPretty (p); } else if (((decl_isStatementSequence (s)) && (isSingleStatement (s))) && ! forceCompoundStatement) { /* avoid dangling else. */ p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); doStatementSequenceC (p, s); p = mcPretty_popPretty (p); } else { /* avoid dangling else. */ p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); outText (p, (const char *) "{\\n", 3); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); doStatementSequenceC (p, s); p = mcPretty_popPretty (p); outText (p, (const char *) "}\\n", 3); p = mcPretty_popPretty (p); } } /* doElsifC - */ static void doElsifC (mcPretty_pretty p, decl_node s) { mcDebug_assert (decl_isElsif (s)); outText (p, (const char *) "else if", 7); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, s->elsifF.expr); outText (p, (const char *) ")\\n", 3); mcDebug_assert ((s->elsifF.else_ == NULL) || (s->elsifF.elsif == NULL)); if (forceCompoundStatement || ((hasIfAndNoElse (s->elsifF.then)) && ((s->elsifF.else_ != NULL) || (s->elsifF.elsif != NULL)))) { /* avoid dangling else. */ p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); outText (p, (const char *) "{\\n", 3); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); outText (p, (const char *) "/* avoid dangling else. */\\n", 29); doStatementSequenceC (p, s->elsifF.then); p = mcPretty_popPretty (p); outText (p, (const char *) "}\\n", 3); p = mcPretty_popPretty (p); } else { doCompoundStmt (p, s->elsifF.then); } if (containsStatement (s->elsifF.else_)) { outText (p, (const char *) "else\\n", 6); if (forceCompoundStatement) { /* avoid dangling else. */ p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); outText (p, (const char *) "{\\n", 3); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); outText (p, (const char *) "/* avoid dangling else. */\\n", 29); doStatementSequenceC (p, s->elsifF.else_); p = mcPretty_popPretty (p); outText (p, (const char *) "}\\n", 3); p = mcPretty_popPretty (p); } else { doCompoundStmt (p, s->elsifF.else_); } } else if ((s->elsifF.elsif != NULL) && (decl_isElsif (s->elsifF.elsif))) { /* avoid dangling else. */ doElsifC (p, s->elsifF.elsif); } } /* noIfElse - */ static unsigned int noIfElse (decl_node n) { return (((n != NULL) && (decl_isIf (n))) && (n->ifF.else_ == NULL)) && (n->ifF.elsif == NULL); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* noIfElseChained - returns TRUE if, n, is an IF statement which has no associated ELSE statement. An IF with an ELSIF is also checked for no ELSE and will result in a return value of TRUE. */ static unsigned int noIfElseChained (decl_node n) { decl_node e; if (n != NULL) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if (decl_isIf (n)) { if (n->ifF.else_ != NULL) { /* we do have an else, continue to check this statement. */ return hasIfAndNoElse (n->ifF.else_); } else if (n->ifF.elsif == NULL) { /* avoid dangling else. */ /* neither else or elsif. */ return TRUE; } else { /* avoid dangling else. */ /* test elsif for lack of else. */ e = n->ifF.elsif; mcDebug_assert (decl_isElsif (e)); return noIfElseChained (e); } } else if (decl_isElsif (n)) { /* avoid dangling else. */ if (n->elsifF.else_ != NULL) { /* we do have an else, continue to check this statement. */ return hasIfAndNoElse (n->elsifF.else_); } else if (n->elsifF.elsif == NULL) { /* avoid dangling else. */ /* neither else or elsif. */ return TRUE; } else { /* avoid dangling else. */ /* test elsif for lack of else. */ e = n->elsifF.elsif; mcDebug_assert (decl_isElsif (e)); return noIfElseChained (e); } } } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* hasIfElse - */ static unsigned int hasIfElse (decl_node n) { if (n != NULL) { if (decl_isStatementSequence (n)) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if (isStatementSequenceEmpty (n)) { return FALSE; } else if (isSingleStatement (n)) { /* avoid dangling else. */ n = static_cast (Indexing_GetIndice (n->stmtF.statements, 1)); return isIfElse (n); } } } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isIfElse - */ static unsigned int isIfElse (decl_node n) { return ((n != NULL) && (decl_isIf (n))) && ((n->ifF.else_ != NULL) || (n->ifF.elsif != NULL)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* hasIfAndNoElse - returns TRUE if statement, n, is a single statement which is an IF and it has no else statement. */ static unsigned int hasIfAndNoElse (decl_node n) { if (n != NULL) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if (decl_isStatementSequence (n)) { if (isStatementSequenceEmpty (n)) { return FALSE; } else if (isSingleStatement (n)) { /* avoid dangling else. */ n = static_cast (Indexing_GetIndice (n->stmtF.statements, 1)); return hasIfAndNoElse (n); } else { /* avoid dangling else. */ n = static_cast (Indexing_GetIndice (n->stmtF.statements, Indexing_HighIndice (n->stmtF.statements))); return hasIfAndNoElse (n); } } else if ((decl_isElsif (n)) || (decl_isIf (n))) { /* avoid dangling else. */ return noIfElseChained (n); } } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doIfC - issue an if statement and also place in an after comment if one exists. The if statement might contain an else or elsif which are also handled. */ static void doIfC (mcPretty_pretty p, decl_node s) { mcDebug_assert (decl_isIf (s)); doCommentC (p, s->ifF.ifComment.body); outText (p, (const char *) "if", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, s->ifF.expr); outText (p, (const char *) ")", 1); doAfterCommentC (p, s->ifF.ifComment.after); if ((hasIfAndNoElse (s->ifF.then)) && ((s->ifF.else_ != NULL) || (s->ifF.elsif != NULL))) { /* avoid dangling else. */ p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); outText (p, (const char *) "{\\n", 3); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); outText (p, (const char *) "/* avoid dangling else. */\\n", 29); doStatementSequenceC (p, s->ifF.then); p = mcPretty_popPretty (p); outText (p, (const char *) "}\\n", 3); p = mcPretty_popPretty (p); } else if ((noIfElse (s)) && (hasIfElse (s->ifF.then))) { /* avoid dangling else. */ /* gcc does not like legal non dangling else, as it is poor style. So we will avoid getting a warning. */ p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); outText (p, (const char *) "{\\n", 3); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); outText (p, (const char *) "/* avoid gcc warning by using compound statement even if not strictly necessary. */\\n", 86); doStatementSequenceC (p, s->ifF.then); p = mcPretty_popPretty (p); outText (p, (const char *) "}\\n", 3); p = mcPretty_popPretty (p); } else { /* avoid dangling else. */ doCompoundStmt (p, s->ifF.then); } mcDebug_assert ((s->ifF.else_ == NULL) || (s->ifF.elsif == NULL)); if (containsStatement (s->ifF.else_)) { doCommentC (p, s->ifF.elseComment.body); outText (p, (const char *) "else", 4); doAfterCommentC (p, s->ifF.elseComment.after); doCompoundStmt (p, s->ifF.else_); } else if ((s->ifF.elsif != NULL) && (decl_isElsif (s->ifF.elsif))) { /* avoid dangling else. */ doCommentC (p, s->ifF.elseComment.body); doCommentC (p, s->ifF.elseComment.after); doElsifC (p, s->ifF.elsif); } doCommentC (p, s->ifF.endComment.after); doCommentC (p, s->ifF.endComment.body); } /* doForIncCP - */ static void doForIncCP (mcPretty_pretty p, decl_node s) { decl_node t; mcDebug_assert (decl_isFor (s)); t = decl_skipType (decl_getType (s->forF.des)); if (decl_isEnumeration (t)) { if (s->forF.increment == NULL) { doExprC (p, s->forF.des); outText (p, (const char *) "= static_cast<", 14); doTypeNameC (p, decl_getType (s->forF.des)); mcPretty_noSpace (p); outText (p, (const char *) ">(static_cast(", 19); doExprC (p, s->forF.des); outText (p, (const char *) "+1))", 4); } else { doExprC (p, s->forF.des); outText (p, (const char *) "= static_cast<", 14); doTypeNameC (p, decl_getType (s->forF.des)); mcPretty_noSpace (p); outText (p, (const char *) ">(static_cast(", 19); doExprC (p, s->forF.des); outText (p, (const char *) "+", 1); doExprC (p, s->forF.increment); outText (p, (const char *) "))", 2); } } else { doForIncC (p, s); } } /* doForIncC - */ static void doForIncC (mcPretty_pretty p, decl_node s) { if (s->forF.increment == NULL) { doExprC (p, s->forF.des); outText (p, (const char *) "++", 2); } else { doExprC (p, s->forF.des); outText (p, (const char *) "=", 1); doExprC (p, s->forF.des); outText (p, (const char *) "+", 1); doExprC (p, s->forF.increment); } } /* doForInc - */ static void doForInc (mcPretty_pretty p, decl_node s) { if (lang == decl_ansiCP) { doForIncCP (p, s); } else { doForIncC (p, s); } } /* doForC - */ static void doForC (mcPretty_pretty p, decl_node s) { mcDebug_assert (decl_isFor (s)); outText (p, (const char *) "for (", 5); doExprC (p, s->forF.des); outText (p, (const char *) "=", 1); doExprC (p, s->forF.start); outText (p, (const char *) ";", 1); mcPretty_setNeedSpace (p); doExprC (p, s->forF.des); outText (p, (const char *) "<=", 2); doExprC (p, s->forF.end); outText (p, (const char *) ";", 1); mcPretty_setNeedSpace (p); doForInc (p, s); outText (p, (const char *) ")\\n", 3); doCompoundStmt (p, s->forF.statements); } /* doRepeatC - */ static void doRepeatC (mcPretty_pretty p, decl_node s) { mcDebug_assert (decl_isRepeat (s)); doCommentC (p, s->repeatF.repeatComment.body); outText (p, (const char *) "do {", 4); doAfterCommentC (p, s->repeatF.repeatComment.after); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); doStatementSequenceC (p, s->repeatF.statements); doCommentC (p, s->repeatF.untilComment.body); p = mcPretty_popPretty (p); outText (p, (const char *) "} while (! (", 12); doExprC (p, s->repeatF.expr); outText (p, (const char *) "));", 3); doAfterCommentC (p, s->repeatF.untilComment.after); } /* doWhileC - */ static void doWhileC (mcPretty_pretty p, decl_node s) { mcDebug_assert (decl_isWhile (s)); doCommentC (p, s->whileF.doComment.body); outText (p, (const char *) "while (", 7); doExprC (p, s->whileF.expr); outText (p, (const char *) ")", 1); doAfterCommentC (p, s->whileF.doComment.after); doCompoundStmt (p, s->whileF.statements); doCommentC (p, s->whileF.endComment.body); doCommentC (p, s->whileF.endComment.after); } /* doFuncHighC - */ static void doFuncHighC (mcPretty_pretty p, decl_node a) { decl_node s; decl_node n; if ((decl_isLiteral (a)) && ((decl_getType (a)) == charN)) { outCard (p, 0); } else if (isString (a)) { /* avoid dangling else. */ outCard (p, a->stringF.length-2); } else if ((decl_isConst (a)) && (isString (a->constF.value))) { /* avoid dangling else. */ doFuncHighC (p, a->constF.value); } else if (decl_isUnbounded (decl_getType (a))) { /* avoid dangling else. */ outText (p, (const char *) "_", 1); outTextN (p, decl_getSymName (a)); outText (p, (const char *) "_high", 5); } else if (decl_isArray (decl_skipType (decl_getType (a)))) { /* avoid dangling else. */ n = decl_skipType (decl_getType (a)); s = n->arrayF.subr; if (isZero (getMin (s))) { doExprC (p, getMax (s)); } else { outText (p, (const char *) "(", 1); doExprC (p, getMax (s)); doSubtractC (p, getMin (s)); outText (p, (const char *) ")", 1); } } else { /* avoid dangling else. */ /* output sizeof (a) in bytes for the high. */ outText (p, (const char *) "(sizeof", 7); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, a); outText (p, (const char *) ")-1)", 4); } } /* doMultiplyBySize - */ static void doMultiplyBySize (mcPretty_pretty p, decl_node a) { if (((a != charN) && (a != byteN)) && (a != locN)) { mcPretty_setNeedSpace (p); outText (p, (const char *) "* sizeof (", 10); doTypeNameC (p, a); mcPretty_noSpace (p); outText (p, (const char *) ")", 1); } } /* doTotype - */ static void doTotype (mcPretty_pretty p, decl_node a, decl_node t) { if ((! (isString (a))) && (! (decl_isLiteral (a)))) { if (decl_isVar (a)) { if (((a->varF.isParameter || a->varF.isVarParameter) && (decl_isUnbounded (decl_getType (a)))) && ((decl_skipType (decl_getType (decl_getType (a)))) == (decl_skipType (decl_getType (t))))) { /* do not multiply by size as the existing high value is correct. */ return ; } a = decl_getType (a); if (decl_isArray (a)) { doMultiplyBySize (p, decl_skipType (decl_getType (a))); } } } if (t == wordN) { mcPretty_setNeedSpace (p); outText (p, (const char *) "/ sizeof (", 10); doTypeNameC (p, wordN); mcPretty_noSpace (p); outText (p, (const char *) ")", 1); } } /* doFuncUnbounded - */ static void doFuncUnbounded (mcPretty_pretty p, decl_node actual, decl_node formalParam, decl_node formal, decl_node func) { decl_node h; DynamicStrings_String s; mcDebug_assert (decl_isUnbounded (formal)); outText (p, (const char *) "(", 1); if ((lang == decl_ansiCP) && (decl_isParam (formalParam))) { outText (p, (const char *) "const", 5); mcPretty_setNeedSpace (p); } doTypeC (p, decl_getType (formal), &formal); mcPretty_setNeedSpace (p); outText (p, (const char *) "*)", 2); mcPretty_setNeedSpace (p); if ((decl_isLiteral (actual)) && ((decl_getType (actual)) == charN)) { outText (p, (const char *) "\"\\0", 3); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (actual->literalF.name)); s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); outTextS (p, s); outText (p, (const char *) "\"", 1); s = DynamicStrings_KillString (s); } else if (isString (actual)) { /* avoid dangling else. */ outCstring (p, actual, TRUE); } else if (decl_isConst (actual)) { /* avoid dangling else. */ actual = resolveString (actual); mcDebug_assert (isString (actual)); outCstring (p, actual, TRUE); } else if (isFuncCall (actual)) { /* avoid dangling else. */ if ((getExprType (actual)) == NULL) { 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)); } else { outText (p, (const char *) "&", 1); doExprC (p, actual); } } else if (decl_isUnbounded (decl_getType (actual))) { /* avoid dangling else. */ /* doExprC (p, actual). */ doFQNameC (p, actual); } else { /* avoid dangling else. */ outText (p, (const char *) "&", 1); doExprC (p, actual); if (decl_isArray (decl_skipType (decl_getType (actual)))) { outText (p, (const char *) ".array[0]", 9); } } if (! (enableDefForCStrings && (isDefForC (decl_getScope (func))))) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); doFuncHighC (p, actual); doTotype (p, actual, formal); } } /* doProcedureParamC - */ static void doProcedureParamC (mcPretty_pretty p, decl_node actual, decl_node formal) { if (isForC (formal)) { outText (p, (const char *) "(", 1); doFQNameC (p, decl_getType (formal)); outText (p, (const char *) "_C", 2); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); doExprC (p, actual); } else { outText (p, (const char *) "(", 1); doTypeNameC (p, decl_getType (formal)); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "{", 1); outText (p, (const char *) "(", 1); doFQNameC (p, decl_getType (formal)); outText (p, (const char *) "_t)", 3); mcPretty_setNeedSpace (p); doExprC (p, actual); outText (p, (const char *) "}", 1); } } /* doAdrExprC - */ static void doAdrExprC (mcPretty_pretty p, decl_node n) { if (isDeref (n)) { /* no point in issuing & ( * n ) */ doExprC (p, n->unaryF.arg); } else if ((decl_isVar (n)) && n->varF.isVarParameter) { /* avoid dangling else. */ /* no point in issuing & ( * n ) */ doFQNameC (p, n); } else { /* avoid dangling else. */ outText (p, (const char *) "&", 1); doExprC (p, n); } } /* typePair - */ static unsigned int typePair (decl_node a, decl_node b, decl_node x, decl_node y) { return ((a == x) && (b == y)) || ((a == y) && (b == x)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* needsCast - return TRUE if the actual type parameter needs to be cast to the formal type. */ static unsigned int needsCast (decl_node at, decl_node ft) { at = decl_skipType (at); ft = decl_skipType (ft); 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))) { return FALSE; } else { return TRUE; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* checkSystemCast - checks to see if we are passing to/from a system generic type (WORD, BYTE, ADDRESS) and if so emit a cast. It returns the number of open parenthesis. */ static unsigned int checkSystemCast (mcPretty_pretty p, decl_node actual, decl_node formal) { decl_node at; decl_node ft; at = getExprType (actual); ft = decl_getType (formal); if (needsCast (at, ft)) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if (lang == decl_ansiCP) { if ((isString (actual)) && ((decl_skipType (ft)) == addressN)) { outText (p, (const char *) "const_cast (reinterpret_cast (", 50); return 2; } else if ((decl_isPointer (decl_skipType (ft))) || ((decl_skipType (ft)) == addressN)) { /* avoid dangling else. */ if (actual == nilN) { if (decl_isVarParam (formal)) { mcMetaError_metaError1 ((const char *) "NIL is being passed to a VAR parameter {%1DMad}", 47, (const unsigned char *) &formal, (sizeof (formal)-1)); } /* NULL is compatible with pointers/address. */ return 0; } else { outText (p, (const char *) "reinterpret_cast<", 17); doTypeNameC (p, ft); if (decl_isVarParam (formal)) { outText (p, (const char *) "*", 1); } mcPretty_noSpace (p); outText (p, (const char *) "> (", 3); } } else { /* avoid dangling else. */ outText (p, (const char *) "static_cast<", 12); doTypeNameC (p, ft); if (decl_isVarParam (formal)) { outText (p, (const char *) "*", 1); } mcPretty_noSpace (p); outText (p, (const char *) "> (", 3); } return 1; } else { outText (p, (const char *) "(", 1); doTypeNameC (p, ft); if (decl_isVarParam (formal)) { outText (p, (const char *) "*", 1); } mcPretty_noSpace (p); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); } } return 0; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* emitN - */ static void emitN (mcPretty_pretty p, const char *a_, unsigned int _a_high, unsigned int n) { char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); while (n > 0) { outText (p, (const char *) a, _a_high); n -= 1; } } /* isForC - return true if node n is a varparam, param or procedure which was declared inside a definition module for "C". */ static unsigned int isForC (decl_node n) { if (decl_isVarParam (n)) { return n->varparamF.isForC; } else if (decl_isParam (n)) { /* avoid dangling else. */ return n->paramF.isForC; } else if (decl_isProcedure (n)) { /* avoid dangling else. */ return n->procedureF.isForC; } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isDefForCNode - return TRUE if node n was declared inside a definition module for "C". */ static unsigned int isDefForCNode (decl_node n) { nameKey_Name name; while ((n != NULL) && (! (((decl_isImp (n)) || (decl_isDef (n))) || (decl_isModule (n))))) { n = decl_getScope (n); } if ((n != NULL) && (decl_isImp (n))) { name = decl_getSymName (n); n = decl_lookupDef (name); } return ((n != NULL) && (decl_isDef (n))) && (isDefForC (n)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doFuncParamC - */ static void doFuncParamC (mcPretty_pretty p, decl_node actual, decl_node formal, decl_node func) { decl_node ft; decl_node at; unsigned int lbr; if (formal == NULL) { doExprC (p, actual); } else { ft = decl_skipType (decl_getType (formal)); if (decl_isUnbounded (ft)) { doFuncUnbounded (p, actual, formal, ft, func); } else { if ((isAProcType (ft)) && (decl_isProcedure (actual))) { if (decl_isVarParam (formal)) { mcMetaError_metaError1 ((const char *) "{%1MDad} cannot be passed as a VAR parameter", 44, (const unsigned char *) &actual, (sizeof (actual)-1)); } else { doProcedureParamC (p, actual, formal); } } else if (((((decl_getType (actual)) != NULL) && (decl_isProcType (decl_skipType (decl_getType (actual))))) && (isAProcType (ft))) && (isForC (formal))) { /* avoid dangling else. */ if (decl_isVarParam (formal)) { 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)); } else { outText (p, (const char *) "(", 1); doFQNameC (p, decl_getType (formal)); outText (p, (const char *) "_C", 2); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); doExprC (p, actual); outText (p, (const char *) ".proc", 5); } } else if ((((decl_getType (actual)) != NULL) && (decl_isProcType (decl_skipType (decl_getType (actual))))) && ((decl_getType (actual)) != (decl_getType (formal)))) { /* avoid dangling else. */ if (decl_isVarParam (formal)) { 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)); } else { doCastC (p, decl_getType (formal), actual); } } else { /* avoid dangling else. */ lbr = checkSystemCast (p, actual, formal); if (decl_isVarParam (formal)) { doAdrExprC (p, actual); } else { doExprC (p, actual); } emitN (p, (const char *) ")", 1, lbr); } } } } /* getNthParamType - return the type of parameter, i, in list, l. If the parameter is a vararg NIL is returned. */ static decl_node getNthParamType (Indexing_Index l, unsigned int i) { decl_node p; p = getNthParam (l, i); if (p != NULL) { return decl_getType (p); } return NULL; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getNthParam - return the parameter, i, in list, l. If the parameter is a vararg NIL is returned. */ static decl_node getNthParam (Indexing_Index l, unsigned int i) { decl_node p; unsigned int j; unsigned int k; unsigned int h; if (l != NULL) { j = Indexing_LowIndice (l); h = Indexing_HighIndice (l); while (j <= h) { p = static_cast (Indexing_GetIndice (l, j)); if (decl_isParam (p)) { k = identListLen (p->paramF.namelist); } else if (decl_isVarParam (p)) { /* avoid dangling else. */ k = identListLen (p->varparamF.namelist); } else { /* avoid dangling else. */ mcDebug_assert (decl_isVarargs (p)); return NULL; } if (i <= k) { return p; } else { i -= k; j += 1; } } } return NULL; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doFuncArgsC - */ static void doFuncArgsC (mcPretty_pretty p, decl_node s, Indexing_Index l, unsigned int needParen) { decl_node actual; decl_node formal; unsigned int i; unsigned int n; if (needParen) { outText (p, (const char *) "(", 1); } if (s->funccallF.args != NULL) { i = 1; n = expListLen (s->funccallF.args); while (i <= n) { actual = getExpList (s->funccallF.args, i); formal = getNthParam (l, i); doFuncParamC (p, actual, formal, s->funccallF.function); if (i < n) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); } i += 1; } } if (needParen) { mcPretty_noSpace (p); outText (p, (const char *) ")", 1); } } /* doProcTypeArgsC - */ static void doProcTypeArgsC (mcPretty_pretty p, decl_node s, Indexing_Index args, unsigned int needParen) { decl_node a; decl_node b; unsigned int i; unsigned int n; if (needParen) { outText (p, (const char *) "(", 1); } if (s->funccallF.args != NULL) { i = 1; n = expListLen (s->funccallF.args); while (i <= n) { a = getExpList (s->funccallF.args, i); b = static_cast (Indexing_GetIndice (args, i)); doFuncParamC (p, a, b, s->funccallF.function); if (i < n) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); } i += 1; } } if (needParen) { mcPretty_noSpace (p); outText (p, (const char *) ")", 1); } } /* doAdrArgC - */ static void doAdrArgC (mcPretty_pretty p, decl_node n) { if (isDeref (n)) { /* & and * cancel each other out. */ doExprC (p, n->unaryF.arg); } else if ((decl_isVar (n)) && n->varF.isVarParameter) { /* avoid dangling else. */ outTextN (p, decl_getSymName (n)); /* --fixme-- does the caller need to cast it? */ } else { /* avoid dangling else. */ if (isString (n)) { if (lang == decl_ansiCP) { outText (p, (const char *) "const_cast (reinterpret_cast", 48); outText (p, (const char *) "(", 1); doExprC (p, n); outText (p, (const char *) "))", 2); } else { doExprC (p, n); } } else { outText (p, (const char *) "&", 1); doExprC (p, n); } } } /* doAdrC - */ static void doAdrC (mcPretty_pretty p, decl_node n) { mcDebug_assert (isUnary (n)); doAdrArgC (p, n->unaryF.arg); } /* doInc - */ static void doInc (mcPretty_pretty p, decl_node n) { mcDebug_assert (isIntrinsic (n)); if (lang == decl_ansiCP) { doIncDecCP (p, n, (const char *) "+", 1); } else { doIncDecC (p, n, (const char *) "+=", 2); } } /* doDec - */ static void doDec (mcPretty_pretty p, decl_node n) { mcDebug_assert (isIntrinsic (n)); if (lang == decl_ansiCP) { doIncDecCP (p, n, (const char *) "-", 1); } else { doIncDecC (p, n, (const char *) "-=", 2); } } /* doIncDecC - */ static void doIncDecC (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high) { char op[_op_high+1]; /* make a local copy of each unbounded array. */ memcpy (op, op_, _op_high+1); mcDebug_assert (isIntrinsic (n)); if (n->intrinsicF.args != NULL) { doExprC (p, getExpList (n->intrinsicF.args, 1)); mcPretty_setNeedSpace (p); outText (p, (const char *) op, _op_high); mcPretty_setNeedSpace (p); if ((expListLen (n->intrinsicF.args)) == 1) { outText (p, (const char *) "1", 1); } else { doExprC (p, getExpList (n->intrinsicF.args, 2)); } } } /* doIncDecCP - */ static void doIncDecCP (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high) { decl_node lhs; decl_node type; char op[_op_high+1]; /* make a local copy of each unbounded array. */ memcpy (op, op_, _op_high+1); mcDebug_assert (isIntrinsic (n)); if (n->intrinsicF.args != NULL) { lhs = getExpList (n->intrinsicF.args, 1); doExprC (p, lhs); mcPretty_setNeedSpace (p); type = decl_getType (lhs); if ((decl_isPointer (type)) || (type == addressN)) { /* cast to (char * ) and then back again after the arithmetic is complete. */ outText (p, (const char *) "=", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "reinterpret_cast<", 17); doTypeNameC (p, type); mcPretty_noSpace (p); outText (p, (const char *) "> (reinterpret_cast (", 29); doExprC (p, lhs); mcPretty_noSpace (p); outText (p, (const char *) ")", 1); outText (p, (const char *) op, _op_high); if ((expListLen (n->intrinsicF.args)) == 1) { outText (p, (const char *) "1", 1); } else { doExprC (p, getExpList (n->intrinsicF.args, 2)); } outText (p, (const char *) ")", 1); } else if (decl_isEnumeration (decl_skipType (type))) { /* avoid dangling else. */ outText (p, (const char *) "= static_cast<", 14); doTypeNameC (p, type); mcPretty_noSpace (p); outText (p, (const char *) ">(static_cast(", 19); doExprC (p, lhs); outText (p, (const char *) ")", 1); outText (p, (const char *) op, _op_high); if ((expListLen (n->intrinsicF.args)) == 1) { outText (p, (const char *) "1", 1); } else { doExprC (p, getExpList (n->intrinsicF.args, 2)); } outText (p, (const char *) ")", 1); } else { /* avoid dangling else. */ outText (p, (const char *) op, _op_high); outText (p, (const char *) "=", 1); mcPretty_setNeedSpace (p); if ((expListLen (n->intrinsicF.args)) == 1) { outText (p, (const char *) "1", 1); } else { doExprC (p, getExpList (n->intrinsicF.args, 2)); } } } } /* doInclC - */ static void doInclC (mcPretty_pretty p, decl_node n) { decl_node lo; mcDebug_assert (isIntrinsic (n)); if (n->intrinsicF.args != NULL) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if ((expListLen (n->intrinsicF.args)) == 2) { doExprC (p, getExpList (n->intrinsicF.args, 1)); lo = getSetLow (getExpList (n->intrinsicF.args, 1)); mcPretty_setNeedSpace (p); outText (p, (const char *) "|=", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "(1", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "<<", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, getExpList (n->intrinsicF.args, 2)); doSubtractC (p, lo); mcPretty_setNeedSpace (p); outText (p, (const char *) "))", 2); } else { M2RTS_HALT (-1); /* metaError0 ('expecting two parameters to INCL') */ __builtin_unreachable (); } } } /* doExclC - */ static void doExclC (mcPretty_pretty p, decl_node n) { decl_node lo; mcDebug_assert (isIntrinsic (n)); if (n->intrinsicF.args != NULL) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if ((expListLen (n->intrinsicF.args)) == 2) { doExprC (p, getExpList (n->intrinsicF.args, 1)); lo = getSetLow (getExpList (n->intrinsicF.args, 1)); mcPretty_setNeedSpace (p); outText (p, (const char *) "&=", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "(~(1", 4); mcPretty_setNeedSpace (p); outText (p, (const char *) "<<", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, getExpList (n->intrinsicF.args, 2)); doSubtractC (p, lo); mcPretty_setNeedSpace (p); outText (p, (const char *) ")))", 3); } else { M2RTS_HALT (-1); /* metaError0 ('expecting two parameters to EXCL') */ __builtin_unreachable (); } } } /* doNewC - */ static void doNewC (mcPretty_pretty p, decl_node n) { decl_node t; mcDebug_assert (isIntrinsic (n)); if (n->intrinsicF.args == NULL) { M2RTS_HALT (-1); __builtin_unreachable (); } else { if ((expListLen (n->intrinsicF.args)) == 1) { keyc_useStorage (); outText (p, (const char *) "Storage_ALLOCATE", 16); mcPretty_setNeedSpace (p); outText (p, (const char *) "((void **)", 10); mcPretty_setNeedSpace (p); outText (p, (const char *) "&", 1); doExprC (p, getExpList (n->intrinsicF.args, 1)); outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); t = decl_skipType (decl_getType (getExpList (n->intrinsicF.args, 1))); if (decl_isPointer (t)) { t = decl_getType (t); outText (p, (const char *) "sizeof", 6); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doTypeNameC (p, t); mcPretty_noSpace (p); outText (p, (const char *) "))", 2); } else { 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)); } } } } /* doDisposeC - */ static void doDisposeC (mcPretty_pretty p, decl_node n) { decl_node t; mcDebug_assert (isIntrinsic (n)); if (n->intrinsicF.args == NULL) { M2RTS_HALT (-1); __builtin_unreachable (); } else { if ((expListLen (n->intrinsicF.args)) == 1) { keyc_useStorage (); outText (p, (const char *) "Storage_DEALLOCATE", 18); mcPretty_setNeedSpace (p); outText (p, (const char *) "((void **)", 10); mcPretty_setNeedSpace (p); outText (p, (const char *) "&", 1); doExprC (p, getExpList (n->intrinsicF.args, 1)); outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); t = decl_skipType (decl_getType (getExpList (n->intrinsicF.args, 1))); if (decl_isPointer (t)) { t = decl_getType (t); outText (p, (const char *) "sizeof", 6); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doTypeNameC (p, t); mcPretty_noSpace (p); outText (p, (const char *) "))", 2); } else { 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)); } } else { M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to DISPOSE') */ __builtin_unreachable (); } } } /* doCapC - */ static void doCapC (mcPretty_pretty p, decl_node n) { mcDebug_assert (isUnary (n)); if (n->unaryF.arg == NULL) { M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to CAP') */ __builtin_unreachable (); } else { keyc_useCtype (); if (mcOptions_getGccConfigSystem ()) { outText (p, (const char *) "TOUPPER", 7); } else { outText (p, (const char *) "toupper", 7); } mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->unaryF.arg); outText (p, (const char *) ")", 1); } } /* doLengthC - */ static void doLengthC (mcPretty_pretty p, decl_node n) { mcDebug_assert (isUnary (n)); if (n->unaryF.arg == NULL) { M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to LENGTH') */ __builtin_unreachable (); } else { keyc_useM2RTS (); outText (p, (const char *) "M2RTS_Length", 12); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->unaryF.arg); outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); doFuncHighC (p, n->unaryF.arg); outText (p, (const char *) ")", 1); } } /* doAbsC - */ static void doAbsC (mcPretty_pretty p, decl_node n) { decl_node t; mcDebug_assert (isUnary (n)); if (n->unaryF.arg == NULL) { M2RTS_HALT (-1); __builtin_unreachable (); } else { t = getExprType (n); } if (t == longintN) { keyc_useLabs (); outText (p, (const char *) "labs", 4); } else if (t == integerN) { /* avoid dangling else. */ keyc_useAbs (); outText (p, (const char *) "abs", 3); } else if (t == realN) { /* avoid dangling else. */ keyc_useFabs (); outText (p, (const char *) "fabs", 4); } else if (t == longrealN) { /* avoid dangling else. */ keyc_useFabsl (); outText (p, (const char *) "fabsl", 5); } else if (t == cardinalN) { /* avoid dangling else. */ } else { /* avoid dangling else. */ /* do nothing. */ M2RTS_HALT (-1); __builtin_unreachable (); } mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->unaryF.arg); outText (p, (const char *) ")", 1); } /* doValC - */ static void doValC (mcPretty_pretty p, decl_node n) { mcDebug_assert (isBinary (n)); outText (p, (const char *) "(", 1); doTypeNameC (p, n->binaryF.left); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->binaryF.right); outText (p, (const char *) ")", 1); } /* doMinC - */ static void doMinC (mcPretty_pretty p, decl_node n) { decl_node t; mcDebug_assert (isUnary (n)); t = getExprType (n->unaryF.arg); doExprC (p, getMin (t)); } /* doMaxC - */ static void doMaxC (mcPretty_pretty p, decl_node n) { decl_node t; mcDebug_assert (isUnary (n)); t = getExprType (n->unaryF.arg); doExprC (p, getMax (t)); } /* isIntrinsic - returns if, n, is an intrinsic procedure. The intrinsic functions are represented as unary and binary nodes. */ static unsigned int isIntrinsic (decl_node n) { switch (n->kind) { case decl_unreachable: case decl_throw: case decl_inc: case decl_dec: case decl_incl: case decl_excl: case decl_new: case decl_dispose: case decl_halt: return TRUE; break; default: return FALSE; break; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doHalt - */ static void doHalt (mcPretty_pretty p, decl_node n) { mcDebug_assert (n->kind == decl_halt); if ((n->intrinsicF.args == NULL) || ((expListLen (n->intrinsicF.args)) == 0)) { outText (p, (const char *) "M2RTS_HALT", 10); mcPretty_setNeedSpace (p); outText (p, (const char *) "(-1)", 4); } else if ((expListLen (n->intrinsicF.args)) == 1) { /* avoid dangling else. */ outText (p, (const char *) "M2RTS_HALT", 10); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, getExpList (n->intrinsicF.args, 1)); outText (p, (const char *) ")", 1); } } /* doCreal - emit the appropriate creal function. */ static void doCreal (mcPretty_pretty p, decl_node t) { switch (t->kind) { case decl_complex: keyc_useComplex (); outText (p, (const char *) "creal", 5); break; case decl_longcomplex: keyc_useComplex (); outText (p, (const char *) "creall", 6); break; case decl_shortcomplex: keyc_useComplex (); outText (p, (const char *) "crealf", 6); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* doCimag - emit the appropriate cimag function. */ static void doCimag (mcPretty_pretty p, decl_node t) { switch (t->kind) { case decl_complex: keyc_useComplex (); outText (p, (const char *) "cimag", 5); break; case decl_longcomplex: keyc_useComplex (); outText (p, (const char *) "cimagl", 6); break; case decl_shortcomplex: keyc_useComplex (); outText (p, (const char *) "cimagf", 6); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* doReC - */ static void doReC (mcPretty_pretty p, decl_node n) { decl_node t; mcDebug_assert (n->kind == decl_re); if (n->unaryF.arg != NULL) { t = getExprType (n->unaryF.arg); } else { M2RTS_HALT (-1); __builtin_unreachable (); } doCreal (p, t); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->unaryF.arg); outText (p, (const char *) ")", 1); } /* doImC - */ static void doImC (mcPretty_pretty p, decl_node n) { decl_node t; mcDebug_assert (n->kind == decl_im); if (n->unaryF.arg != NULL) { t = getExprType (n->unaryF.arg); } else { M2RTS_HALT (-1); __builtin_unreachable (); } doCimag (p, t); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->unaryF.arg); outText (p, (const char *) ")", 1); } /* doCmplx - */ static void doCmplx (mcPretty_pretty p, decl_node n) { mcDebug_assert (isBinary (n)); keyc_useComplex (); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->binaryF.left); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "+", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->binaryF.right); mcPretty_setNeedSpace (p); outText (p, (const char *) "*", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "I", 1); outText (p, (const char *) ")", 1); } /* doIntrinsicC - */ static void doIntrinsicC (mcPretty_pretty p, decl_node n) { mcDebug_assert (isIntrinsic (n)); doCommentC (p, n->intrinsicF.intrinsicComment.body); switch (n->kind) { case decl_unreachable: doUnreachableC (p, n); break; case decl_throw: doThrowC (p, n); break; case decl_halt: doHalt (p, n); break; case decl_inc: doInc (p, n); break; case decl_dec: doDec (p, n); break; case decl_incl: doInclC (p, n); break; case decl_excl: doExclC (p, n); break; case decl_new: doNewC (p, n); break; case decl_dispose: doDisposeC (p, n); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } outText (p, (const char *) ";", 1); doAfterCommentC (p, n->intrinsicF.intrinsicComment.after); } /* isIntrinsicFunction - returns true if, n, is an instrinsic function. */ static unsigned int isIntrinsicFunction (decl_node n) { switch (n->kind) { case decl_val: case decl_adr: case decl_size: case decl_tsize: case decl_float: case decl_trunc: case decl_ord: case decl_chr: case decl_cap: case decl_abs: case decl_high: case decl_length: case decl_min: case decl_max: case decl_re: case decl_im: case decl_cmplx: return TRUE; break; default: return FALSE; break; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doSizeC - */ static void doSizeC (mcPretty_pretty p, decl_node n) { mcDebug_assert (isUnary (n)); outText (p, (const char *) "sizeof (", 8); doExprC (p, n->unaryF.arg); outText (p, (const char *) ")", 1); } /* doConvertC - */ static void doConvertC (mcPretty_pretty p, decl_node n, const char *conversion_, unsigned int _conversion_high) { char conversion[_conversion_high+1]; /* make a local copy of each unbounded array. */ memcpy (conversion, conversion_, _conversion_high+1); mcDebug_assert (isUnary (n)); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); outText (p, (const char *) conversion, _conversion_high); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->unaryF.arg); outText (p, (const char *) "))", 2); } /* getFuncFromExpr - */ static decl_node getFuncFromExpr (decl_node n) { n = decl_skipType (decl_getType (n)); while ((n != procN) && (! (decl_isProcType (n)))) { n = decl_skipType (decl_getType (n)); } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doFuncExprC - */ static void doFuncExprC (mcPretty_pretty p, decl_node n) { decl_node t; mcDebug_assert (isFuncCall (n)); if (decl_isProcedure (n->funccallF.function)) { doFQDNameC (p, n->funccallF.function, TRUE); mcPretty_setNeedSpace (p); doFuncArgsC (p, n, n->funccallF.function->procedureF.parameters, TRUE); } else { outText (p, (const char *) "(*", 2); doExprC (p, n->funccallF.function); outText (p, (const char *) ".proc", 5); outText (p, (const char *) ")", 1); t = getFuncFromExpr (n->funccallF.function); mcPretty_setNeedSpace (p); if (t == procN) { doProcTypeArgsC (p, n, NULL, TRUE); } else { mcDebug_assert (decl_isProcType (t)); doProcTypeArgsC (p, n, t->proctypeF.parameters, TRUE); } } } /* doFuncCallC - */ static void doFuncCallC (mcPretty_pretty p, decl_node n) { doCommentC (p, n->funccallF.funccallComment.body); doFuncExprC (p, n); outText (p, (const char *) ";", 1); doAfterCommentC (p, n->funccallF.funccallComment.after); } /* doCaseStatementC - */ static void doCaseStatementC (mcPretty_pretty p, decl_node n, unsigned int needBreak) { p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); doStatementSequenceC (p, n); if (needBreak) { outText (p, (const char *) "break;\\n", 8); } p = mcPretty_popPretty (p); } /* doExceptionC - */ static void doExceptionC (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n) { unsigned int w; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); w = decl_getDeclaredMod (n); outText (p, (const char *) a, _a_high); mcPretty_setNeedSpace (p); outText (p, (const char *) "(\"", 2); outTextS (p, mcLexBuf_findFileNameFromToken (w, 0)); outText (p, (const char *) "\",", 2); mcPretty_setNeedSpace (p); outCard (p, mcLexBuf_tokenToLineNo (w, 0)); outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); outCard (p, mcLexBuf_tokenToColumnNo (w, 0)); outText (p, (const char *) ");\\n", 4); outText (p, (const char *) "__builtin_unreachable ();\\n", 27); } /* doExceptionCP - */ static void doExceptionCP (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n) { unsigned int w; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); w = decl_getDeclaredMod (n); outText (p, (const char *) a, _a_high); mcPretty_setNeedSpace (p); outText (p, (const char *) "(\"", 2); outTextS (p, mcLexBuf_findFileNameFromToken (w, 0)); outText (p, (const char *) "\",", 2); mcPretty_setNeedSpace (p); outCard (p, mcLexBuf_tokenToLineNo (w, 0)); outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); outCard (p, mcLexBuf_tokenToColumnNo (w, 0)); outText (p, (const char *) ");\\n", 4); outText (p, (const char *) "__builtin_unreachable ();\\n", 27); } /* doException - */ static void doException (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n) { char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); keyc_useException (); if (lang == decl_ansiCP) { doExceptionCP (p, (const char *) a, _a_high, n); } else { doExceptionC (p, (const char *) a, _a_high, n); } } /* doRangeListC - */ static void doRangeListC (mcPretty_pretty p, decl_node c) { decl_node r; unsigned int i; unsigned int h; mcDebug_assert (decl_isCaseList (c)); i = 1; h = Indexing_HighIndice (c->caselistF.rangePairs); while (i <= h) { r = static_cast (Indexing_GetIndice (c->caselistF.rangePairs, i)); mcDebug_assert ((r->rangeF.hi == NULL) || (r->rangeF.lo == r->rangeF.hi)); outText (p, (const char *) "case", 4); mcPretty_setNeedSpace (p); doExprC (p, r->rangeF.lo); outText (p, (const char *) ":\\n", 3); i += 1; } } /* doRangeIfListC - */ static void doRangeIfListC (mcPretty_pretty p, decl_node e, decl_node c) { decl_node r; unsigned int i; unsigned int h; mcDebug_assert (decl_isCaseList (c)); i = 1; h = Indexing_HighIndice (c->caselistF.rangePairs); while (i <= h) { r = static_cast (Indexing_GetIndice (c->caselistF.rangePairs, i)); if ((r->rangeF.lo != r->rangeF.hi) && (r->rangeF.hi != NULL)) { outText (p, (const char *) "((", 2); doExprC (p, e); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) ">=", 2); mcPretty_setNeedSpace (p); doExprC (p, r->rangeF.lo); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "&&", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "((", 2); doExprC (p, e); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "<=", 2); mcPretty_setNeedSpace (p); doExprC (p, r->rangeF.hi); outText (p, (const char *) ")", 1); } else { outText (p, (const char *) "((", 2); doExprC (p, e); outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "==", 2); mcPretty_setNeedSpace (p); doExprC (p, r->rangeF.lo); outText (p, (const char *) ")", 1); } if (i < h) { mcPretty_setNeedSpace (p); outText (p, (const char *) "||", 2); mcPretty_setNeedSpace (p); } i += 1; } } /* doCaseLabels - */ static void doCaseLabels (mcPretty_pretty p, decl_node n, unsigned int needBreak) { mcDebug_assert (decl_isCaseLabelList (n)); doRangeListC (p, n->caselabellistF.caseList); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); doStatementSequenceC (p, n->caselabellistF.statements); if (needBreak) { outText (p, (const char *) "break;\\n\\n", 10); } p = mcPretty_popPretty (p); } /* doCaseLabelListC - */ static void doCaseLabelListC (mcPretty_pretty p, decl_node n, unsigned int haveElse) { unsigned int i; unsigned int h; decl_node c; mcDebug_assert (decl_isCase (n)); i = 1; h = Indexing_HighIndice (n->caseF.caseLabelList); while (i <= h) { c = static_cast (Indexing_GetIndice (n->caseF.caseLabelList, i)); doCaseLabels (p, c, ((i < h) || haveElse) || caseException); i += 1; } } /* doCaseIfLabels - */ static void doCaseIfLabels (mcPretty_pretty p, decl_node e, decl_node n, unsigned int i, unsigned int h) { mcDebug_assert (decl_isCaseLabelList (n)); if (i > 1) { outText (p, (const char *) "else", 4); mcPretty_setNeedSpace (p); } outText (p, (const char *) "if", 2); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doRangeIfListC (p, e, n->caselabellistF.caseList); outText (p, (const char *) ")\\n", 3); if (h == 1) { doCompoundStmt (p, n->caselabellistF.statements); } else { outText (p, (const char *) "{\\n", 3); doStatementSequenceC (p, n->caselabellistF.statements); outText (p, (const char *) "}\\n", 3); } } /* doCaseIfLabelListC - */ static void doCaseIfLabelListC (mcPretty_pretty p, decl_node n) { unsigned int i; unsigned int h; decl_node c; mcDebug_assert (decl_isCase (n)); i = 1; h = Indexing_HighIndice (n->caseF.caseLabelList); while (i <= h) { c = static_cast (Indexing_GetIndice (n->caseF.caseLabelList, i)); doCaseIfLabels (p, n->caseF.expression, c, i, h); i += 1; } } /* doCaseElseC - */ static void doCaseElseC (mcPretty_pretty p, decl_node n) { mcDebug_assert (decl_isCase (n)); if (n->caseF.else_ == NULL) { /* avoid dangling else. */ if (caseException) { outText (p, (const char *) "\\ndefault:\\n", 12); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); doException (p, (const char *) "CaseException", 13, n); p = mcPretty_popPretty (p); } } else { outText (p, (const char *) "\\ndefault:\\n", 12); doCaseStatementC (p, n->caseF.else_, TRUE); } } /* doCaseIfElseC - */ static void doCaseIfElseC (mcPretty_pretty p, decl_node n) { mcDebug_assert (decl_isCase (n)); if (n->caseF.else_ == NULL) { /* avoid dangling else. */ if (TRUE) { outText (p, (const char *) "\\n", 2); outText (p, (const char *) "else {\\n", 8); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); doException (p, (const char *) "CaseException", 13, n); p = mcPretty_popPretty (p); outText (p, (const char *) "}\\n", 3); } } else { outText (p, (const char *) "\\n", 2); outText (p, (const char *) "else {\\n", 8); doCaseStatementC (p, n->caseF.else_, FALSE); outText (p, (const char *) "}\\n", 3); } } /* canUseSwitchCaseLabels - returns TRUE if all the case labels are single values and not ranges. */ static unsigned int canUseSwitchCaseLabels (decl_node n) { unsigned int i; unsigned int h; decl_node r; decl_node l; mcDebug_assert (decl_isCaseLabelList (n)); l = n->caselabellistF.caseList; i = 1; h = Indexing_HighIndice (l->caselistF.rangePairs); while (i <= h) { r = static_cast (Indexing_GetIndice (l->caselistF.rangePairs, i)); if ((r->rangeF.hi != NULL) && (r->rangeF.lo != r->rangeF.hi)) { return FALSE; } i += 1; } return TRUE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* canUseSwitch - returns TRUE if the case statement can be implement by a switch statement. This will be TRUE if all case selectors are single values rather than ranges. */ static unsigned int canUseSwitch (decl_node n) { unsigned int i; unsigned int h; decl_node c; mcDebug_assert (decl_isCase (n)); i = 1; h = Indexing_HighIndice (n->caseF.caseLabelList); while (i <= h) { c = static_cast (Indexing_GetIndice (n->caseF.caseLabelList, i)); if (! (canUseSwitchCaseLabels (c))) { return FALSE; } i += 1; } return TRUE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doCaseC - */ static void doCaseC (mcPretty_pretty p, decl_node n) { unsigned int i; mcDebug_assert (decl_isCase (n)); if (canUseSwitch (n)) { i = mcPretty_getindent (p); outText (p, (const char *) "switch", 6); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->caseF.expression); p = mcPretty_pushPretty (p); outText (p, (const char *) ")", 1); mcPretty_setindent (p, i+indentationC); outText (p, (const char *) "\\n{\\n", 5); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); doCaseLabelListC (p, n, n->caseF.else_ != NULL); doCaseElseC (p, n); p = mcPretty_popPretty (p); outText (p, (const char *) "}\\n", 3); p = mcPretty_popPretty (p); } else { doCaseIfLabelListC (p, n); doCaseIfElseC (p, n); } } /* doLoopC - */ static void doLoopC (mcPretty_pretty p, decl_node s) { mcDebug_assert (decl_isLoop (s)); outText (p, (const char *) "for (;;)\\n", 10); outText (p, (const char *) "{\\n", 3); p = mcPretty_pushPretty (p); mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); doStatementSequenceC (p, s->loopF.statements); p = mcPretty_popPretty (p); outText (p, (const char *) "}\\n", 3); } /* doExitC - */ static void doExitC (mcPretty_pretty p, decl_node s) { mcDebug_assert (decl_isExit (s)); outText (p, (const char *) "/* exit. */\\n", 14); } /* doStatementsC - */ static void doStatementsC (mcPretty_pretty p, decl_node s) { if (s == NULL) {} /* empty. */ else if (decl_isStatementSequence (s)) { /* avoid dangling else. */ doStatementSequenceC (p, s); } else if (isComment (s)) { /* avoid dangling else. */ doCommentC (p, s); } else if (decl_isExit (s)) { /* avoid dangling else. */ doExitC (p, s); } else if (decl_isReturn (s)) { /* avoid dangling else. */ doReturnC (p, s); } else if (isAssignment (s)) { /* avoid dangling else. */ doAssignmentC (p, s); } else if (decl_isIf (s)) { /* avoid dangling else. */ doIfC (p, s); } else if (decl_isFor (s)) { /* avoid dangling else. */ doForC (p, s); } else if (decl_isRepeat (s)) { /* avoid dangling else. */ doRepeatC (p, s); } else if (decl_isWhile (s)) { /* avoid dangling else. */ doWhileC (p, s); } else if (isIntrinsic (s)) { /* avoid dangling else. */ doIntrinsicC (p, s); } else if (isFuncCall (s)) { /* avoid dangling else. */ doFuncCallC (p, s); } else if (decl_isCase (s)) { /* avoid dangling else. */ doCaseC (p, s); } else if (decl_isLoop (s)) { /* avoid dangling else. */ doLoopC (p, s); } else if (decl_isExit (s)) { /* avoid dangling else. */ doExitC (p, s); } else { /* avoid dangling else. */ M2RTS_HALT (-1); /* need to handle another s^.kind. */ __builtin_unreachable (); } } static void stop (void) { } /* doLocalVarC - */ static void doLocalVarC (mcPretty_pretty p, decl_scopeT s) { includeVarProcedure (s); debugLists (); 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}); } /* doLocalConstTypesC - */ static void doLocalConstTypesC (mcPretty_pretty p, decl_scopeT s) { simplifyTypes (s); includeConstType (s); doP = p; 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}); } /* addParamDone - */ static void addParamDone (decl_node n) { if ((decl_isVar (n)) && n->varF.isParameter) { addDone (n); addDone (decl_getType (n)); } } /* includeParameters - */ static void includeParameters (decl_node n) { mcDebug_assert (decl_isProcedure (n)); Indexing_ForeachIndiceInIndexDo (n->procedureF.decls.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addParamDone}); } /* isHalt - */ static unsigned int isHalt (decl_node n) { return n->kind == decl_halt; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isReturnOrHalt - */ static unsigned int isReturnOrHalt (decl_node n) { return (isHalt (n)) || (decl_isReturn (n)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isLastStatementReturn - */ static unsigned int isLastStatementReturn (decl_node n) { return isLastStatement (n, (decl_isNodeF) {(decl_isNodeF_t) isReturnOrHalt}); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isLastStatementSequence - */ static unsigned int isLastStatementSequence (decl_node n, decl_isNodeF q) { unsigned int h; mcDebug_assert (decl_isStatementSequence (n)); h = Indexing_HighIndice (n->stmtF.statements); if (h > 0) { return isLastStatement (reinterpret_cast (Indexing_GetIndice (n->stmtF.statements, h)), q); } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isLastStatementIf - */ static unsigned int isLastStatementIf (decl_node n, decl_isNodeF q) { unsigned int ret; mcDebug_assert (decl_isIf (n)); ret = TRUE; if ((n->ifF.elsif != NULL) && ret) { ret = isLastStatement (n->ifF.elsif, q); } if ((n->ifF.then != NULL) && ret) { ret = isLastStatement (n->ifF.then, q); } if ((n->ifF.else_ != NULL) && ret) { ret = isLastStatement (n->ifF.else_, q); } return ret; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isLastStatementElsif - */ static unsigned int isLastStatementElsif (decl_node n, decl_isNodeF q) { unsigned int ret; mcDebug_assert (decl_isElsif (n)); ret = TRUE; if ((n->elsifF.elsif != NULL) && ret) { ret = isLastStatement (n->elsifF.elsif, q); } if ((n->elsifF.then != NULL) && ret) { ret = isLastStatement (n->elsifF.then, q); } if ((n->elsifF.else_ != NULL) && ret) { ret = isLastStatement (n->elsifF.else_, q); } return ret; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isLastStatementCase - */ static unsigned int isLastStatementCase (decl_node n, decl_isNodeF q) { unsigned int ret; unsigned int i; unsigned int h; decl_node c; ret = TRUE; mcDebug_assert (decl_isCase (n)); i = 1; h = Indexing_HighIndice (n->caseF.caseLabelList); while (i <= h) { c = static_cast (Indexing_GetIndice (n->caseF.caseLabelList, i)); mcDebug_assert (decl_isCaseLabelList (c)); ret = ret && (isLastStatement (c->caselabellistF.statements, q)); i += 1; } if (n->caseF.else_ != NULL) { ret = ret && (isLastStatement (n->caseF.else_, q)); } return ret; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isLastStatement - returns TRUE if the last statement in, n, is, q. */ static unsigned int isLastStatement (decl_node n, decl_isNodeF q) { unsigned int ret; if (n == NULL) { return FALSE; } else if (decl_isStatementSequence (n)) { /* avoid dangling else. */ return isLastStatementSequence (n, q); } else if (decl_isProcedure (n)) { /* avoid dangling else. */ mcDebug_assert (decl_isProcedure (n)); return isLastStatement (n->procedureF.beginStatements, q); } else if (decl_isIf (n)) { /* avoid dangling else. */ return isLastStatementIf (n, q); } else if (decl_isElsif (n)) { /* avoid dangling else. */ return isLastStatementElsif (n, q); } else if (decl_isCase (n)) { /* avoid dangling else. */ return isLastStatementCase (n, q); } else if ((*q.proc) (n)) { /* avoid dangling else. */ return TRUE; } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doProcedureC - */ static void doProcedureC (decl_node n) { unsigned int s; outText (doP, (const char *) "\\n", 2); includeParameters (n); keyc_enterScope (n); doProcedureHeadingC (n, FALSE); outText (doP, (const char *) "\\n", 2); doP = outKc (doP, (const char *) "{\\n", 3); s = mcPretty_getcurline (doP); doLocalConstTypesC (doP, n->procedureF.decls); doLocalVarC (doP, n->procedureF.decls); doUnboundedParamCopyC (doP, n); if (s != (mcPretty_getcurline (doP))) { outText (doP, (const char *) "\\n", 2); } doStatementsC (doP, n->procedureF.beginStatements); if (n->procedureF.returnType != NULL) { if (returnException) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if (isLastStatementReturn (n)) { outText (doP, (const char *) "/* static analysis guarentees a RETURN statement will be used before here. */\\n", 80); outText (doP, (const char *) "__builtin_unreachable ();\\n", 27); } else { doException (doP, (const char *) "ReturnException", 15, n); } } } doP = outKc (doP, (const char *) "}\\n", 3); keyc_leaveScope (n); } /* outProceduresC - */ static void outProceduresC (mcPretty_pretty p, decl_scopeT s) { doP = p; if (debugDecl) { libc_printf ((const char *) "seen %d procedures\\n", 20, Indexing_HighIndice (s.procedures)); } Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doProcedureC}); } /* output - */ static void output (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v) { if (decl_isConst (n)) { (*c.proc) (n); } else if (decl_isVar (n)) { /* avoid dangling else. */ (*v.proc) (n); } else { /* avoid dangling else. */ (*t.proc) (n); } } /* allDependants - */ static decl_dependentState allDependants (decl_node n) { alists_alist l; decl_dependentState s; l = alists_initList (); s = walkDependants (l, n); alists_killList (&l); return s; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkDependants - */ static decl_dependentState walkDependants (alists_alist l, decl_node n) { if ((n == NULL) || (alists_isItemInList (doneQ, reinterpret_cast (n)))) { return decl_completed; } else if (alists_isItemInList (l, reinterpret_cast (n))) { /* avoid dangling else. */ return decl_recursive; } else { /* avoid dangling else. */ alists_includeItemIntoList (l, reinterpret_cast (n)); return doDependants (l, n); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkType - */ static decl_dependentState walkType (alists_alist l, decl_node n) { decl_node t; t = decl_getType (n); if (alists_isItemInList (doneQ, reinterpret_cast (t))) { return decl_completed; } else if (alists_isItemInList (partialQ, reinterpret_cast (t))) { /* avoid dangling else. */ return decl_blocked; } else { /* avoid dangling else. */ queueBlocked (t); return decl_blocked; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* db - */ static void db (const char *a_, unsigned int _a_high, decl_node n) { char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); if (mcOptions_getDebugTopological ()) { outText (doP, (const char *) a, _a_high); if (n != NULL) { outTextS (doP, gen (n)); } } } /* dbt - */ static void dbt (const char *a_, unsigned int _a_high) { char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); if (mcOptions_getDebugTopological ()) { outText (doP, (const char *) a, _a_high); } } /* dbs - */ static void dbs (decl_dependentState s, decl_node n) { if (mcOptions_getDebugTopological ()) { switch (s) { case decl_completed: outText (doP, (const char *) "{completed ", 11); break; case decl_blocked: outText (doP, (const char *) "{blocked ", 9); break; case decl_partial: outText (doP, (const char *) "{partial ", 9); break; case decl_recursive: outText (doP, (const char *) "{recursive ", 11); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } if (n != NULL) { outTextS (doP, gen (n)); } outText (doP, (const char *) "}\\n", 3); } } /* dbq - */ static void dbq (decl_node n) { if (mcOptions_getDebugTopological ()) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if (alists_isItemInList (todoQ, reinterpret_cast (n))) { db ((const char *) "{T", 2, n); outText (doP, (const char *) "}", 1); } else if (alists_isItemInList (partialQ, reinterpret_cast (n))) { /* avoid dangling else. */ db ((const char *) "{P", 2, n); outText (doP, (const char *) "}", 1); } else if (alists_isItemInList (doneQ, reinterpret_cast (n))) { /* avoid dangling else. */ db ((const char *) "{D", 2, n); outText (doP, (const char *) "}", 1); } } } /* walkRecord - */ static decl_dependentState walkRecord (alists_alist l, decl_node n) { decl_dependentState s; unsigned int o; unsigned int i; unsigned int t; decl_node q; i = Indexing_LowIndice (n->recordF.listOfSons); t = Indexing_HighIndice (n->recordF.listOfSons); db ((const char *) "\\nwalking ", 10, n); o = mcPretty_getindent (doP); mcPretty_setindent (doP, (mcPretty_getcurpos (doP))+3); dbq (n); while (i <= t) { q = static_cast (Indexing_GetIndice (n->recordF.listOfSons, i)); db ((const char *) "", 0, q); if ((decl_isRecordField (q)) && q->recordfieldF.tag) {} /* empty. */ else { /* do nothing as it is a tag selector processed in the varient. */ s = walkDependants (l, q); if (s != decl_completed) { dbs (s, q); addTodo (n); dbq (n); db ((const char *) "\\n", 2, NULL); mcPretty_setindent (doP, o); return s; } } i += 1; } db ((const char *) "{completed", 10, n); dbt ((const char *) "}\\n", 3); mcPretty_setindent (doP, o); return decl_completed; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkVarient - */ static decl_dependentState walkVarient (alists_alist l, decl_node n) { decl_dependentState s; unsigned int i; unsigned int t; decl_node q; db ((const char *) "\\nwalking", 9, n); s = walkDependants (l, n->varientF.tag); if (s != decl_completed) { dbs (s, n->varientF.tag); dbq (n->varientF.tag); db ((const char *) "\\n", 2, NULL); return s; } i = Indexing_LowIndice (n->varientF.listOfSons); t = Indexing_HighIndice (n->varientF.listOfSons); while (i <= t) { q = static_cast (Indexing_GetIndice (n->varientF.listOfSons, i)); db ((const char *) "", 0, q); s = walkDependants (l, q); if (s != decl_completed) { dbs (s, q); db ((const char *) "\\n", 2, NULL); return s; } i += 1; } db ((const char *) "{completed", 10, n); dbt ((const char *) "}\\n", 3); return decl_completed; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* queueBlocked - */ static void queueBlocked (decl_node n) { if (! ((alists_isItemInList (doneQ, reinterpret_cast (n))) || (alists_isItemInList (partialQ, reinterpret_cast (n))))) { addTodo (n); } } /* walkVar - */ static decl_dependentState walkVar (alists_alist l, decl_node n) { decl_node t; t = decl_getType (n); if (alists_isItemInList (doneQ, reinterpret_cast (t))) { return decl_completed; } else { queueBlocked (t); return decl_blocked; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkEnumeration - */ static decl_dependentState walkEnumeration (alists_alist l, decl_node n) { decl_dependentState s; unsigned int i; unsigned int t; decl_node q; i = Indexing_LowIndice (n->enumerationF.listOfSons); t = Indexing_HighIndice (n->enumerationF.listOfSons); s = decl_completed; while (i <= t) { q = static_cast (Indexing_GetIndice (n->enumerationF.listOfSons, i)); s = walkDependants (l, q); if (s != decl_completed) { return s; } i += 1; } return s; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkSubrange - */ static decl_dependentState walkSubrange (alists_alist l, decl_node n) { decl_dependentState s; s = walkDependants (l, n->subrangeF.low); if (s != decl_completed) { return s; } s = walkDependants (l, n->subrangeF.high); if (s != decl_completed) { return s; } s = walkDependants (l, n->subrangeF.type); if (s != decl_completed) { return s; } return decl_completed; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkSubscript - */ static decl_dependentState walkSubscript (alists_alist l, decl_node n) { decl_dependentState s; s = walkDependants (l, n->subscriptF.expr); if (s != decl_completed) { return s; } s = walkDependants (l, n->subscriptF.type); if (s != decl_completed) { return s; } return decl_completed; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkPointer - */ static decl_dependentState walkPointer (alists_alist l, decl_node n) { decl_node t; /* if the type of, n, is done or partial then we can output pointer. */ t = decl_getType (n); if ((alists_isItemInList (partialQ, reinterpret_cast (t))) || (alists_isItemInList (doneQ, reinterpret_cast (t)))) { /* pointer to partial can always generate a complete type. */ return decl_completed; } return walkType (l, n); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkArray - */ static decl_dependentState walkArray (alists_alist l, decl_node n) { decl_dependentState s; /* an array can only be declared if its data type has already been emitted. */ if (! (alists_isItemInList (doneQ, reinterpret_cast (n->arrayF.type)))) { s = walkDependants (l, n->arrayF.type); queueBlocked (n->arrayF.type); if (s == decl_completed) { /* downgrade the completed to partial as it has not yet been written. */ return decl_partial; } else { return s; } } return walkDependants (l, n->arrayF.subr); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkConst - */ static decl_dependentState walkConst (alists_alist l, decl_node n) { decl_dependentState s; s = walkDependants (l, n->constF.type); if (s != decl_completed) { return s; } s = walkDependants (l, n->constF.value); if (s != decl_completed) { return s; } return decl_completed; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkVarParam - */ static decl_dependentState walkVarParam (alists_alist l, decl_node n) { decl_node t; t = decl_getType (n); if (alists_isItemInList (partialQ, reinterpret_cast (t))) { /* parameter can be issued from a partial. */ return decl_completed; } return walkDependants (l, t); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkParam - */ static decl_dependentState walkParam (alists_alist l, decl_node n) { decl_node t; t = decl_getType (n); if (alists_isItemInList (partialQ, reinterpret_cast (t))) { /* parameter can be issued from a partial. */ return decl_completed; } return walkDependants (l, t); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkOptarg - */ static decl_dependentState walkOptarg (alists_alist l, decl_node n) { decl_node t; t = decl_getType (n); if (alists_isItemInList (partialQ, reinterpret_cast (t))) { /* parameter can be issued from a partial. */ return decl_completed; } return walkDependants (l, t); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkRecordField - */ static decl_dependentState walkRecordField (alists_alist l, decl_node n) { decl_node t; decl_dependentState s; mcDebug_assert (decl_isRecordField (n)); t = decl_getType (n); if (alists_isItemInList (partialQ, reinterpret_cast (t))) { dbs (decl_partial, n); return decl_partial; } else if (alists_isItemInList (doneQ, reinterpret_cast (t))) { /* avoid dangling else. */ dbs (decl_completed, n); return decl_completed; } else { /* avoid dangling else. */ addTodo (t); dbs (decl_blocked, n); dbq (n); dbq (t); /* s := walkDependants (l, t) */ return decl_blocked; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkVarientField - */ static decl_dependentState walkVarientField (alists_alist l, decl_node n) { decl_dependentState s; unsigned int i; unsigned int t; decl_node q; i = Indexing_LowIndice (n->varientfieldF.listOfSons); t = Indexing_HighIndice (n->varientfieldF.listOfSons); s = decl_completed; while (i <= t) { q = static_cast (Indexing_GetIndice (n->varientfieldF.listOfSons, i)); s = walkDependants (l, q); if (s != decl_completed) { dbs (s, n); return s; } i += 1; } n->varientfieldF.simple = t <= 1; dbs (s, n); return s; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkEnumerationField - */ static decl_dependentState walkEnumerationField (alists_alist l, decl_node n) { return decl_completed; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkSet - */ static decl_dependentState walkSet (alists_alist l, decl_node n) { return walkDependants (l, decl_getType (n)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkProcType - */ static decl_dependentState walkProcType (alists_alist l, decl_node n) { decl_dependentState s; decl_node t; t = decl_getType (n); if (alists_isItemInList (partialQ, reinterpret_cast (t))) {} /* empty. */ else { /* proctype can be generated from partial types. */ s = walkDependants (l, t); if (s != decl_completed) { return s; } } return walkParameters (l, n->proctypeF.parameters); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkProcedure - */ static decl_dependentState walkProcedure (alists_alist l, decl_node n) { decl_dependentState s; s = walkDependants (l, decl_getType (n)); if (s != decl_completed) { return s; } return walkParameters (l, n->procedureF.parameters); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkParameters - */ static decl_dependentState walkParameters (alists_alist l, Indexing_Index p) { decl_dependentState s; unsigned int i; unsigned int h; decl_node q; i = Indexing_LowIndice (p); h = Indexing_HighIndice (p); while (i <= h) { q = static_cast (Indexing_GetIndice (p, i)); s = walkDependants (l, q); if (s != decl_completed) { return s; } i += 1; } return decl_completed; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkFuncCall - */ static decl_dependentState walkFuncCall (alists_alist l, decl_node n) { return decl_completed; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkUnary - */ static decl_dependentState walkUnary (alists_alist l, decl_node n) { decl_dependentState s; s = walkDependants (l, n->unaryF.arg); if (s != decl_completed) { return s; } return walkDependants (l, n->unaryF.resultType); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkBinary - */ static decl_dependentState walkBinary (alists_alist l, decl_node n) { decl_dependentState s; s = walkDependants (l, n->binaryF.left); if (s != decl_completed) { return s; } s = walkDependants (l, n->binaryF.right); if (s != decl_completed) { return s; } return walkDependants (l, n->binaryF.resultType); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkComponentRef - */ static decl_dependentState walkComponentRef (alists_alist l, decl_node n) { decl_dependentState s; s = walkDependants (l, n->componentrefF.rec); if (s != decl_completed) { return s; } s = walkDependants (l, n->componentrefF.field); if (s != decl_completed) { return s; } return walkDependants (l, n->componentrefF.resultType); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkPointerRef - */ static decl_dependentState walkPointerRef (alists_alist l, decl_node n) { decl_dependentState s; s = walkDependants (l, n->pointerrefF.ptr); if (s != decl_completed) { return s; } s = walkDependants (l, n->pointerrefF.field); if (s != decl_completed) { return s; } return walkDependants (l, n->pointerrefF.resultType); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* walkSetValue - */ static decl_dependentState walkSetValue (alists_alist l, decl_node n) { decl_dependentState s; unsigned int i; unsigned int j; mcDebug_assert (decl_isSetValue (n)); s = walkDependants (l, n->setvalueF.type); if (s != decl_completed) { return s; } i = Indexing_LowIndice (n->setvalueF.values); j = Indexing_HighIndice (n->setvalueF.values); while (i <= j) { s = walkDependants (l, reinterpret_cast (Indexing_GetIndice (n->setvalueF.values, i))); if (s != decl_completed) { return s; } i += 1; } return decl_completed; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doDependants - return the dependentState depending upon whether all dependants have been declared. */ static decl_dependentState doDependants (alists_alist l, decl_node n) { switch (n->kind) { case decl_throw: case decl_varargs: case decl_address: case decl_loc: case decl_byte: case decl_word: case decl_csizet: case decl_cssizet: case decl_boolean: case decl_char: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_real: case decl_longreal: case decl_shortreal: case decl_bitset: case decl_ztype: case decl_rtype: case decl_complex: case decl_longcomplex: case decl_shortcomplex: case decl_proc: /* base types. */ return decl_completed; break; case decl_type: /* language features and compound type attributes. */ return walkType (l, n); break; case decl_record: return walkRecord (l, n); break; case decl_varient: return walkVarient (l, n); break; case decl_var: return walkVar (l, n); break; case decl_enumeration: return walkEnumeration (l, n); break; case decl_subrange: return walkSubrange (l, n); break; case decl_pointer: return walkPointer (l, n); break; case decl_array: return walkArray (l, n); break; case decl_string: return decl_completed; break; case decl_const: return walkConst (l, n); break; case decl_literal: return decl_completed; break; case decl_varparam: return walkVarParam (l, n); break; case decl_param: return walkParam (l, n); break; case decl_optarg: return walkOptarg (l, n); break; case decl_recordfield: return walkRecordField (l, n); break; case decl_varientfield: return walkVarientField (l, n); break; case decl_enumerationfield: return walkEnumerationField (l, n); break; case decl_set: return walkSet (l, n); break; case decl_proctype: return walkProcType (l, n); break; case decl_subscript: return walkSubscript (l, n); break; case decl_procedure: /* blocks. */ return walkProcedure (l, n); break; case decl_def: case decl_imp: case decl_module: case decl_loop: case decl_while: case decl_for: case decl_repeat: case decl_if: case decl_elsif: case decl_assignment: /* statements. */ M2RTS_HALT (-1); __builtin_unreachable (); break; case decl_componentref: /* expressions. */ return walkComponentRef (l, n); break; case decl_pointerref: return walkPointerRef (l, n); break; case decl_not: case decl_abs: case decl_min: case decl_max: case decl_chr: case decl_cap: case decl_ord: case decl_float: case decl_trunc: case decl_high: return walkUnary (l, n); break; case decl_cast: case decl_val: case decl_plus: case decl_sub: case decl_div: case decl_mod: case decl_mult: case decl_divide: return walkBinary (l, n); break; case decl_constexp: case decl_neg: case decl_adr: case decl_size: case decl_tsize: case decl_deref: return walkUnary (l, n); break; case decl_equal: case decl_notequal: case decl_less: case decl_greater: case decl_greequal: case decl_lessequal: return walkBinary (l, n); break; case decl_funccall: return walkFuncCall (l, n); break; case decl_setvalue: return walkSetValue (l, n); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* tryComplete - returns TRUE if node, n, can be and was completed. */ static unsigned int tryComplete (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v) { if (decl_isEnumeration (n)) { /* can always emit enumerated types. */ output (n, c, t, v); return TRUE; } else if (((decl_isType (n)) && (decl_isTypeHidden (n))) && ((decl_getType (n)) == NULL)) { /* avoid dangling else. */ /* can always emit hidden types. */ outputHidden (n); return TRUE; } else if ((allDependants (n)) == decl_completed) { /* avoid dangling else. */ output (n, c, t, v); return TRUE; } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* tryCompleteFromPartial - */ static unsigned int tryCompleteFromPartial (decl_node n, decl_nodeProcedure t) { if ((((decl_isType (n)) && ((decl_getType (n)) != NULL)) && (decl_isPointer (decl_getType (n)))) && ((allDependants (decl_getType (n))) == decl_completed)) { /* alists.includeItemIntoList (partialQ, getType (n)) ; */ outputHiddenComplete (n); return TRUE; } else if ((allDependants (n)) == decl_completed) { /* avoid dangling else. */ (*t.proc) (n); return TRUE; } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* visitIntrinsicFunction - */ static void visitIntrinsicFunction (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (isIntrinsicFunction (n)); switch (n->kind) { case decl_val: case decl_cmplx: visitNode (v, n->binaryF.left, p); visitNode (v, n->binaryF.right, p); visitNode (v, n->binaryF.resultType, p); break; case decl_length: case decl_adr: case decl_size: case decl_tsize: case decl_float: case decl_trunc: case decl_ord: case decl_chr: case decl_cap: case decl_abs: case decl_high: case decl_min: case decl_max: case decl_re: case decl_im: visitNode (v, n->unaryF.arg, p); visitNode (v, n->unaryF.resultType, p); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* visitUnary - */ static void visitUnary (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (isUnary (n)); visitNode (v, n->unaryF.arg, p); visitNode (v, n->unaryF.resultType, p); } /* visitBinary - */ static void visitBinary (alists_alist v, decl_node n, decl_nodeProcedure p) { visitNode (v, n->binaryF.left, p); visitNode (v, n->binaryF.right, p); visitNode (v, n->binaryF.resultType, p); } /* visitBoolean - */ static void visitBoolean (alists_alist v, decl_node n, decl_nodeProcedure p) { visitNode (v, falseN, p); visitNode (v, trueN, p); } /* visitScope - */ static void visitScope (alists_alist v, decl_node n, decl_nodeProcedure p) { if (mustVisitScope) { visitNode (v, n, p); } } /* visitType - */ static void visitType (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isType (n)); visitNode (v, n->typeF.type, p); visitScope (v, n->typeF.scope, p); } /* visitIndex - */ static void visitIndex (alists_alist v, Indexing_Index i, decl_nodeProcedure p) { unsigned int j; unsigned int h; j = 1; h = Indexing_HighIndice (i); while (j <= h) { visitNode (v, reinterpret_cast (Indexing_GetIndice (i, j)), p); j += 1; } } /* visitRecord - */ static void visitRecord (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isRecord (n)); visitScope (v, n->recordF.scope, p); visitIndex (v, n->recordF.listOfSons, p); } /* visitVarient - */ static void visitVarient (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isVarient (n)); visitIndex (v, n->varientF.listOfSons, p); visitNode (v, n->varientF.varient, p); visitNode (v, n->varientF.tag, p); visitScope (v, n->varientF.scope, p); } /* visitVar - */ static void visitVar (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isVar (n)); visitNode (v, n->varF.type, p); visitNode (v, n->varF.decl, p); visitScope (v, n->varF.scope, p); } /* visitEnumeration - */ static void visitEnumeration (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isEnumeration (n)); visitIndex (v, n->enumerationF.listOfSons, p); visitScope (v, n->enumerationF.scope, p); } /* visitSubrange - */ static void visitSubrange (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isSubrange (n)); visitNode (v, n->subrangeF.low, p); visitNode (v, n->subrangeF.high, p); visitNode (v, n->subrangeF.type, p); visitScope (v, n->subrangeF.scope, p); } /* visitPointer - */ static void visitPointer (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isPointer (n)); visitNode (v, n->pointerF.type, p); visitScope (v, n->pointerF.scope, p); } /* visitArray - */ static void visitArray (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isArray (n)); visitNode (v, n->arrayF.subr, p); visitNode (v, n->arrayF.type, p); visitScope (v, n->arrayF.scope, p); } /* visitConst - */ static void visitConst (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isConst (n)); visitNode (v, n->constF.type, p); visitNode (v, n->constF.value, p); visitScope (v, n->constF.scope, p); } /* visitVarParam - */ static void visitVarParam (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isVarParam (n)); visitNode (v, n->varparamF.namelist, p); visitNode (v, n->varparamF.type, p); visitScope (v, n->varparamF.scope, p); } /* visitParam - */ static void visitParam (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isParam (n)); visitNode (v, n->paramF.namelist, p); visitNode (v, n->paramF.type, p); visitScope (v, n->paramF.scope, p); } /* visitOptarg - */ static void visitOptarg (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isOptarg (n)); visitNode (v, n->optargF.namelist, p); visitNode (v, n->optargF.type, p); visitNode (v, n->optargF.init, p); visitScope (v, n->optargF.scope, p); } /* visitRecordField - */ static void visitRecordField (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isRecordField (n)); visitNode (v, n->recordfieldF.type, p); visitNode (v, n->recordfieldF.parent, p); visitNode (v, n->recordfieldF.varient, p); visitScope (v, n->recordfieldF.scope, p); } /* visitVarientField - */ static void visitVarientField (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isVarientField (n)); visitNode (v, n->varientfieldF.parent, p); visitNode (v, n->varientfieldF.varient, p); visitIndex (v, n->varientfieldF.listOfSons, p); visitScope (v, n->varientfieldF.scope, p); } /* visitEnumerationField - */ static void visitEnumerationField (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isEnumerationField (n)); visitNode (v, n->enumerationfieldF.type, p); visitScope (v, n->enumerationfieldF.scope, p); } /* visitSet - */ static void visitSet (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isSet (n)); visitNode (v, n->setF.type, p); visitScope (v, n->setF.scope, p); } /* visitProcType - */ static void visitProcType (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isProcType (n)); visitIndex (v, n->proctypeF.parameters, p); visitNode (v, n->proctypeF.optarg_, p); visitNode (v, n->proctypeF.returnType, p); visitScope (v, n->proctypeF.scope, p); } /* visitSubscript - */ static void visitSubscript (alists_alist v, decl_node n, decl_nodeProcedure p) { } /* visitDecls - */ static void visitDecls (alists_alist v, decl_scopeT s, decl_nodeProcedure p) { visitIndex (v, s.constants, p); visitIndex (v, s.types, p); visitIndex (v, s.procedures, p); visitIndex (v, s.variables, p); } /* visitProcedure - */ static void visitProcedure (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isProcedure (n)); visitDecls (v, n->procedureF.decls, p); visitScope (v, n->procedureF.scope, p); visitIndex (v, n->procedureF.parameters, p); visitNode (v, n->procedureF.optarg_, p); visitNode (v, n->procedureF.returnType, p); visitNode (v, n->procedureF.beginStatements, p); } /* visitDef - */ static void visitDef (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isDef (n)); visitDecls (v, n->defF.decls, p); } /* visitImp - */ static void visitImp (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isImp (n)); visitDecls (v, n->impF.decls, p); visitNode (v, n->impF.beginStatements, p); /* --fixme-- do we need to visit definitionModule? */ visitNode (v, n->impF.finallyStatements, p); } /* visitModule - */ static void visitModule (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isModule (n)); visitDecls (v, n->moduleF.decls, p); visitNode (v, n->moduleF.beginStatements, p); visitNode (v, n->moduleF.finallyStatements, p); } /* visitLoop - */ static void visitLoop (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isLoop (n)); visitNode (v, n->loopF.statements, p); } /* visitWhile - */ static void visitWhile (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isWhile (n)); visitNode (v, n->whileF.expr, p); visitNode (v, n->whileF.statements, p); } /* visitRepeat - */ static void visitRepeat (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isRepeat (n)); visitNode (v, n->repeatF.expr, p); visitNode (v, n->repeatF.statements, p); } /* visitCase - */ static void visitCase (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isCase (n)); visitNode (v, n->caseF.expression, p); visitIndex (v, n->caseF.caseLabelList, p); visitNode (v, n->caseF.else_, p); } /* visitCaseLabelList - */ static void visitCaseLabelList (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isCaseLabelList (n)); visitNode (v, n->caselabellistF.caseList, p); visitNode (v, n->caselabellistF.statements, p); } /* visitCaseList - */ static void visitCaseList (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isCaseList (n)); visitIndex (v, n->caselistF.rangePairs, p); } /* visitRange - */ static void visitRange (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isRange (n)); visitNode (v, n->rangeF.lo, p); visitNode (v, n->rangeF.hi, p); } /* visitIf - */ static void visitIf (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isIf (n)); visitNode (v, n->ifF.expr, p); visitNode (v, n->ifF.elsif, p); visitNode (v, n->ifF.then, p); visitNode (v, n->ifF.else_, p); } /* visitElsif - */ static void visitElsif (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isElsif (n)); visitNode (v, n->elsifF.expr, p); visitNode (v, n->elsifF.elsif, p); visitNode (v, n->elsifF.then, p); visitNode (v, n->elsifF.else_, p); } /* visitFor - */ static void visitFor (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isFor (n)); visitNode (v, n->forF.des, p); visitNode (v, n->forF.start, p); visitNode (v, n->forF.end, p); visitNode (v, n->forF.increment, p); visitNode (v, n->forF.statements, p); } /* visitAssignment - */ static void visitAssignment (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (isAssignment (n)); visitNode (v, n->assignmentF.des, p); visitNode (v, n->assignmentF.expr, p); } /* visitComponentRef - */ static void visitComponentRef (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (isComponentRef (n)); visitNode (v, n->componentrefF.rec, p); visitNode (v, n->componentrefF.field, p); visitNode (v, n->componentrefF.resultType, p); } /* visitPointerRef - */ static void visitPointerRef (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isPointerRef (n)); visitNode (v, n->pointerrefF.ptr, p); visitNode (v, n->pointerrefF.field, p); visitNode (v, n->pointerrefF.resultType, p); } /* visitArrayRef - */ static void visitArrayRef (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (isArrayRef (n)); visitNode (v, n->arrayrefF.array, p); visitNode (v, n->arrayrefF.index, p); visitNode (v, n->arrayrefF.resultType, p); } /* visitFunccall - */ static void visitFunccall (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (isFuncCall (n)); visitNode (v, n->funccallF.function, p); visitNode (v, n->funccallF.args, p); visitNode (v, n->funccallF.type, p); } /* visitVarDecl - */ static void visitVarDecl (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (isVarDecl (n)); visitNode (v, n->vardeclF.type, p); visitScope (v, n->vardeclF.scope, p); } /* visitExplist - */ static void visitExplist (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isExpList (n)); visitIndex (v, n->explistF.exp, p); } /* visitExit - */ static void visitExit (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isExit (n)); visitNode (v, n->exitF.loop, p); } /* visitReturn - */ static void visitReturn (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isReturn (n)); visitNode (v, n->returnF.exp, p); } /* visitStmtSeq - */ static void visitStmtSeq (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isStatementSequence (n)); visitIndex (v, n->stmtF.statements, p); } /* visitVarargs - */ static void visitVarargs (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isVarargs (n)); visitScope (v, n->varargsF.scope, p); } /* visitSetValue - */ static void visitSetValue (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (decl_isSetValue (n)); visitNode (v, n->setvalueF.type, p); visitIndex (v, n->setvalueF.values, p); } /* visitIntrinsic - */ static void visitIntrinsic (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (isIntrinsic (n)); visitNode (v, n->intrinsicF.args, p); } /* visitDependants - helper procedure function called from visitNode. node n has just been visited, this procedure will visit node, n, dependants. */ static void visitDependants (alists_alist v, decl_node n, decl_nodeProcedure p) { mcDebug_assert (n != NULL); mcDebug_assert (alists_isItemInList (v, reinterpret_cast (n))); switch (n->kind) { case decl_explist: visitExplist (v, n, p); break; case decl_funccall: visitFunccall (v, n, p); break; case decl_exit: visitExit (v, n, p); break; case decl_return: visitReturn (v, n, p); break; case decl_stmtseq: visitStmtSeq (v, n, p); break; case decl_comment: break; case decl_length: visitIntrinsicFunction (v, n, p); break; case decl_unreachable: case decl_throw: case decl_halt: case decl_new: case decl_dispose: case decl_inc: case decl_dec: case decl_incl: case decl_excl: visitIntrinsic (v, n, p); break; case decl_boolean: visitBoolean (v, n, p); break; case decl_nil: case decl_false: case decl_true: break; case decl_varargs: visitVarargs (v, n, p); break; case decl_address: case decl_loc: case decl_byte: case decl_word: case decl_csizet: case decl_cssizet: case decl_char: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_real: case decl_longreal: case decl_shortreal: case decl_bitset: case decl_ztype: case decl_rtype: case decl_complex: case decl_longcomplex: case decl_shortcomplex: case decl_proc: break; case decl_type: /* language features and compound type attributes. */ visitType (v, n, p); break; case decl_record: visitRecord (v, n, p); break; case decl_varient: visitVarient (v, n, p); break; case decl_var: visitVar (v, n, p); break; case decl_enumeration: visitEnumeration (v, n, p); break; case decl_subrange: visitSubrange (v, n, p); break; case decl_pointer: visitPointer (v, n, p); break; case decl_array: visitArray (v, n, p); break; case decl_string: break; case decl_const: visitConst (v, n, p); break; case decl_literal: break; case decl_varparam: visitVarParam (v, n, p); break; case decl_param: visitParam (v, n, p); break; case decl_optarg: visitOptarg (v, n, p); break; case decl_recordfield: visitRecordField (v, n, p); break; case decl_varientfield: visitVarientField (v, n, p); break; case decl_enumerationfield: visitEnumerationField (v, n, p); break; case decl_set: visitSet (v, n, p); break; case decl_proctype: visitProcType (v, n, p); break; case decl_subscript: visitSubscript (v, n, p); break; case decl_procedure: /* blocks. */ visitProcedure (v, n, p); break; case decl_def: visitDef (v, n, p); break; case decl_imp: visitImp (v, n, p); break; case decl_module: visitModule (v, n, p); break; case decl_loop: /* statements. */ visitLoop (v, n, p); break; case decl_while: visitWhile (v, n, p); break; case decl_for: visitFor (v, n, p); break; case decl_repeat: visitRepeat (v, n, p); break; case decl_case: visitCase (v, n, p); break; case decl_caselabellist: visitCaseLabelList (v, n, p); break; case decl_caselist: visitCaseList (v, n, p); break; case decl_range: visitRange (v, n, p); break; case decl_if: visitIf (v, n, p); break; case decl_elsif: visitElsif (v, n, p); break; case decl_assignment: visitAssignment (v, n, p); break; case decl_componentref: /* expressions. */ visitComponentRef (v, n, p); break; case decl_pointerref: visitPointerRef (v, n, p); break; case decl_arrayref: visitArrayRef (v, n, p); break; case decl_cmplx: case decl_equal: case decl_notequal: case decl_less: case decl_greater: case decl_greequal: case decl_lessequal: case decl_and: case decl_or: case decl_in: case decl_cast: case decl_val: case decl_plus: case decl_sub: case decl_div: case decl_mod: case decl_mult: case decl_divide: visitBinary (v, n, p); break; case decl_re: visitUnary (v, n, p); break; case decl_im: visitUnary (v, n, p); break; case decl_abs: visitUnary (v, n, p); break; case decl_chr: visitUnary (v, n, p); break; case decl_cap: visitUnary (v, n, p); break; case decl_high: visitUnary (v, n, p); break; case decl_ord: visitUnary (v, n, p); break; case decl_float: visitUnary (v, n, p); break; case decl_trunc: visitUnary (v, n, p); break; case decl_not: visitUnary (v, n, p); break; case decl_neg: visitUnary (v, n, p); break; case decl_adr: visitUnary (v, n, p); break; case decl_size: visitUnary (v, n, p); break; case decl_tsize: visitUnary (v, n, p); break; case decl_min: visitUnary (v, n, p); break; case decl_max: visitUnary (v, n, p); break; case decl_constexp: visitUnary (v, n, p); break; case decl_deref: visitUnary (v, n, p); break; case decl_identlist: break; case decl_vardecl: visitVarDecl (v, n, p); break; case decl_setvalue: visitSetValue (v, n, p); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* visitNode - visits node, n, if it is not already in the alist, v. It calls p(n) if the node is unvisited. */ static void visitNode (alists_alist v, decl_node n, decl_nodeProcedure p) { if ((n != NULL) && (! (alists_isItemInList (v, reinterpret_cast (n))))) { alists_includeItemIntoList (v, reinterpret_cast (n)); (*p.proc) (n); visitDependants (v, n, p); } } /* genKind - returns a string depending upon the kind of node, n. */ static DynamicStrings_String genKind (decl_node n) { switch (n->kind) { case decl_nil: case decl_true: case decl_false: case decl_address: case decl_loc: case decl_byte: case decl_word: case decl_csizet: case decl_cssizet: case decl_char: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_real: case decl_longreal: case decl_shortreal: case decl_bitset: case decl_boolean: case decl_proc: case decl_ztype: case decl_rtype: case decl_complex: case decl_longcomplex: case decl_shortcomplex: /* types, no need to generate a kind string as it it contained in the name. */ return NULL; break; case decl_type: /* language features and compound type attributes. */ return DynamicStrings_InitString ((const char *) "type", 4); break; case decl_record: return DynamicStrings_InitString ((const char *) "record", 6); break; case decl_varient: return DynamicStrings_InitString ((const char *) "varient", 7); break; case decl_var: return DynamicStrings_InitString ((const char *) "var", 3); break; case decl_enumeration: return DynamicStrings_InitString ((const char *) "enumeration", 11); break; case decl_subrange: return DynamicStrings_InitString ((const char *) "subrange", 8); break; case decl_array: return DynamicStrings_InitString ((const char *) "array", 5); break; case decl_subscript: return DynamicStrings_InitString ((const char *) "subscript", 9); break; case decl_string: return DynamicStrings_InitString ((const char *) "string", 6); break; case decl_const: return DynamicStrings_InitString ((const char *) "const", 5); break; case decl_literal: return DynamicStrings_InitString ((const char *) "literal", 7); break; case decl_varparam: return DynamicStrings_InitString ((const char *) "varparam", 8); break; case decl_param: return DynamicStrings_InitString ((const char *) "param", 5); break; case decl_varargs: return DynamicStrings_InitString ((const char *) "varargs", 7); break; case decl_pointer: return DynamicStrings_InitString ((const char *) "pointer", 7); break; case decl_recordfield: return DynamicStrings_InitString ((const char *) "recordfield", 11); break; case decl_varientfield: return DynamicStrings_InitString ((const char *) "varientfield", 12); break; case decl_enumerationfield: return DynamicStrings_InitString ((const char *) "enumerationfield", 16); break; case decl_set: return DynamicStrings_InitString ((const char *) "set", 3); break; case decl_proctype: return DynamicStrings_InitString ((const char *) "proctype", 8); break; case decl_procedure: /* blocks. */ return DynamicStrings_InitString ((const char *) "procedure", 9); break; case decl_def: return DynamicStrings_InitString ((const char *) "def", 3); break; case decl_imp: return DynamicStrings_InitString ((const char *) "imp", 3); break; case decl_module: return DynamicStrings_InitString ((const char *) "module", 6); break; case decl_loop: /* statements. */ return DynamicStrings_InitString ((const char *) "loop", 4); break; case decl_while: return DynamicStrings_InitString ((const char *) "while", 5); break; case decl_for: return DynamicStrings_InitString ((const char *) "for", 3); break; case decl_repeat: return DynamicStrings_InitString ((const char *) "repeat", 6); break; case decl_assignment: return DynamicStrings_InitString ((const char *) "assignment", 10); break; case decl_if: return DynamicStrings_InitString ((const char *) "if", 2); break; case decl_elsif: return DynamicStrings_InitString ((const char *) "elsif", 5); break; case decl_constexp: /* expressions. */ return DynamicStrings_InitString ((const char *) "constexp", 8); break; case decl_neg: return DynamicStrings_InitString ((const char *) "neg", 3); break; case decl_cast: return DynamicStrings_InitString ((const char *) "cast", 4); break; case decl_val: return DynamicStrings_InitString ((const char *) "val", 3); break; case decl_plus: return DynamicStrings_InitString ((const char *) "plus", 4); break; case decl_sub: return DynamicStrings_InitString ((const char *) "sub", 3); break; case decl_div: return DynamicStrings_InitString ((const char *) "div", 3); break; case decl_mod: return DynamicStrings_InitString ((const char *) "mod", 3); break; case decl_mult: return DynamicStrings_InitString ((const char *) "mult", 4); break; case decl_divide: return DynamicStrings_InitString ((const char *) "divide", 6); break; case decl_adr: return DynamicStrings_InitString ((const char *) "adr", 3); break; case decl_size: return DynamicStrings_InitString ((const char *) "size", 4); break; case decl_tsize: return DynamicStrings_InitString ((const char *) "tsize", 5); break; case decl_chr: return DynamicStrings_InitString ((const char *) "chr", 3); break; case decl_ord: return DynamicStrings_InitString ((const char *) "ord", 3); break; case decl_float: return DynamicStrings_InitString ((const char *) "float", 5); break; case decl_trunc: return DynamicStrings_InitString ((const char *) "trunc", 5); break; case decl_high: return DynamicStrings_InitString ((const char *) "high", 4); break; case decl_componentref: return DynamicStrings_InitString ((const char *) "componentref", 12); break; case decl_pointerref: return DynamicStrings_InitString ((const char *) "pointerref", 10); break; case decl_arrayref: return DynamicStrings_InitString ((const char *) "arrayref", 8); break; case decl_deref: return DynamicStrings_InitString ((const char *) "deref", 5); break; case decl_equal: return DynamicStrings_InitString ((const char *) "equal", 5); break; case decl_notequal: return DynamicStrings_InitString ((const char *) "notequal", 8); break; case decl_less: return DynamicStrings_InitString ((const char *) "less", 4); break; case decl_greater: return DynamicStrings_InitString ((const char *) "greater", 7); break; case decl_greequal: return DynamicStrings_InitString ((const char *) "greequal", 8); break; case decl_lessequal: return DynamicStrings_InitString ((const char *) "lessequal", 9); break; case decl_lsl: return DynamicStrings_InitString ((const char *) "lsl", 3); break; case decl_lsr: return DynamicStrings_InitString ((const char *) "lsr", 3); break; case decl_lor: return DynamicStrings_InitString ((const char *) "lor", 3); break; case decl_land: return DynamicStrings_InitString ((const char *) "land", 4); break; case decl_lnot: return DynamicStrings_InitString ((const char *) "lnot", 4); break; case decl_lxor: return DynamicStrings_InitString ((const char *) "lxor", 4); break; case decl_and: return DynamicStrings_InitString ((const char *) "and", 3); break; case decl_or: return DynamicStrings_InitString ((const char *) "or", 2); break; case decl_not: return DynamicStrings_InitString ((const char *) "not", 3); break; case decl_identlist: return DynamicStrings_InitString ((const char *) "identlist", 9); break; case decl_vardecl: return DynamicStrings_InitString ((const char *) "vardecl", 7); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } M2RTS_HALT (-1); __builtin_unreachable (); ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* gen - generate a small string describing node, n. */ static DynamicStrings_String gen (decl_node n) { DynamicStrings_String s; unsigned int d; d = (unsigned int ) ((long unsigned int ) (n)); s = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "< %d ", 5), (const unsigned char *) &d, (sizeof (d)-1)); /* use 0x%x once FormatStrings has been released. */ s = DynamicStrings_ConCat (s, genKind (n)); /* use 0x%x once FormatStrings has been released. */ s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) " ", 1)); s = DynamicStrings_ConCat (s, getFQstring (n)); s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) " >", 2)); return s; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* dumpQ - */ static void dumpQ (const char *q_, unsigned int _q_high, alists_alist l) { DynamicStrings_String m; decl_node n; unsigned int d; unsigned int h; unsigned int i; char q[_q_high+1]; /* make a local copy of each unbounded array. */ memcpy (q, q_, _q_high+1); m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "Queue ", 6)); m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) q, _q_high)); m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2)); m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); i = 1; h = alists_noOfItemsInList (l); while (i <= h) { n = static_cast (alists_getItemFromList (l, i)); m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, gen (n))); i += 1; } m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2)); m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); } /* dumpLists - */ static void dumpLists (void) { DynamicStrings_String m; if (mcOptions_getDebugTopological ()) { m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2)); m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); dumpQ ((const char *) "todo", 4, todoQ); dumpQ ((const char *) "partial", 7, partialQ); dumpQ ((const char *) "done", 4, doneQ); } } /* outputHidden - */ static void outputHidden (decl_node n) { outText (doP, (const char *) "#if !defined (", 14); doFQNameC (doP, n); outText (doP, (const char *) "_D)\\n", 5); outText (doP, (const char *) "# define ", 10); doFQNameC (doP, n); outText (doP, (const char *) "_D\\n", 4); outText (doP, (const char *) " typedef void *", 17); doFQNameC (doP, n); outText (doP, (const char *) ";\\n", 3); outText (doP, (const char *) "#endif\\n\\n", 10); } /* outputHiddenComplete - */ static void outputHiddenComplete (decl_node n) { decl_node t; mcDebug_assert (decl_isType (n)); t = decl_getType (n); mcDebug_assert (decl_isPointer (t)); outText (doP, (const char *) "#define ", 8); doFQNameC (doP, n); outText (doP, (const char *) "_D\\n", 4); outText (doP, (const char *) "typedef ", 8); doTypeNameC (doP, decl_getType (t)); mcPretty_setNeedSpace (doP); outText (doP, (const char *) "*", 1); doFQNameC (doP, n); outText (doP, (const char *) ";\\n", 3); } /* tryPartial - */ static unsigned int tryPartial (decl_node n, decl_nodeProcedure pt) { decl_node q; if ((n != NULL) && (decl_isType (n))) { q = decl_getType (n); while (decl_isPointer (q)) { q = decl_getType (q); } if (q != NULL) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if ((decl_isRecord (q)) || (decl_isProcType (q))) { (*pt.proc) (n); addTodo (q); return TRUE; } else if (decl_isArray (q)) { /* avoid dangling else. */ (*pt.proc) (n); addTodo (q); return TRUE; } } } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* outputPartialRecordArrayProcType - */ static void outputPartialRecordArrayProcType (decl_node n, decl_node q, unsigned int indirection) { DynamicStrings_String s; outText (doP, (const char *) "typedef struct", 14); mcPretty_setNeedSpace (doP); s = getFQstring (n); if (decl_isRecord (q)) { s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_r", 2))); } else if (decl_isArray (q)) { /* avoid dangling else. */ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_a", 2))); } else if (decl_isProcType (q)) { /* avoid dangling else. */ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_p", 2))); } outTextS (doP, s); mcPretty_setNeedSpace (doP); s = DynamicStrings_KillString (s); while (indirection > 0) { outText (doP, (const char *) "*", 1); indirection -= 1; } doFQNameC (doP, n); outText (doP, (const char *) ";\\n\\n", 5); } /* outputPartial - */ static void outputPartial (decl_node n) { decl_node q; unsigned int indirection; q = decl_getType (n); indirection = 0; while (decl_isPointer (q)) { q = decl_getType (q); indirection += 1; } outputPartialRecordArrayProcType (n, q, indirection); } /* tryOutputTodo - */ static void tryOutputTodo (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure pt) { unsigned int i; unsigned int n; decl_node d; i = 1; n = alists_noOfItemsInList (todoQ); while (i <= n) { d = static_cast (alists_getItemFromList (todoQ, i)); if (tryComplete (d, c, t, v)) { alists_removeItemFromList (todoQ, reinterpret_cast (d)); alists_includeItemIntoList (doneQ, reinterpret_cast (d)); i = 1; } else if (tryPartial (d, pt)) { /* avoid dangling else. */ alists_removeItemFromList (todoQ, reinterpret_cast (d)); alists_includeItemIntoList (partialQ, reinterpret_cast (d)); i = 1; } else { /* avoid dangling else. */ i += 1; } n = alists_noOfItemsInList (todoQ); } } /* tryOutputPartial - */ static void tryOutputPartial (decl_nodeProcedure t) { unsigned int i; unsigned int n; decl_node d; i = 1; n = alists_noOfItemsInList (partialQ); while (i <= n) { d = static_cast (alists_getItemFromList (partialQ, i)); if (tryCompleteFromPartial (d, t)) { alists_removeItemFromList (partialQ, reinterpret_cast (d)); alists_includeItemIntoList (doneQ, reinterpret_cast (d)); i = 1; n -= 1; } else { i += 1; } } } /* debugList - */ static void debugList (const char *a_, unsigned int _a_high, alists_alist l) { unsigned int i; unsigned int h; decl_node n; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); h = alists_noOfItemsInList (l); if (h > 0) { outText (doP, (const char *) a, _a_high); outText (doP, (const char *) " still contains node(s)\\n", 25); i = 1; do { n = static_cast (alists_getItemFromList (l, i)); dbg (n); i += 1; } while (! (i > h)); } } /* debugLists - */ static void debugLists (void) { if (mcOptions_getDebugTopological ()) { debugList ((const char *) "todo", 4, todoQ); debugList ((const char *) "partial", 7, partialQ); } } /* addEnumConst - */ static void addEnumConst (decl_node n) { DynamicStrings_String s; if ((decl_isConst (n)) || (decl_isEnumeration (n))) { addTodo (n); } } /* populateTodo - */ static void populateTodo (decl_nodeProcedure p) { decl_node n; unsigned int i; unsigned int h; alists_alist l; h = alists_noOfItemsInList (todoQ); i = 1; while (i <= h) { n = static_cast (alists_getItemFromList (todoQ, i)); l = alists_initList (); visitNode (l, n, p); alists_killList (&l); h = alists_noOfItemsInList (todoQ); i += 1; } } /* topologicallyOut - */ static void topologicallyOut (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure tp, decl_nodeProcedure pc, decl_nodeProcedure pt, decl_nodeProcedure pv) { unsigned int tol; unsigned int pal; unsigned int to; unsigned int pa; populateTodo ((decl_nodeProcedure) {(decl_nodeProcedure_t) addEnumConst}); tol = 0; pal = 0; to = alists_noOfItemsInList (todoQ); pa = alists_noOfItemsInList (partialQ); while ((tol != to) || (pal != pa)) { dumpLists (); tryOutputTodo (c, t, v, tp); dumpLists (); tryOutputPartial (pt); tol = to; pal = pa; to = alists_noOfItemsInList (todoQ); pa = alists_noOfItemsInList (partialQ); } dumpLists (); debugLists (); } /* scaffoldStatic - */ static void scaffoldStatic (mcPretty_pretty p, decl_node n) { outText (p, (const char *) "\\n", 2); doExternCP (p); outText (p, (const char *) "void", 4); mcPretty_setNeedSpace (p); outText (p, (const char *) "_M2_", 4); doFQNameC (p, n); outText (p, (const char *) "_init", 5); mcPretty_setNeedSpace (p); outText (p, (const char *) "(__attribute__((unused)) int argc", 33); outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37); outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40); p = outKc (p, (const char *) "{\\n", 3); doStatementsC (p, n->impF.beginStatements); p = outKc (p, (const char *) "}\\n", 3); outText (p, (const char *) "\\n", 2); doExternCP (p); outText (p, (const char *) "void", 4); mcPretty_setNeedSpace (p); outText (p, (const char *) "_M2_", 4); doFQNameC (p, n); outText (p, (const char *) "_fini", 5); mcPretty_setNeedSpace (p); outText (p, (const char *) "(__attribute__((unused)) int argc", 33); outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37); outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40); p = outKc (p, (const char *) "{\\n", 3); doStatementsC (p, n->impF.finallyStatements); p = outKc (p, (const char *) "}\\n", 3); } /* emitCtor - */ static void emitCtor (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; outText (p, (const char *) "\\n", 2); outText (p, (const char *) "static void", 11); mcPretty_setNeedSpace (p); outText (p, (const char *) "ctorFunction ()\\n", 17); doFQNameC (p, n); p = outKc (p, (const char *) "{\\n", 3); outText (p, (const char *) "M2RTS_RegisterModule (\"", 23); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); mcPretty_prints (p, s); outText (p, (const char *) "\",\\n", 4); outText (p, (const char *) "init, fini, dependencies);\\n", 28); p = outKc (p, (const char *) "}\\n\\n", 5); p = outKc (p, (const char *) "struct ", 7); mcPretty_prints (p, s); p = outKc (p, (const char *) "_module_m2 { ", 13); mcPretty_prints (p, s); p = outKc (p, (const char *) "_module_m2 (); ~", 16); mcPretty_prints (p, s); p = outKc (p, (const char *) "_module_m2 (); } global_module_", 31); mcPretty_prints (p, s); outText (p, (const char *) ";\\n\\n", 5); mcPretty_prints (p, s); p = outKc (p, (const char *) "_module_m2::", 12); mcPretty_prints (p, s); p = outKc (p, (const char *) "_module_m2 ()\\n", 15); p = outKc (p, (const char *) "{\\n", 3); outText (p, (const char *) "M2RTS_RegisterModule (\"", 23); mcPretty_prints (p, s); outText (p, (const char *) "\", init, fini, dependencies);", 29); p = outKc (p, (const char *) "}\\n", 3); mcPretty_prints (p, s); p = outKc (p, (const char *) "_module_m2::~", 13); mcPretty_prints (p, s); p = outKc (p, (const char *) "_module_m2 ()\\n", 15); p = outKc (p, (const char *) "{\\n", 3); p = outKc (p, (const char *) "}\\n", 3); s = DynamicStrings_KillString (s); } /* scaffoldDynamic - */ static void scaffoldDynamic (mcPretty_pretty p, decl_node n) { outText (p, (const char *) "\\n", 2); doExternCP (p); outText (p, (const char *) "void", 4); mcPretty_setNeedSpace (p); outText (p, (const char *) "_M2_", 4); doFQNameC (p, n); outText (p, (const char *) "_init", 5); mcPretty_setNeedSpace (p); outText (p, (const char *) "(__attribute__((unused)) int argc,", 34); outText (p, (const char *) " __attribute__((unused)) char *argv[]", 37); outText (p, (const char *) " __attribute__((unused)) char *envp[])\\n", 40); p = outKc (p, (const char *) "{\\n", 3); doStatementsC (p, n->impF.beginStatements); p = outKc (p, (const char *) "}\\n", 3); outText (p, (const char *) "\\n", 2); doExternCP (p); outText (p, (const char *) "void", 4); mcPretty_setNeedSpace (p); outText (p, (const char *) "_M2_", 4); doFQNameC (p, n); outText (p, (const char *) "_fini", 5); mcPretty_setNeedSpace (p); outText (p, (const char *) "(__attribute__((unused)) int argc,", 34); outText (p, (const char *) " __attribute__((unused)) char *argv[]", 37); outText (p, (const char *) " __attribute__((unused)) char *envp[])\\n", 40); p = outKc (p, (const char *) "{\\n", 3); doStatementsC (p, n->impF.finallyStatements); p = outKc (p, (const char *) "}\\n", 3); emitCtor (p, n); } /* scaffoldMain - */ static void scaffoldMain (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; outText (p, (const char *) "int\\n", 5); outText (p, (const char *) "main", 4); mcPretty_setNeedSpace (p); outText (p, (const char *) "(int argc, char *argv[], char *envp[])\\n", 40); p = outKc (p, (const char *) "{\\n", 3); outText (p, (const char *) "M2RTS_ConstructModules (", 24); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); mcPretty_prints (p, s); outText (p, (const char *) ", argc, argv, envp);\\n", 22); outText (p, (const char *) "M2RTS_DeconstructModules (", 26); mcPretty_prints (p, s); outText (p, (const char *) ", argc, argv, envp);\\n", 22); outText (p, (const char *) "return 0;", 9); p = outKc (p, (const char *) "}\\n", 3); s = DynamicStrings_KillString (s); } /* outImpInitC - emit the init/fini functions and main function if required. */ static void outImpInitC (mcPretty_pretty p, decl_node n) { if (mcOptions_getScaffoldDynamic ()) { scaffoldDynamic (p, n); } else { scaffoldStatic (p, n); } if (mcOptions_getScaffoldMain ()) { scaffoldMain (p, n); } } /* runSimplifyTypes - */ static void runSimplifyTypes (decl_node n) { if (decl_isImp (n)) { simplifyTypes (n->impF.decls); } else if (decl_isModule (n)) { /* avoid dangling else. */ simplifyTypes (n->moduleF.decls); } else if (decl_isDef (n)) { /* avoid dangling else. */ simplifyTypes (n->defF.decls); } } /* outDefC - */ static void outDefC (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; mcDebug_assert (decl_isDef (n)); outputFile = mcStream_openFrag (1); /* first fragment. */ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */ mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50); mcPretty_prints (p, s); mcPretty_print (p, (const char *) ". */\\n", 7); mcOptions_writeGPLheader (outputFile); doCommentC (p, n->defF.com.body); mcPretty_print (p, (const char *) "\\n\\n#if !defined (_", 19); mcPretty_prints (p, s); mcPretty_print (p, (const char *) "_H)\\n", 5); mcPretty_print (p, (const char *) "# define _", 12); mcPretty_prints (p, s); mcPretty_print (p, (const char *) "_H\\n\\n", 6); keyc_genConfigSystem (p); mcPretty_print (p, (const char *) "# ifdef __cplusplus\\n", 23); mcPretty_print (p, (const char *) "extern \"C\" {\\n", 14); mcPretty_print (p, (const char *) "# endif\\n", 11); outputFile = mcStream_openFrag (3); /* third fragment. */ doP = p; /* third fragment. */ Indexing_ForeachIndiceInIndexDo (n->defF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC}); mcPretty_print (p, (const char *) "\\n", 2); mcPretty_print (p, (const char *) "# if defined (_", 17); mcPretty_prints (p, s); mcPretty_print (p, (const char *) "_C)\\n", 5); mcPretty_print (p, (const char *) "# define EXTERN\\n", 22); mcPretty_print (p, (const char *) "# else\\n", 10); mcPretty_print (p, (const char *) "# define EXTERN extern\\n", 29); mcPretty_print (p, (const char *) "# endif\\n\\n", 13); outDeclsDefC (p, n); runPrototypeDefC (n); mcPretty_print (p, (const char *) "# ifdef __cplusplus\\n", 23); mcPretty_print (p, (const char *) "}\\n", 3); mcPretty_print (p, (const char *) "# endif\\n", 11); mcPretty_print (p, (const char *) "\\n", 2); mcPretty_print (p, (const char *) "# undef EXTERN\\n", 18); mcPretty_print (p, (const char *) "#endif\\n", 8); outputFile = mcStream_openFrag (2); /* second fragment. */ keyc_genDefs (p); /* second fragment. */ s = DynamicStrings_KillString (s); } /* runPrototypeExported - */ static void runPrototypeExported (decl_node n) { if (decl_isExported (n)) { keyc_enterScope (n); doProcedureHeadingC (n, TRUE); mcPretty_print (doP, (const char *) ";\\n", 3); keyc_leaveScope (n); } } /* runPrototypeDefC - */ static void runPrototypeDefC (decl_node n) { if (decl_isDef (n)) { Indexing_ForeachIndiceInIndexDo (n->defF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) runPrototypeExported}); } } /* outImpC - */ static void outImpC (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; decl_node defModule; mcDebug_assert (decl_isImp (n)); outputFile = mcStream_openFrag (1); /* first fragment. */ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */ mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50); mcPretty_prints (p, s); mcPretty_print (p, (const char *) ". */\\n", 7); mcOptions_writeGPLheader (outputFile); doCommentC (p, n->impF.com.body); outText (p, (const char *) "\\n", 2); outputFile = mcStream_openFrag (3); /* third fragment. */ if (mcOptions_getExtendedOpaque ()) /* third fragment. */ { doP = p; /* ForeachIndiceInIndexDo (n^.impF.importedModules, doIncludeC) ; */ includeExternals (n); foreachModuleDo (n, (symbolKey_performOperation) {(symbolKey_performOperation_t) runSimplifyTypes}); libc_printf ((const char *) "/* --extended-opaque seen therefore no #include will be used and everything will be declared in full. */\\n", 108); decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runIncludeDefConstType}); includeDefVarProcedure (n); outDeclsImpC (p, n->impF.decls); decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runPrototypeDefC}); } else { s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* we don't want to include the .h file for this implementation module. */ mcPretty_print (p, (const char *) "#define _", 9); mcPretty_prints (p, s); mcPretty_print (p, (const char *) "_H\\n", 4); mcPretty_print (p, (const char *) "#define _", 9); mcPretty_prints (p, s); mcPretty_print (p, (const char *) "_C\\n\\n", 6); s = DynamicStrings_KillString (s); doP = p; Indexing_ForeachIndiceInIndexDo (n->impF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC}); mcPretty_print (p, (const char *) "\\n", 2); includeDefConstType (n); includeDefVarProcedure (n); outDeclsImpC (p, n->impF.decls); defModule = decl_lookupDef (decl_getSymName (n)); if (defModule != NULL) { runPrototypeDefC (defModule); } } Indexing_ForeachIndiceInIndexDo (n->impF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC}); outProceduresC (p, n->impF.decls); outImpInitC (p, n); outputFile = mcStream_openFrag (2); /* second fragment. */ keyc_genConfigSystem (p); /* second fragment. */ keyc_genDefs (p); } /* outDeclsModuleC - */ static void outDeclsModuleC (mcPretty_pretty p, decl_scopeT s) { simplifyTypes (s); includeConstType (s); doP = p; 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}); /* try and output types, constants before variables and procedures. */ includeVarProcedure (s); 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}); Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC}); } /* outModuleInitC - */ static void outModuleInitC (mcPretty_pretty p, decl_node n) { outText (p, (const char *) "\\n", 2); doExternCP (p); outText (p, (const char *) "void", 4); mcPretty_setNeedSpace (p); outText (p, (const char *) "_M2_", 4); doFQNameC (p, n); outText (p, (const char *) "_init", 5); mcPretty_setNeedSpace (p); outText (p, (const char *) "(__attribute__((unused)) int argc", 33); outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37); outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40); p = outKc (p, (const char *) "{\\n", 3); doStatementsC (p, n->moduleF.beginStatements); p = outKc (p, (const char *) "}\\n", 3); outText (p, (const char *) "\\n", 2); doExternCP (p); outText (p, (const char *) "void", 4); mcPretty_setNeedSpace (p); outText (p, (const char *) "_M2_", 4); doFQNameC (p, n); outText (p, (const char *) "_fini", 5); mcPretty_setNeedSpace (p); outText (p, (const char *) "(__attribute__((unused)) int argc", 33); outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37); outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40); p = outKc (p, (const char *) "{\\n", 3); doStatementsC (p, n->moduleF.finallyStatements); p = outKc (p, (const char *) "}\\n", 3); } /* outModuleC - */ static void outModuleC (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; mcDebug_assert (decl_isModule (n)); outputFile = mcStream_openFrag (1); /* first fragment. */ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */ mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50); mcPretty_prints (p, s); mcPretty_print (p, (const char *) ". */\\n", 7); mcOptions_writeGPLheader (outputFile); doCommentC (p, n->moduleF.com.body); outText (p, (const char *) "\\n", 2); outputFile = mcStream_openFrag (3); /* third fragment. */ if (mcOptions_getExtendedOpaque ()) /* third fragment. */ { doP = p; includeExternals (n); foreachModuleDo (n, (symbolKey_performOperation) {(symbolKey_performOperation_t) runSimplifyTypes}); libc_printf ((const char *) "/* --extended-opaque seen therefore no #include will be used and everything will be declared in full. */\\n", 108); decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runIncludeDefConstType}); outDeclsModuleC (p, n->moduleF.decls); decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runPrototypeDefC}); } else { doP = p; Indexing_ForeachIndiceInIndexDo (n->moduleF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC}); mcPretty_print (p, (const char *) "\\n", 2); outDeclsModuleC (p, n->moduleF.decls); } Indexing_ForeachIndiceInIndexDo (n->moduleF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC}); outProceduresC (p, n->moduleF.decls); outModuleInitC (p, n); outputFile = mcStream_openFrag (2); /* second fragment. */ keyc_genConfigSystem (p); /* second fragment. */ keyc_genDefs (p); } /* outC - */ static void outC (mcPretty_pretty p, decl_node n) { keyc_enterScope (n); if (decl_isDef (n)) { outDefC (p, n); } else if (decl_isImp (n)) { /* avoid dangling else. */ outImpC (p, n); } else if (decl_isModule (n)) { /* avoid dangling else. */ outModuleC (p, n); } else { /* avoid dangling else. */ M2RTS_HALT (-1); __builtin_unreachable (); } keyc_leaveScope (n); } /* doIncludeM2 - include modules in module, n. */ static void doIncludeM2 (decl_node n) { DynamicStrings_String s; s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); mcPretty_print (doP, (const char *) "IMPORT ", 7); mcPretty_prints (doP, s); mcPretty_print (doP, (const char *) " ;\\n", 4); s = DynamicStrings_KillString (s); if (decl_isDef (n)) { symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone}); } else if (decl_isImp (n)) { /* avoid dangling else. */ symbolKey_foreachNodeDo (n->impF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone}); } else if (decl_isModule (n)) { /* avoid dangling else. */ symbolKey_foreachNodeDo (n->moduleF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone}); } } /* doConstM2 - */ static void doConstM2 (decl_node n) { mcPretty_print (doP, (const char *) "CONST\\n", 7); doFQNameC (doP, n); mcPretty_setNeedSpace (doP); doExprC (doP, n->constF.value); mcPretty_print (doP, (const char *) "\\n", 2); } /* doProcTypeM2 - */ static void doProcTypeM2 (mcPretty_pretty p, decl_node n) { outText (p, (const char *) "proc type to do..", 17); } /* doRecordFieldM2 - */ static void doRecordFieldM2 (mcPretty_pretty p, decl_node f) { doNameM2 (p, f); outText (p, (const char *) ":", 1); mcPretty_setNeedSpace (p); doTypeM2 (p, decl_getType (f)); mcPretty_setNeedSpace (p); } /* doVarientFieldM2 - */ static void doVarientFieldM2 (mcPretty_pretty p, decl_node n) { unsigned int i; unsigned int t; decl_node q; mcDebug_assert (decl_isVarientField (n)); doNameM2 (p, n); outText (p, (const char *) ":", 1); mcPretty_setNeedSpace (p); i = Indexing_LowIndice (n->varientfieldF.listOfSons); t = Indexing_HighIndice (n->varientfieldF.listOfSons); while (i <= t) { q = static_cast (Indexing_GetIndice (n->varientfieldF.listOfSons, i)); if (decl_isRecordField (q)) { doRecordFieldM2 (p, q); outText (p, (const char *) ";\\n", 3); } else if (decl_isVarient (q)) { /* avoid dangling else. */ doVarientM2 (p, q); outText (p, (const char *) ";\\n", 3); } else { /* avoid dangling else. */ M2RTS_HALT (-1); __builtin_unreachable (); } i += 1; } } /* doVarientM2 - */ static void doVarientM2 (mcPretty_pretty p, decl_node n) { unsigned int i; unsigned int t; decl_node q; mcDebug_assert (decl_isVarient (n)); outText (p, (const char *) "CASE", 4); mcPretty_setNeedSpace (p); if (n->varientF.tag != NULL) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if (decl_isRecordField (n->varientF.tag)) { doRecordFieldM2 (p, n->varientF.tag); } else if (decl_isVarientField (n->varientF.tag)) { /* avoid dangling else. */ doVarientFieldM2 (p, n->varientF.tag); } else { /* avoid dangling else. */ M2RTS_HALT (-1); __builtin_unreachable (); } } mcPretty_setNeedSpace (p); outText (p, (const char *) "OF\\n", 4); i = Indexing_LowIndice (n->varientF.listOfSons); t = Indexing_HighIndice (n->varientF.listOfSons); while (i <= t) { q = static_cast (Indexing_GetIndice (n->varientF.listOfSons, i)); if (decl_isRecordField (q)) { /* avoid dangling else. */ if (! q->recordfieldF.tag) { doRecordFieldM2 (p, q); outText (p, (const char *) ";\\n", 3); } } else if (decl_isVarientField (q)) { /* avoid dangling else. */ doVarientFieldM2 (p, q); } else { /* avoid dangling else. */ M2RTS_HALT (-1); __builtin_unreachable (); } i += 1; } outText (p, (const char *) "END", 3); mcPretty_setNeedSpace (p); } /* doRecordM2 - */ static void doRecordM2 (mcPretty_pretty p, decl_node n) { unsigned int i; unsigned int h; decl_node f; mcDebug_assert (decl_isRecord (n)); p = outKm2 (p, (const char *) "RECORD", 6); i = Indexing_LowIndice (n->recordF.listOfSons); h = Indexing_HighIndice (n->recordF.listOfSons); outText (p, (const char *) "\\n", 2); while (i <= h) { f = static_cast (Indexing_GetIndice (n->recordF.listOfSons, i)); if (decl_isRecordField (f)) { /* avoid dangling else. */ if (! f->recordfieldF.tag) { doRecordFieldM2 (p, f); outText (p, (const char *) ";\\n", 3); } } else if (decl_isVarient (f)) { /* avoid dangling else. */ doVarientM2 (p, f); outText (p, (const char *) ";\\n", 3); } else if (decl_isVarientField (f)) { /* avoid dangling else. */ doVarientFieldM2 (p, f); } i += 1; } p = outKm2 (p, (const char *) "END", 3); mcPretty_setNeedSpace (p); } /* doPointerM2 - */ static void doPointerM2 (mcPretty_pretty p, decl_node n) { outText (p, (const char *) "POINTER TO", 10); mcPretty_setNeedSpace (doP); doTypeM2 (p, decl_getType (n)); mcPretty_setNeedSpace (p); outText (p, (const char *) ";\\n", 3); } /* doTypeAliasM2 - */ static void doTypeAliasM2 (mcPretty_pretty p, decl_node n) { doTypeNameC (p, n); mcPretty_setNeedSpace (p); outText (doP, (const char *) "=", 1); mcPretty_setNeedSpace (p); doTypeM2 (p, decl_getType (n)); mcPretty_setNeedSpace (p); outText (p, (const char *) "\\n", 2); } /* doEnumerationM2 - */ static void doEnumerationM2 (mcPretty_pretty p, decl_node n) { unsigned int i; unsigned int h; decl_node s; DynamicStrings_String t; outText (p, (const char *) "(", 1); i = Indexing_LowIndice (n->enumerationF.listOfSons); h = Indexing_HighIndice (n->enumerationF.listOfSons); while (i <= h) { s = static_cast (Indexing_GetIndice (n->enumerationF.listOfSons, i)); doFQNameC (p, s); if (i < h) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); } i += 1; } outText (p, (const char *) ")", 1); } /* doBaseM2 - */ static void doBaseM2 (mcPretty_pretty p, decl_node n) { switch (n->kind) { case decl_char: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_complex: case decl_longcomplex: case decl_shortcomplex: case decl_real: case decl_longreal: case decl_shortreal: case decl_bitset: case decl_boolean: case decl_proc: doNameM2 (p, n); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } mcPretty_setNeedSpace (p); } /* doSystemM2 - */ static void doSystemM2 (mcPretty_pretty p, decl_node n) { switch (n->kind) { case decl_address: case decl_loc: case decl_byte: case decl_word: case decl_csizet: case decl_cssizet: doNameM2 (p, n); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* doTypeM2 - */ static void doTypeM2 (mcPretty_pretty p, decl_node n) { if (isBase (n)) { doBaseM2 (p, n); } else if (isSystem (n)) { /* avoid dangling else. */ doSystemM2 (p, n); } else if (decl_isType (n)) { /* avoid dangling else. */ doTypeAliasM2 (p, n); } else if (decl_isProcType (n)) { /* avoid dangling else. */ doProcTypeM2 (p, n); } else if (decl_isPointer (n)) { /* avoid dangling else. */ doPointerM2 (p, n); } else if (decl_isEnumeration (n)) { /* avoid dangling else. */ doEnumerationM2 (p, n); } else if (decl_isRecord (n)) { /* avoid dangling else. */ doRecordM2 (p, n); } } /* doTypesM2 - */ static void doTypesM2 (decl_node n) { decl_node m; outText (doP, (const char *) "TYPE\\n", 6); doTypeM2 (doP, n); } /* doVarM2 - */ static void doVarM2 (decl_node n) { mcDebug_assert (decl_isVar (n)); doNameC (doP, n); outText (doP, (const char *) ":", 1); mcPretty_setNeedSpace (doP); doTypeM2 (doP, decl_getType (n)); mcPretty_setNeedSpace (doP); outText (doP, (const char *) ";\\n", 3); } /* doVarsM2 - */ static void doVarsM2 (decl_node n) { decl_node m; outText (doP, (const char *) "VAR\\n", 5); doVarM2 (n); } /* doTypeNameM2 - */ static void doTypeNameM2 (mcPretty_pretty p, decl_node n) { doNameM2 (p, n); } /* doParamM2 - */ static void doParamM2 (mcPretty_pretty p, decl_node n) { decl_node ptype; nameKey_Name i; unsigned int c; unsigned int t; wlists_wlist l; mcDebug_assert (decl_isParam (n)); ptype = decl_getType (n); if (n->paramF.namelist == NULL) { doTypeNameM2 (p, ptype); } else { mcDebug_assert (isIdentList (n->paramF.namelist)); l = n->paramF.namelist->identlistF.names; if (l == NULL) { doTypeNameM2 (p, ptype); } else { t = wlists_noOfItemsInList (l); c = 1; while (c <= t) { i = static_cast (wlists_getItemFromList (l, c)); mcPretty_setNeedSpace (p); doNamesC (p, i); if (c < t) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); } c += 1; } outText (p, (const char *) ":", 1); mcPretty_setNeedSpace (p); doTypeNameM2 (p, ptype); } } } /* doVarParamM2 - */ static void doVarParamM2 (mcPretty_pretty p, decl_node n) { decl_node ptype; nameKey_Name i; unsigned int c; unsigned int t; wlists_wlist l; mcDebug_assert (decl_isVarParam (n)); outText (p, (const char *) "VAR", 3); mcPretty_setNeedSpace (p); ptype = decl_getType (n); if (n->varparamF.namelist == NULL) { doTypeNameM2 (p, ptype); } else { mcDebug_assert (isIdentList (n->varparamF.namelist)); l = n->varparamF.namelist->identlistF.names; if (l == NULL) { doTypeNameM2 (p, ptype); } else { t = wlists_noOfItemsInList (l); c = 1; while (c <= t) { i = static_cast (wlists_getItemFromList (l, c)); mcPretty_setNeedSpace (p); doNamesC (p, i); if (c < t) { outText (p, (const char *) ",", 1); mcPretty_setNeedSpace (p); } c += 1; } outText (p, (const char *) ":", 1); mcPretty_setNeedSpace (p); doTypeNameM2 (p, ptype); } } } /* doParameterM2 - */ static void doParameterM2 (mcPretty_pretty p, decl_node n) { if (decl_isParam (n)) { doParamM2 (p, n); } else if (decl_isVarParam (n)) { /* avoid dangling else. */ doVarParamM2 (p, n); } else if (decl_isVarargs (n)) { /* avoid dangling else. */ mcPretty_print (p, (const char *) "...", 3); } } /* doPrototypeM2 - */ static void doPrototypeM2 (decl_node n) { unsigned int i; unsigned int h; decl_node p; mcDebug_assert (decl_isProcedure (n)); mcPretty_noSpace (doP); doNameM2 (doP, n); mcPretty_setNeedSpace (doP); outText (doP, (const char *) "(", 1); i = Indexing_LowIndice (n->procedureF.parameters); h = Indexing_HighIndice (n->procedureF.parameters); while (i <= h) { p = static_cast (Indexing_GetIndice (n->procedureF.parameters, i)); doParameterM2 (doP, p); mcPretty_noSpace (doP); if (i < h) { mcPretty_print (doP, (const char *) ";", 1); mcPretty_setNeedSpace (doP); } i += 1; } outText (doP, (const char *) ")", 1); if (n->procedureF.returnType != NULL) { mcPretty_setNeedSpace (doP); outText (doP, (const char *) ":", 1); doTypeM2 (doP, n->procedureF.returnType); mcPretty_setNeedSpace (doP); } outText (doP, (const char *) ";\\n", 3); } /* outputPartialM2 - just writes out record, array, and proctypes. No need for forward declarations in Modula-2 but we need to keep topological sort happy. So when asked to output partial we emit the full type for these types and then do nothing when trying to complete partial to full. */ static void outputPartialM2 (decl_node n) { decl_node q; q = decl_getType (n); if (decl_isRecord (q)) { doTypeM2 (doP, n); } else if (decl_isArray (q)) { /* avoid dangling else. */ doTypeM2 (doP, n); } else if (decl_isProcType (q)) { /* avoid dangling else. */ doTypeM2 (doP, n); } } /* outDeclsDefM2 - */ static void outDeclsDefM2 (mcPretty_pretty p, decl_scopeT s) { simplifyTypes (s); includeConstType (s); doP = p; 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}); includeVarProcedure (s); 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}); Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeM2}); } /* outDefM2 - */ static void outDefM2 (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSource (n))); mcPretty_print (p, (const char *) "(* automatically created by mc from ", 36); mcPretty_prints (p, s); mcPretty_print (p, (const char *) ". *)\\n\\n", 9); s = DynamicStrings_KillString (s); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); mcPretty_print (p, (const char *) "DEFINITION MODULE ", 18); mcPretty_prints (p, s); mcPretty_print (p, (const char *) " ;\\n\\n", 6); doP = p; Indexing_ForeachIndiceInIndexDo (n->defF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeM2}); mcPretty_print (p, (const char *) "\\n", 2); outDeclsDefM2 (p, n->defF.decls); mcPretty_print (p, (const char *) "\\n", 2); mcPretty_print (p, (const char *) "END ", 4); mcPretty_prints (p, s); mcPretty_print (p, (const char *) ".\\n", 3); s = DynamicStrings_KillString (s); } /* outDeclsImpM2 - */ static void outDeclsImpM2 (mcPretty_pretty p, decl_scopeT s) { simplifyTypes (s); includeConstType (s); doP = p; 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}); includeVarProcedure (s); 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}); outText (p, (const char *) "\\n", 2); Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC}); } /* outImpM2 - */ static void outImpM2 (mcPretty_pretty p, decl_node n) { DynamicStrings_String s; s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSource (n))); mcPretty_print (p, (const char *) "(* automatically created by mc from ", 36); mcPretty_prints (p, s); mcPretty_print (p, (const char *) ". *)\\n\\n", 9); mcPretty_print (p, (const char *) "IMPLEMENTATION MODULE ", 22); mcPretty_prints (p, s); mcPretty_print (p, (const char *) " ;\\n\\n", 6); doP = p; Indexing_ForeachIndiceInIndexDo (n->impF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeM2}); mcPretty_print (p, (const char *) "\\n", 2); includeDefConstType (n); outDeclsImpM2 (p, n->impF.decls); mcPretty_print (p, (const char *) "\\n", 2); mcPretty_print (p, (const char *) "END ", 4); mcPretty_prints (p, s); mcPretty_print (p, (const char *) ".\\n", 3); s = DynamicStrings_KillString (s); } /* outModuleM2 - */ static void outModuleM2 (mcPretty_pretty p, decl_node n) { } /* outM2 - */ static void outM2 (mcPretty_pretty p, decl_node n) { if (decl_isDef (n)) { outDefM2 (p, n); } else if (decl_isImp (n)) { /* avoid dangling else. */ outImpM2 (p, n); } else if (decl_isModule (n)) { /* avoid dangling else. */ outModuleM2 (p, n); } else { /* avoid dangling else. */ M2RTS_HALT (-1); __builtin_unreachable (); } } /* addDone - adds node, n, to the doneQ. */ static void addDone (decl_node n) { alists_includeItemIntoList (doneQ, reinterpret_cast (n)); } /* addDoneDef - adds node, n, to the doneQ providing it is not an opaque of the main module we are compiling. */ static void addDoneDef (decl_node n) { if (decl_isDef (n)) { addDone (n); return ; } if ((! (decl_isDef (n))) && ((decl_lookupImp (decl_getSymName (decl_getScope (n)))) == (decl_getMainModule ()))) { 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)); mcError_flushErrors (); mcError_errorAbort0 ((const char *) "terminating compilation", 23); } else { addDone (n); } } /* dbgAdd - */ static decl_node dbgAdd (alists_alist l, decl_node n) { if (n != NULL) { alists_includeItemIntoList (l, reinterpret_cast (n)); } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* dbgType - */ static void dbgType (alists_alist l, decl_node n) { decl_node t; t = dbgAdd (l, decl_getType (n)); out1 ((const char *) "<%s type", 8, n); if (t == NULL) { out0 ((const char *) ", type = NIL\\n", 14); } else { out1 ((const char *) ", type = %s>\\n", 14, t); } } /* dbgPointer - */ static void dbgPointer (alists_alist l, decl_node n) { decl_node t; t = dbgAdd (l, decl_getType (n)); out1 ((const char *) "<%s pointer", 11, n); out1 ((const char *) " to %s>\\n", 9, t); } /* dbgRecord - */ static void dbgRecord (alists_alist l, decl_node n) { unsigned int i; unsigned int t; decl_node q; out1 ((const char *) "<%s record:\\n", 13, n); i = Indexing_LowIndice (n->recordF.listOfSons); t = Indexing_HighIndice (n->recordF.listOfSons); while (i <= t) { q = static_cast (Indexing_GetIndice (n->recordF.listOfSons, i)); if (decl_isRecordField (q)) { out1 ((const char *) " \\n", 7, q); i += 1; } outText (doP, (const char *) ">\\n", 3); } /* dbgVarient - */ static void dbgVarient (alists_alist l, decl_node n) { unsigned int i; unsigned int t; decl_node q; out1 ((const char *) "<%s varient: ", 13, n); out1 ((const char *) "tag %s", 6, n->varientF.tag); q = decl_getType (n->varientF.tag); if (q == NULL) { outText (doP, (const char *) "\\n", 2); } else { out1 ((const char *) ": %s\\n", 6, q); q = dbgAdd (l, q); } i = Indexing_LowIndice (n->varientF.listOfSons); t = Indexing_HighIndice (n->varientF.listOfSons); while (i <= t) { q = static_cast (Indexing_GetIndice (n->varientF.listOfSons, i)); if (decl_isRecordField (q)) { out1 ((const char *) " \\n", 7, q); i += 1; } outText (doP, (const char *) ">\\n", 3); } /* dbgEnumeration - */ static void dbgEnumeration (alists_alist l, decl_node n) { decl_node e; unsigned int i; unsigned int h; outText (doP, (const char *) "< enumeration ", 14); i = Indexing_LowIndice (n->enumerationF.listOfSons); h = Indexing_HighIndice (n->enumerationF.listOfSons); while (i <= h) { e = static_cast (Indexing_GetIndice (n->enumerationF.listOfSons, i)); out1 ((const char *) "%s, ", 4, e); i += 1; } outText (doP, (const char *) ">\\n", 3); } /* dbgVar - */ static void dbgVar (alists_alist l, decl_node n) { decl_node t; t = dbgAdd (l, decl_getType (n)); out1 ((const char *) "<%s var", 7, n); out1 ((const char *) ", type = %s>\\n", 14, t); } /* dbgSubrange - */ static void dbgSubrange (alists_alist l, decl_node n) { if (n->subrangeF.low == NULL) { out1 ((const char *) "%s", 2, n->subrangeF.type); } else { out1 ((const char *) "[%s", 3, n->subrangeF.low); out1 ((const char *) "..%s]", 5, n->subrangeF.high); } } /* dbgArray - */ static void dbgArray (alists_alist l, decl_node n) { decl_node t; t = dbgAdd (l, decl_getType (n)); out1 ((const char *) "<%s array ", 10, n); if (n->arrayF.subr != NULL) { dbgSubrange (l, n->arrayF.subr); } out1 ((const char *) " of %s>\\n", 9, t); } /* doDbg - */ static void doDbg (alists_alist l, decl_node n) { if (n == NULL) {} /* empty. */ else if (decl_isSubrange (n)) { /* avoid dangling else. */ dbgSubrange (l, n); } else if (decl_isType (n)) { /* avoid dangling else. */ dbgType (l, n); } else if (decl_isRecord (n)) { /* avoid dangling else. */ dbgRecord (l, n); } else if (decl_isVarient (n)) { /* avoid dangling else. */ dbgVarient (l, n); } else if (decl_isEnumeration (n)) { /* avoid dangling else. */ dbgEnumeration (l, n); } else if (decl_isPointer (n)) { /* avoid dangling else. */ dbgPointer (l, n); } else if (decl_isArray (n)) { /* avoid dangling else. */ dbgArray (l, n); } else if (decl_isVar (n)) { /* avoid dangling else. */ dbgVar (l, n); } } /* dbg - */ static void dbg (decl_node n) { alists_alist l; mcPretty_pretty o; FIO_File f; DynamicStrings_String s; unsigned int i; o = doP; f = outputFile; outputFile = FIO_StdOut; doP = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln}); l = alists_initList (); alists_includeItemIntoList (l, reinterpret_cast (n)); i = 1; out1 ((const char *) "dbg (%s)\\n", 10, n); do { n = static_cast (alists_getItemFromList (l, i)); doDbg (l, n); i += 1; } while (! (i > (alists_noOfItemsInList (l)))); doP = o; outputFile = f; } /* addGenericBody - adds comment node to funccall, return, assignment nodes. */ static void addGenericBody (decl_node n, decl_node c) { switch (n->kind) { case decl_unreachable: case decl_throw: case decl_halt: case decl_new: case decl_dispose: case decl_inc: case decl_dec: case decl_incl: case decl_excl: n->intrinsicF.intrinsicComment.body = c; break; case decl_funccall: n->funccallF.funccallComment.body = c; break; case decl_return: n->returnF.returnComment.body = c; break; case decl_assignment: n->assignmentF.assignComment.body = c; break; case decl_module: n->moduleF.com.body = c; break; case decl_def: n->defF.com.body = c; break; case decl_imp: n->impF.com.body = c; break; default: break; } } /* addGenericAfter - adds comment node to funccall, return, assignment nodes. */ static void addGenericAfter (decl_node n, decl_node c) { switch (n->kind) { case decl_unreachable: case decl_throw: case decl_halt: case decl_new: case decl_dispose: case decl_inc: case decl_dec: case decl_incl: case decl_excl: n->intrinsicF.intrinsicComment.after = c; break; case decl_funccall: n->funccallF.funccallComment.after = c; break; case decl_return: n->returnF.returnComment.after = c; break; case decl_assignment: n->assignmentF.assignComment.after = c; break; case decl_module: n->moduleF.com.after = c; break; case decl_def: n->defF.com.after = c; break; case decl_imp: n->impF.com.after = c; break; default: break; } } /* isAssignment - */ static unsigned int isAssignment (decl_node n) { return n->kind == decl_assignment; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isComment - returns TRUE if node, n, is a comment. */ static unsigned int isComment (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_comment; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* initPair - initialise the commentPair, c. */ static void initPair (decl_commentPair *c) { (*c).after = NULL; (*c).body = NULL; } /* dupExplist - */ static decl_node dupExplist (decl_node n) { decl_node m; unsigned int i; mcDebug_assert (decl_isExpList (n)); m = decl_makeExpList (); i = Indexing_LowIndice (n->explistF.exp); while (i <= (Indexing_HighIndice (n->explistF.exp))) { decl_putExpList (m, decl_dupExpr (reinterpret_cast (Indexing_GetIndice (n->explistF.exp, i)))); i += 1; } return m; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* dupArrayref - */ static decl_node dupArrayref (decl_node n) { mcDebug_assert (isArrayRef (n)); return decl_makeArrayRef (decl_dupExpr (n->arrayrefF.array), decl_dupExpr (n->arrayrefF.index)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* dupPointerref - */ static decl_node dupPointerref (decl_node n) { mcDebug_assert (decl_isPointerRef (n)); return decl_makePointerRef (decl_dupExpr (n->pointerrefF.ptr), decl_dupExpr (n->pointerrefF.field)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* dupComponentref - */ static decl_node dupComponentref (decl_node n) { mcDebug_assert (isComponentRef (n)); return doMakeComponentRef (decl_dupExpr (n->componentrefF.rec), decl_dupExpr (n->componentrefF.field)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* dupBinary - */ static decl_node dupBinary (decl_node n) { /* assert (isBinary (n)) ; */ return makeBinary (n->kind, decl_dupExpr (n->binaryF.left), decl_dupExpr (n->binaryF.right), n->binaryF.resultType); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* dupUnary - */ static decl_node dupUnary (decl_node n) { /* assert (isUnary (n)) ; */ return makeUnary (n->kind, decl_dupExpr (n->unaryF.arg), n->unaryF.resultType); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* dupFunccall - */ static decl_node dupFunccall (decl_node n) { decl_node m; mcDebug_assert (isFuncCall (n)); m = decl_makeFuncCall (decl_dupExpr (n->funccallF.function), decl_dupExpr (n->funccallF.args)); m->funccallF.type = n->funccallF.type; return m; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* dupSetValue - */ static decl_node dupSetValue (decl_node n) { decl_node m; unsigned int i; m = newNode (decl_setvalue); m->setvalueF.type = n->setvalueF.type; i = Indexing_LowIndice (n->setvalueF.values); while (i <= (Indexing_HighIndice (n->setvalueF.values))) { m = decl_putSetValue (m, decl_dupExpr (reinterpret_cast (Indexing_GetIndice (n->setvalueF.values, i)))); i += 1; } return m; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* doDupExpr - */ static decl_node doDupExpr (decl_node n) { mcDebug_assert (n != NULL); switch (n->kind) { case decl_explist: return dupExplist (n); break; case decl_exit: case decl_return: case decl_stmtseq: case decl_comment: M2RTS_HALT (-1); /* should not be duplicating code. */ __builtin_unreachable (); break; case decl_length: M2RTS_HALT (-1); /* length should have been converted into unary. */ __builtin_unreachable (); break; case decl_nil: case decl_true: case decl_false: case decl_address: case decl_loc: case decl_byte: case decl_word: case decl_csizet: case decl_cssizet: case decl_boolean: case decl_proc: case decl_char: case decl_integer: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_longint: case decl_shortint: case decl_real: case decl_longreal: case decl_shortreal: case decl_bitset: case decl_ztype: case decl_rtype: case decl_complex: case decl_longcomplex: case decl_shortcomplex: /* base types. */ return n; break; case decl_type: case decl_record: case decl_varient: case decl_var: case decl_enumeration: case decl_subrange: case decl_subscript: case decl_array: case decl_string: case decl_const: case decl_literal: case decl_varparam: case decl_param: case decl_varargs: case decl_optarg: case decl_pointer: case decl_recordfield: case decl_varientfield: case decl_enumerationfield: case decl_set: case decl_proctype: /* language features and compound type attributes. */ return n; break; case decl_procedure: case decl_def: case decl_imp: case decl_module: /* blocks. */ return n; break; case decl_loop: case decl_while: case decl_for: case decl_repeat: case decl_case: case decl_caselabellist: case decl_caselist: case decl_range: case decl_if: case decl_elsif: case decl_assignment: /* statements. */ return n; break; case decl_arrayref: /* expressions. */ return dupArrayref (n); break; case decl_pointerref: return dupPointerref (n); break; case decl_componentref: return dupComponentref (n); break; case decl_cmplx: case decl_and: case decl_or: case decl_equal: case decl_notequal: case decl_less: case decl_greater: case decl_greequal: case decl_lessequal: case decl_cast: case decl_val: case decl_plus: case decl_sub: case decl_div: case decl_mod: case decl_mult: case decl_divide: case decl_in: return dupBinary (n); break; case decl_re: case decl_im: case decl_constexp: case decl_deref: case decl_abs: case decl_chr: case decl_cap: case decl_high: case decl_float: case decl_trunc: case decl_ord: case decl_not: case decl_neg: case decl_adr: case decl_size: case decl_tsize: case decl_min: case decl_max: return dupUnary (n); break; case decl_identlist: return n; break; case decl_vardecl: return n; break; case decl_funccall: return dupFunccall (n); break; case decl_setvalue: return dupSetValue (n); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* makeSystem - */ static void makeSystem (void) { systemN = decl_lookupDef (nameKey_makeKey ((const char *) "SYSTEM", 6)); addressN = makeBase (decl_address); locN = makeBase (decl_loc); byteN = makeBase (decl_byte); wordN = makeBase (decl_word); csizetN = makeBase (decl_csizet); cssizetN = makeBase (decl_cssizet); adrN = makeBase (decl_adr); tsizeN = makeBase (decl_tsize); throwN = makeBase (decl_throw); decl_enterScope (systemN); addressN = addToScope (addressN); locN = addToScope (locN); byteN = addToScope (byteN); wordN = addToScope (wordN); csizetN = addToScope (csizetN); cssizetN = addToScope (cssizetN); adrN = addToScope (adrN); tsizeN = addToScope (tsizeN); throwN = addToScope (throwN); mcDebug_assert (sizeN != NULL); /* assumed to be built already. */ sizeN = addToScope (sizeN); /* also export size from system. */ decl_leaveScope (); /* also export size from system. */ addDone (addressN); addDone (locN); addDone (byteN); addDone (wordN); addDone (csizetN); addDone (cssizetN); } /* makeM2rts - */ static void makeM2rts (void) { m2rtsN = decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5)); } /* makeBitnum - */ static decl_node makeBitnum (void) { decl_node b; b = newNode (decl_subrange); b->subrangeF.type = NULL; b->subrangeF.scope = NULL; b->subrangeF.low = lookupConst (b, nameKey_makeKey ((const char *) "0", 1)); b->subrangeF.high = lookupConst (b, nameKey_makeKey ((const char *) "31", 2)); return b; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeBaseSymbols - */ static void makeBaseSymbols (void) { baseSymbols = symbolKey_initTree (); booleanN = makeBase (decl_boolean); charN = makeBase (decl_char); procN = makeBase (decl_proc); cardinalN = makeBase (decl_cardinal); longcardN = makeBase (decl_longcard); shortcardN = makeBase (decl_shortcard); integerN = makeBase (decl_integer); longintN = makeBase (decl_longint); shortintN = makeBase (decl_shortint); bitsetN = makeBase (decl_bitset); bitnumN = makeBitnum (); ztypeN = makeBase (decl_ztype); rtypeN = makeBase (decl_rtype); complexN = makeBase (decl_complex); longcomplexN = makeBase (decl_longcomplex); shortcomplexN = makeBase (decl_shortcomplex); realN = makeBase (decl_real); longrealN = makeBase (decl_longreal); shortrealN = makeBase (decl_shortreal); nilN = makeBase (decl_nil); trueN = makeBase (decl_true); falseN = makeBase (decl_false); sizeN = makeBase (decl_size); minN = makeBase (decl_min); maxN = makeBase (decl_max); floatN = makeBase (decl_float); truncN = makeBase (decl_trunc); ordN = makeBase (decl_ord); valN = makeBase (decl_val); chrN = makeBase (decl_chr); capN = makeBase (decl_cap); absN = makeBase (decl_abs); newN = makeBase (decl_new); disposeN = makeBase (decl_dispose); lengthN = makeBase (decl_length); incN = makeBase (decl_inc); decN = makeBase (decl_dec); inclN = makeBase (decl_incl); exclN = makeBase (decl_excl); highN = makeBase (decl_high); imN = makeBase (decl_im); reN = makeBase (decl_re); cmplxN = makeBase (decl_cmplx); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "BOOLEAN", 7), reinterpret_cast (booleanN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "PROC", 4), reinterpret_cast (procN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CHAR", 4), reinterpret_cast (charN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CARDINAL", 8), reinterpret_cast (cardinalN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTCARD", 9), reinterpret_cast (shortcardN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGCARD", 8), reinterpret_cast (longcardN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INTEGER", 7), reinterpret_cast (integerN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGINT", 7), reinterpret_cast (longintN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTINT", 8), reinterpret_cast (shortintN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "BITSET", 6), reinterpret_cast (bitsetN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "REAL", 4), reinterpret_cast (realN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTREAL", 9), reinterpret_cast (shortrealN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGREAL", 8), reinterpret_cast (longrealN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "COMPLEX", 7), reinterpret_cast (complexN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGCOMPLEX", 11), reinterpret_cast (longcomplexN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTCOMPLEX", 12), reinterpret_cast (shortcomplexN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "NIL", 3), reinterpret_cast (nilN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "TRUE", 4), reinterpret_cast (trueN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "FALSE", 5), reinterpret_cast (falseN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SIZE", 4), reinterpret_cast (sizeN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "MIN", 3), reinterpret_cast (minN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "MAX", 3), reinterpret_cast (maxN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "FLOAT", 5), reinterpret_cast (floatN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "TRUNC", 5), reinterpret_cast (truncN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "ORD", 3), reinterpret_cast (ordN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "VAL", 3), reinterpret_cast (valN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CHR", 3), reinterpret_cast (chrN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CAP", 3), reinterpret_cast (capN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "ABS", 3), reinterpret_cast (absN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "NEW", 3), reinterpret_cast (newN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "DISPOSE", 7), reinterpret_cast (disposeN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LENGTH", 6), reinterpret_cast (lengthN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INC", 3), reinterpret_cast (incN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "DEC", 3), reinterpret_cast (decN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INCL", 4), reinterpret_cast (inclN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "EXCL", 4), reinterpret_cast (exclN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "HIGH", 4), reinterpret_cast (highN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CMPLX", 5), reinterpret_cast (cmplxN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "RE", 2), reinterpret_cast (reN)); symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "IM", 2), reinterpret_cast (imN)); addDone (booleanN); addDone (charN); addDone (cardinalN); addDone (longcardN); addDone (shortcardN); addDone (integerN); addDone (longintN); addDone (shortintN); addDone (bitsetN); addDone (bitnumN); addDone (ztypeN); addDone (rtypeN); addDone (realN); addDone (longrealN); addDone (shortrealN); addDone (complexN); addDone (longcomplexN); addDone (shortcomplexN); addDone (procN); addDone (nilN); addDone (trueN); addDone (falseN); } /* makeBuiltins - */ static void makeBuiltins (void) { bitsperunitN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "8", 1)); bitsperwordN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "32", 2)); bitspercharN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "8", 1)); unitsperwordN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "4", 1)); addDone (bitsperunitN); addDone (bitsperwordN); addDone (bitspercharN); addDone (unitsperwordN); } /* init - */ static void init (void) { lang = decl_ansiC; outputFile = FIO_StdOut; doP = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln}); todoQ = alists_initList (); partialQ = alists_initList (); doneQ = alists_initList (); modUniverse = symbolKey_initTree (); defUniverse = symbolKey_initTree (); modUniverseI = Indexing_InitIndex (1); defUniverseI = Indexing_InitIndex (1); scopeStack = Indexing_InitIndex (1); makeBaseSymbols (); makeSystem (); makeBuiltins (); makeM2rts (); outputState = decl_punct; tempCount = 0; mustVisitScope = FALSE; } /* getDeclaredMod - returns the token number associated with the nodes declaration in the implementation or program module. */ extern "C" unsigned int decl_getDeclaredMod (decl_node n) { return n->at.modDeclared; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getDeclaredDef - returns the token number associated with the nodes declaration in the definition module. */ extern "C" unsigned int decl_getDeclaredDef (decl_node n) { return n->at.defDeclared; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getFirstUsed - returns the token number associated with the first use of node, n. */ extern "C" unsigned int decl_getFirstUsed (decl_node n) { return n->at.firstUsed; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isDef - return TRUE if node, n, is a definition module. */ extern "C" unsigned int decl_isDef (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_def; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isImp - return TRUE if node, n, is an implementation module. */ extern "C" unsigned int decl_isImp (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_imp; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isImpOrModule - returns TRUE if, n, is a program module or implementation module. */ extern "C" unsigned int decl_isImpOrModule (decl_node n) { return (decl_isImp (n)) || (decl_isModule (n)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isVisited - returns TRUE if the node was visited. */ extern "C" unsigned int decl_isVisited (decl_node n) { switch (n->kind) { case decl_def: return n->defF.visited; break; case decl_imp: return n->impF.visited; break; case decl_module: return n->moduleF.visited; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* unsetVisited - unset the visited flag on a def/imp/module node. */ extern "C" void decl_unsetVisited (decl_node n) { switch (n->kind) { case decl_def: n->defF.visited = FALSE; break; case decl_imp: n->impF.visited = FALSE; break; case decl_module: n->moduleF.visited = FALSE; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* setVisited - set the visited flag on a def/imp/module node. */ extern "C" void decl_setVisited (decl_node n) { switch (n->kind) { case decl_def: n->defF.visited = TRUE; break; case decl_imp: n->impF.visited = TRUE; break; case decl_module: n->moduleF.visited = TRUE; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* setEnumsComplete - sets the field inside the def or imp or module, n. */ extern "C" void decl_setEnumsComplete (decl_node n) { switch (n->kind) { case decl_def: n->defF.enumsComplete = TRUE; break; case decl_imp: n->impF.enumsComplete = TRUE; break; case decl_module: n->moduleF.enumsComplete = TRUE; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* getEnumsComplete - gets the field from the def or imp or module, n. */ extern "C" unsigned int decl_getEnumsComplete (decl_node n) { switch (n->kind) { case decl_def: return n->defF.enumsComplete; break; case decl_imp: return n->impF.enumsComplete; break; case decl_module: return n->moduleF.enumsComplete; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* resetEnumPos - resets the index into the saved list of enums inside module, n. */ extern "C" void decl_resetEnumPos (decl_node n) { mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n))); if (decl_isDef (n)) { n->defF.enumFixup.count = 0; } else if (decl_isImp (n)) { /* avoid dangling else. */ n->impF.enumFixup.count = 0; } else if (decl_isModule (n)) { /* avoid dangling else. */ n->moduleF.enumFixup.count = 0; } } /* getNextEnum - returns the next enumeration node. */ extern "C" decl_node decl_getNextEnum (void) { decl_node n; n = NULL; mcDebug_assert (((decl_isDef (currentModule)) || (decl_isImp (currentModule))) || (decl_isModule (currentModule))); if (decl_isDef (currentModule)) { n = getNextFixup (¤tModule->defF.enumFixup); } else if (decl_isImp (currentModule)) { /* avoid dangling else. */ n = getNextFixup (¤tModule->impF.enumFixup); } else if (decl_isModule (currentModule)) { /* avoid dangling else. */ n = getNextFixup (¤tModule->moduleF.enumFixup); } mcDebug_assert (n != NULL); mcDebug_assert ((decl_isEnumeration (n)) || (decl_isEnumerationField (n))); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isModule - return TRUE if node, n, is a program module. */ extern "C" unsigned int decl_isModule (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_module; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isMainModule - return TRUE if node, n, is the main module specified by the source file. This might be a definition, implementation or program module. */ extern "C" unsigned int decl_isMainModule (decl_node n) { mcDebug_assert (n != NULL); return n == mainModule; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* setMainModule - sets node, n, as the main module to be compiled. */ extern "C" void decl_setMainModule (decl_node n) { mcDebug_assert (n != NULL); mainModule = n; } /* setCurrentModule - sets node, n, as the current module being compiled. */ extern "C" void decl_setCurrentModule (decl_node n) { mcDebug_assert (n != NULL); currentModule = n; } /* lookupDef - returns a definition module node named, n. */ extern "C" decl_node decl_lookupDef (nameKey_Name n) { decl_node d; d = static_cast (symbolKey_getSymKey (defUniverse, n)); if (d == NULL) { d = makeDef (n); symbolKey_putSymKey (defUniverse, n, reinterpret_cast (d)); Indexing_IncludeIndiceIntoIndex (defUniverseI, reinterpret_cast (d)); } return d; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* lookupImp - returns an implementation module node named, n. */ extern "C" decl_node decl_lookupImp (nameKey_Name n) { decl_node m; m = static_cast (symbolKey_getSymKey (modUniverse, n)); if (m == NULL) { m = makeImp (n); symbolKey_putSymKey (modUniverse, n, reinterpret_cast (m)); Indexing_IncludeIndiceIntoIndex (modUniverseI, reinterpret_cast (m)); } mcDebug_assert (! (decl_isModule (m))); return m; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* lookupModule - returns a module node named, n. */ extern "C" decl_node decl_lookupModule (nameKey_Name n) { decl_node m; m = static_cast (symbolKey_getSymKey (modUniverse, n)); if (m == NULL) { m = makeModule (n); symbolKey_putSymKey (modUniverse, n, reinterpret_cast (m)); Indexing_IncludeIndiceIntoIndex (modUniverseI, reinterpret_cast (m)); } mcDebug_assert (! (decl_isImp (m))); return m; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putDefForC - the definition module was defined FOR "C". */ extern "C" void decl_putDefForC (decl_node n) { mcDebug_assert (decl_isDef (n)); n->defF.forC = TRUE; } /* lookupInScope - looks up a symbol named, n, from, scope. */ extern "C" decl_node decl_lookupInScope (decl_node scope, nameKey_Name n) { switch (scope->kind) { case decl_def: return static_cast (symbolKey_getSymKey (scope->defF.decls.symbols, n)); break; case decl_module: return static_cast (symbolKey_getSymKey (scope->moduleF.decls.symbols, n)); break; case decl_imp: return static_cast (symbolKey_getSymKey (scope->impF.decls.symbols, n)); break; case decl_procedure: return static_cast (symbolKey_getSymKey (scope->procedureF.decls.symbols, n)); break; case decl_record: return static_cast (symbolKey_getSymKey (scope->recordF.localSymbols, n)); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isConst - returns TRUE if node, n, is a const. */ extern "C" unsigned int decl_isConst (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_const; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isType - returns TRUE if node, n, is a type. */ extern "C" unsigned int decl_isType (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_type; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putType - places, exp, as the type alias to des. TYPE des = exp ; */ extern "C" void decl_putType (decl_node des, decl_node exp) { mcDebug_assert (des != NULL); mcDebug_assert (decl_isType (des)); des->typeF.type = exp; } /* getType - returns the type associated with node, n. */ extern "C" decl_node decl_getType (decl_node n) { switch (n->kind) { case decl_new: case decl_dispose: return NULL; break; case decl_length: return cardinalN; break; case decl_inc: case decl_dec: case decl_incl: case decl_excl: return NULL; break; case decl_nil: return addressN; break; case decl_true: case decl_false: return booleanN; break; case decl_address: return n; break; case decl_loc: return n; break; case decl_byte: return n; break; case decl_word: return n; break; case decl_csizet: return n; break; case decl_cssizet: return n; break; case decl_boolean: /* base types. */ return n; break; case decl_proc: return n; break; case decl_char: return n; break; case decl_cardinal: return n; break; case decl_longcard: return n; break; case decl_shortcard: return n; break; case decl_integer: return n; break; case decl_longint: return n; break; case decl_shortint: return n; break; case decl_real: return n; break; case decl_longreal: return n; break; case decl_shortreal: return n; break; case decl_bitset: return n; break; case decl_ztype: return n; break; case decl_rtype: return n; break; case decl_complex: return n; break; case decl_longcomplex: return n; break; case decl_shortcomplex: return n; break; case decl_type: /* language features and compound type attributes. */ return n->typeF.type; break; case decl_record: return n; break; case decl_varient: return n; break; case decl_var: return n->varF.type; break; case decl_enumeration: return n; break; case decl_subrange: return n->subrangeF.type; break; case decl_array: return n->arrayF.type; break; case decl_string: return charN; break; case decl_const: return n->constF.type; break; case decl_literal: return n->literalF.type; break; case decl_varparam: return n->varparamF.type; break; case decl_param: return n->paramF.type; break; case decl_optarg: return n->optargF.type; break; case decl_pointer: return n->pointerF.type; break; case decl_recordfield: return n->recordfieldF.type; break; case decl_varientfield: return n; break; case decl_enumerationfield: return n->enumerationfieldF.type; break; case decl_set: return n->setF.type; break; case decl_proctype: return n->proctypeF.returnType; break; case decl_subscript: return n->subscriptF.type; break; case decl_procedure: /* blocks. */ return n->procedureF.returnType; break; case decl_throw: return NULL; break; case decl_unreachable: return NULL; break; case decl_def: case decl_imp: case decl_module: case decl_loop: case decl_while: case decl_for: case decl_repeat: case decl_if: case decl_elsif: case decl_assignment: /* statements. */ M2RTS_HALT (-1); __builtin_unreachable (); break; case decl_cmplx: case decl_cast: case decl_val: case decl_plus: case decl_sub: case decl_div: case decl_mod: case decl_mult: case decl_divide: /* expressions. */ return n->binaryF.resultType; break; case decl_in: return booleanN; break; case decl_max: case decl_min: case decl_re: case decl_im: case decl_abs: case decl_constexp: case decl_deref: case decl_neg: case decl_adr: case decl_size: case decl_tsize: return n->unaryF.resultType; break; case decl_and: case decl_or: case decl_not: case decl_equal: case decl_notequal: case decl_less: case decl_greater: case decl_greequal: case decl_lessequal: return booleanN; break; case decl_trunc: return integerN; break; case decl_float: return realN; break; case decl_high: return cardinalN; break; case decl_ord: return cardinalN; break; case decl_chr: return charN; break; case decl_cap: return charN; break; case decl_arrayref: return n->arrayrefF.resultType; break; case decl_componentref: return n->componentrefF.resultType; break; case decl_pointerref: return n->pointerrefF.resultType; break; case decl_funccall: return n->funccallF.type; break; case decl_setvalue: return n->setvalueF.type; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } M2RTS_HALT (-1); __builtin_unreachable (); ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* skipType - skips over type aliases. */ extern "C" decl_node decl_skipType (decl_node n) { while ((n != NULL) && (decl_isType (n))) { if ((decl_getType (n)) == NULL) { /* this will occur if, n, is an opaque type. */ return n; } n = decl_getType (n); } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putTypeHidden - marks type, des, as being a hidden type. TYPE des ; */ extern "C" void decl_putTypeHidden (decl_node des) { decl_node s; mcDebug_assert (des != NULL); mcDebug_assert (decl_isType (des)); des->typeF.isHidden = TRUE; s = decl_getScope (des); mcDebug_assert (decl_isDef (s)); s->defF.hasHidden = TRUE; } /* isTypeHidden - returns TRUE if type, n, is hidden. */ extern "C" unsigned int decl_isTypeHidden (decl_node n) { mcDebug_assert (n != NULL); mcDebug_assert (decl_isType (n)); return n->typeF.isHidden; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* hasHidden - returns TRUE if module, n, has a hidden type. */ extern "C" unsigned int decl_hasHidden (decl_node n) { mcDebug_assert (decl_isDef (n)); return n->defF.hasHidden; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isVar - returns TRUE if node, n, is a type. */ extern "C" unsigned int decl_isVar (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_var; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isTemporary - returns TRUE if node, n, is a variable and temporary. */ extern "C" unsigned int decl_isTemporary (decl_node n) { return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isExported - returns TRUE if symbol, n, is exported from the definition module. */ extern "C" unsigned int decl_isExported (decl_node n) { decl_node s; s = decl_getScope (n); if (s != NULL) { switch (s->kind) { case decl_def: return Indexing_IsIndiceInIndex (s->defF.exported, reinterpret_cast (n)); break; default: return FALSE; break; } } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getDeclScope - returns the node representing the current declaration scope. */ extern "C" decl_node decl_getDeclScope (void) { unsigned int i; i = Indexing_HighIndice (scopeStack); return static_cast (Indexing_GetIndice (scopeStack, i)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getScope - returns the scope associated with node, n. */ extern "C" decl_node decl_getScope (decl_node n) { switch (n->kind) { case decl_stmtseq: case decl_exit: case decl_return: case decl_comment: case decl_identlist: case decl_setvalue: case decl_halt: case decl_new: case decl_dispose: case decl_length: case decl_inc: case decl_dec: case decl_incl: case decl_excl: case decl_nil: case decl_true: case decl_false: return NULL; break; case decl_address: case decl_loc: case decl_byte: case decl_word: case decl_csizet: case decl_cssizet: return systemN; break; case decl_boolean: case decl_proc: case decl_char: case decl_cardinal: case decl_longcard: case decl_shortcard: case decl_integer: case decl_longint: case decl_shortint: case decl_real: case decl_longreal: case decl_shortreal: case decl_bitset: case decl_ztype: case decl_rtype: case decl_complex: case decl_longcomplex: case decl_shortcomplex: /* base types. */ return NULL; break; case decl_type: /* language features and compound type attributes. */ return n->typeF.scope; break; case decl_record: return n->recordF.scope; break; case decl_varient: return n->varientF.scope; break; case decl_var: return n->varF.scope; break; case decl_enumeration: return n->enumerationF.scope; break; case decl_subrange: return n->subrangeF.scope; break; case decl_array: return n->arrayF.scope; break; case decl_string: return NULL; break; case decl_const: return n->constF.scope; break; case decl_literal: return NULL; break; case decl_varparam: return n->varparamF.scope; break; case decl_param: return n->paramF.scope; break; case decl_optarg: return n->optargF.scope; break; case decl_pointer: return n->pointerF.scope; break; case decl_recordfield: return n->recordfieldF.scope; break; case decl_varientfield: return n->varientfieldF.scope; break; case decl_enumerationfield: return n->enumerationfieldF.scope; break; case decl_set: return n->setF.scope; break; case decl_proctype: return n->proctypeF.scope; break; case decl_subscript: return NULL; break; case decl_procedure: /* blocks. */ return n->procedureF.scope; break; case decl_def: case decl_imp: case decl_module: case decl_case: case decl_loop: case decl_while: case decl_for: case decl_repeat: case decl_if: case decl_elsif: case decl_assignment: /* statements. */ return NULL; break; case decl_componentref: case decl_pointerref: case decl_arrayref: case decl_chr: case decl_cap: case decl_ord: case decl_float: case decl_trunc: case decl_high: case decl_cast: case decl_val: case decl_plus: case decl_sub: case decl_div: case decl_mod: case decl_mult: case decl_divide: case decl_in: /* expressions. */ return NULL; break; case decl_neg: return NULL; break; case decl_lsl: case decl_lsr: case decl_lor: case decl_land: case decl_lnot: case decl_lxor: case decl_and: case decl_or: case decl_not: case decl_constexp: case decl_deref: case decl_equal: case decl_notequal: case decl_less: case decl_greater: case decl_greequal: case decl_lessequal: return NULL; break; case decl_adr: case decl_size: case decl_tsize: case decl_throw: return systemN; break; case decl_unreachable: case decl_cmplx: case decl_re: case decl_im: case decl_min: case decl_max: return NULL; break; case decl_vardecl: return n->vardeclF.scope; break; case decl_funccall: return NULL; break; case decl_explist: return NULL; break; case decl_caselabellist: return NULL; break; case decl_caselist: return NULL; break; case decl_range: return NULL; break; case decl_varargs: return n->varargsF.scope; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isLiteral - returns TRUE if, n, is a literal. */ extern "C" unsigned int decl_isLiteral (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_literal; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isConstSet - returns TRUE if, n, is a constant set. */ extern "C" unsigned int decl_isConstSet (decl_node n) { mcDebug_assert (n != NULL); if ((decl_isLiteral (n)) || (decl_isConst (n))) { return decl_isSet (decl_skipType (decl_getType (n))); } return FALSE; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isEnumerationField - returns TRUE if, n, is an enumeration field. */ extern "C" unsigned int decl_isEnumerationField (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_enumerationfield; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isEnumeration - returns TRUE if node, n, is an enumeration type. */ extern "C" unsigned int decl_isEnumeration (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_enumeration; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isUnbounded - returns TRUE if, n, is an unbounded array. */ extern "C" unsigned int decl_isUnbounded (decl_node n) { mcDebug_assert (n != NULL); return (n->kind == decl_array) && n->arrayF.isUnbounded; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isParameter - returns TRUE if, n, is a parameter. */ extern "C" unsigned int decl_isParameter (decl_node n) { mcDebug_assert (n != NULL); return (n->kind == decl_param) || (n->kind == decl_varparam); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isVarParam - returns TRUE if, n, is a var parameter. */ extern "C" unsigned int decl_isVarParam (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_varparam; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isParam - returns TRUE if, n, is a non var parameter. */ extern "C" unsigned int decl_isParam (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_param; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isNonVarParam - is an alias to isParam. */ extern "C" unsigned int decl_isNonVarParam (decl_node n) { return decl_isParam (n); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* addOptParameter - returns an optarg which has been created and added to procedure node, proc. It has a name, id, and, type, and an initial value, init. */ extern "C" decl_node decl_addOptParameter (decl_node proc, nameKey_Name id, decl_node type, decl_node init) { decl_node p; decl_node l; mcDebug_assert (decl_isProcedure (proc)); l = decl_makeIdentList (); mcDebug_assert (decl_putIdent (l, id)); checkMakeVariables (proc, l, type, FALSE, TRUE); if (! proc->procedureF.checking) { p = makeOptParameter (l, type, init); decl_addParameter (proc, p); } return p; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isOptarg - returns TRUE if, n, is an optarg. */ extern "C" unsigned int decl_isOptarg (decl_node n) { return n->kind == decl_optarg; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isRecord - returns TRUE if, n, is a record. */ extern "C" unsigned int decl_isRecord (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_record; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isRecordField - returns TRUE if, n, is a record field. */ extern "C" unsigned int decl_isRecordField (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_recordfield; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isVarientField - returns TRUE if, n, is a varient field. */ extern "C" unsigned int decl_isVarientField (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_varientfield; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isArray - returns TRUE if, n, is an array. */ extern "C" unsigned int decl_isArray (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_array; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isProcType - returns TRUE if, n, is a procedure type. */ extern "C" unsigned int decl_isProcType (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_proctype; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isPointer - returns TRUE if, n, is a pointer. */ extern "C" unsigned int decl_isPointer (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_pointer; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isProcedure - returns TRUE if, n, is a procedure. */ extern "C" unsigned int decl_isProcedure (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_procedure; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isVarient - returns TRUE if, n, is a varient record. */ extern "C" unsigned int decl_isVarient (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_varient; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isSet - returns TRUE if, n, is a set type. */ extern "C" unsigned int decl_isSet (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_set; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isSubrange - returns TRUE if, n, is a subrange type. */ extern "C" unsigned int decl_isSubrange (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_subrange; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isZtype - returns TRUE if, n, is the Z type. */ extern "C" unsigned int decl_isZtype (decl_node n) { return n == ztypeN; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isRtype - returns TRUE if, n, is the R type. */ extern "C" unsigned int decl_isRtype (decl_node n) { return n == rtypeN; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeConst - create, initialise and return a const node. */ extern "C" decl_node decl_makeConst (nameKey_Name n) { decl_node d; d = newNode (decl_const); d->constF.name = n; d->constF.type = NULL; d->constF.scope = decl_getDeclScope (); d->constF.value = NULL; return addToScope (d); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putConst - places value, v, into node, n. */ extern "C" void decl_putConst (decl_node n, decl_node v) { mcDebug_assert (decl_isConst (n)); n->constF.value = v; } /* makeType - create, initialise and return a type node. */ extern "C" decl_node decl_makeType (nameKey_Name n) { decl_node d; d = newNode (decl_type); d->typeF.name = n; d->typeF.type = NULL; d->typeF.scope = decl_getDeclScope (); d->typeF.isHidden = FALSE; d->typeF.isInternal = FALSE; return addToScope (d); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeTypeImp - lookup a type in the definition module and return it. Otherwise create a new type. */ extern "C" decl_node decl_makeTypeImp (nameKey_Name n) { decl_node d; d = decl_lookupSym (n); if (d != NULL) { d->typeF.isHidden = FALSE; return addToScope (d); } else { d = newNode (decl_type); d->typeF.name = n; d->typeF.type = NULL; d->typeF.scope = decl_getDeclScope (); d->typeF.isHidden = FALSE; return addToScope (d); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeVar - create, initialise and return a var node. */ extern "C" decl_node decl_makeVar (nameKey_Name n) { decl_node d; d = newNode (decl_var); d->varF.name = n; d->varF.type = NULL; d->varF.decl = NULL; d->varF.scope = decl_getDeclScope (); d->varF.isInitialised = FALSE; d->varF.isParameter = FALSE; d->varF.isVarParameter = FALSE; initCname (&d->varF.cname); return addToScope (d); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putVar - places, type, as the type for var. */ extern "C" void decl_putVar (decl_node var, decl_node type, decl_node decl) { mcDebug_assert (var != NULL); mcDebug_assert (decl_isVar (var)); var->varF.type = type; var->varF.decl = decl; } /* makeVarDecl - create a vardecl node and create a shadow variable in the current scope. */ extern "C" decl_node decl_makeVarDecl (decl_node i, decl_node type) { decl_node d; decl_node v; unsigned int j; unsigned int n; type = checkPtr (type); d = newNode (decl_vardecl); d->vardeclF.names = i->identlistF.names; d->vardeclF.type = type; d->vardeclF.scope = decl_getDeclScope (); n = wlists_noOfItemsInList (d->vardeclF.names); j = 1; while (j <= n) { v = decl_lookupSym (wlists_getItemFromList (d->vardeclF.names, j)); mcDebug_assert (decl_isVar (v)); decl_putVar (v, type, d); j += 1; } return d; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeEnum - creates an enumerated type and returns the node. */ extern "C" decl_node decl_makeEnum (void) { if ((currentModule != NULL) && (decl_getEnumsComplete (currentModule))) { return decl_getNextEnum (); } else { return doMakeEnum (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeEnumField - returns an enumeration field, named, n. */ extern "C" decl_node decl_makeEnumField (decl_node e, nameKey_Name n) { if ((currentModule != NULL) && (decl_getEnumsComplete (currentModule))) { return decl_getNextEnum (); } else { return doMakeEnumField (e, n); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeSubrange - returns a subrange node, built from range: low..high. */ extern "C" decl_node decl_makeSubrange (decl_node low, decl_node high) { decl_node n; n = newNode (decl_subrange); n->subrangeF.low = low; n->subrangeF.high = high; n->subrangeF.type = NULL; n->subrangeF.scope = decl_getDeclScope (); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putSubrangeType - assigns, type, to the subrange type, sub. */ extern "C" void decl_putSubrangeType (decl_node sub, decl_node type) { mcDebug_assert (decl_isSubrange (sub)); sub->subrangeF.type = type; } /* makePointer - returns a pointer of, type, node. */ extern "C" decl_node decl_makePointer (decl_node type) { decl_node n; n = newNode (decl_pointer); n->pointerF.type = type; n->pointerF.scope = decl_getDeclScope (); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeSet - returns a set of, type, node. */ extern "C" decl_node decl_makeSet (decl_node type) { decl_node n; n = newNode (decl_set); n->setF.type = type; n->setF.scope = decl_getDeclScope (); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeArray - returns a node representing ARRAY subr OF type. */ extern "C" decl_node decl_makeArray (decl_node subr, decl_node type) { decl_node n; decl_node s; s = decl_skipType (subr); mcDebug_assert (((decl_isSubrange (s)) || (isOrdinal (s))) || (decl_isEnumeration (s))); n = newNode (decl_array); n->arrayF.subr = subr; n->arrayF.type = type; n->arrayF.scope = decl_getDeclScope (); n->arrayF.isUnbounded = FALSE; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putUnbounded - sets array, n, as unbounded. */ extern "C" void decl_putUnbounded (decl_node n) { mcDebug_assert (n->kind == decl_array); n->arrayF.isUnbounded = TRUE; } /* makeRecord - creates and returns a record node. */ extern "C" decl_node decl_makeRecord (void) { decl_node n; n = newNode (decl_record); n->recordF.localSymbols = symbolKey_initTree (); n->recordF.listOfSons = Indexing_InitIndex (1); n->recordF.scope = decl_getDeclScope (); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeVarient - creates a new symbol, a varient symbol for record or varient field symbol, r. */ extern "C" decl_node decl_makeVarient (decl_node r) { decl_node n; n = newNode (decl_varient); n->varientF.listOfSons = Indexing_InitIndex (1); /* if so use this n^.varientF.parent := r */ if (decl_isRecord (r)) { n->varientF.varient = NULL; } else { n->varientF.varient = r; } n->varientF.tag = NULL; n->varientF.scope = decl_getDeclScope (); switch (r->kind) { case decl_record: /* now add, n, to the record/varient, r, field list */ Indexing_IncludeIndiceIntoIndex (r->recordF.listOfSons, reinterpret_cast (n)); break; case decl_varientfield: Indexing_IncludeIndiceIntoIndex (r->varientfieldF.listOfSons, reinterpret_cast (n)); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* addFieldsToRecord - adds fields, i, of type, t, into a record, r. It returns, r. */ extern "C" decl_node decl_addFieldsToRecord (decl_node r, decl_node v, decl_node i, decl_node t) { decl_node p; decl_node fj; unsigned int j; unsigned int n; nameKey_Name fn; if (decl_isRecord (r)) { p = r; v = NULL; } else { p = getRecord (getParent (r)); mcDebug_assert (decl_isVarientField (r)); mcDebug_assert (decl_isVarient (v)); putFieldVarient (r, v); } n = wlists_noOfItemsInList (i->identlistF.names); j = 1; while (j <= n) { fn = static_cast (wlists_getItemFromList (i->identlistF.names, j)); fj = static_cast (symbolKey_getSymKey (p->recordF.localSymbols, n)); if (fj == NULL) { fj = putFieldRecord (r, fn, t, v); } else { 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)); } j += 1; } return r; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* buildVarientSelector - builds a field of name, tag, of, type onto: record or varient field, r. varient, v. */ extern "C" void decl_buildVarientSelector (decl_node r, decl_node v, nameKey_Name tag, decl_node type) { decl_node f; mcDebug_assert ((decl_isRecord (r)) || (decl_isVarientField (r))); if ((decl_isRecord (r)) || (decl_isVarientField (r))) { /* avoid gcc warning by using compound statement even if not strictly necessary. */ if ((type == NULL) && (tag == nameKey_NulName)) { mcMetaError_metaError1 ((const char *) "expecting a tag field in the declaration of a varient record {%1Ua}", 67, (const unsigned char *) &r, (sizeof (r)-1)); } else if (type == NULL) { /* avoid dangling else. */ f = decl_lookupSym (tag); putVarientTag (v, f); } else { /* avoid dangling else. */ f = putFieldRecord (r, tag, type, v); mcDebug_assert (decl_isRecordField (f)); f->recordfieldF.tag = TRUE; putVarientTag (v, f); } } } /* buildVarientFieldRecord - builds a varient field into a varient symbol, v. The varient field is returned. */ extern "C" decl_node decl_buildVarientFieldRecord (decl_node v, decl_node p) { decl_node f; mcDebug_assert (decl_isVarient (v)); f = makeVarientField (v, p); mcDebug_assert (decl_isVarientField (f)); putFieldVarient (f, v); return f; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getSymName - returns the name of symbol, n. */ extern "C" nameKey_Name decl_getSymName (decl_node n) { switch (n->kind) { case decl_new: return nameKey_makeKey ((const char *) "NEW", 3); break; case decl_dispose: return nameKey_makeKey ((const char *) "DISPOSE", 7); break; case decl_length: return nameKey_makeKey ((const char *) "LENGTH", 6); break; case decl_inc: return nameKey_makeKey ((const char *) "INC", 3); break; case decl_dec: return nameKey_makeKey ((const char *) "DEC", 3); break; case decl_incl: return nameKey_makeKey ((const char *) "INCL", 4); break; case decl_excl: return nameKey_makeKey ((const char *) "EXCL", 4); break; case decl_nil: return nameKey_makeKey ((const char *) "NIL", 3); break; case decl_true: return nameKey_makeKey ((const char *) "TRUE", 4); break; case decl_false: return nameKey_makeKey ((const char *) "FALSE", 5); break; case decl_address: return nameKey_makeKey ((const char *) "ADDRESS", 7); break; case decl_loc: return nameKey_makeKey ((const char *) "LOC", 3); break; case decl_byte: return nameKey_makeKey ((const char *) "BYTE", 4); break; case decl_word: return nameKey_makeKey ((const char *) "WORD", 4); break; case decl_csizet: return nameKey_makeKey ((const char *) "CSIZE_T", 7); break; case decl_cssizet: return nameKey_makeKey ((const char *) "CSSIZE_T", 8); break; case decl_boolean: /* base types. */ return nameKey_makeKey ((const char *) "BOOLEAN", 7); break; case decl_proc: return nameKey_makeKey ((const char *) "PROC", 4); break; case decl_char: return nameKey_makeKey ((const char *) "CHAR", 4); break; case decl_cardinal: return nameKey_makeKey ((const char *) "CARDINAL", 8); break; case decl_longcard: return nameKey_makeKey ((const char *) "LONGCARD", 8); break; case decl_shortcard: return nameKey_makeKey ((const char *) "SHORTCARD", 9); break; case decl_integer: return nameKey_makeKey ((const char *) "INTEGER", 7); break; case decl_longint: return nameKey_makeKey ((const char *) "LONGINT", 7); break; case decl_shortint: return nameKey_makeKey ((const char *) "SHORTINT", 8); break; case decl_real: return nameKey_makeKey ((const char *) "REAL", 4); break; case decl_longreal: return nameKey_makeKey ((const char *) "LONGREAL", 8); break; case decl_shortreal: return nameKey_makeKey ((const char *) "SHORTREAL", 9); break; case decl_bitset: return nameKey_makeKey ((const char *) "BITSET", 6); break; case decl_ztype: return nameKey_makeKey ((const char *) "_ZTYPE", 6); break; case decl_rtype: return nameKey_makeKey ((const char *) "_RTYPE", 6); break; case decl_complex: return nameKey_makeKey ((const char *) "COMPLEX", 7); break; case decl_longcomplex: return nameKey_makeKey ((const char *) "LONGCOMPLEX", 11); break; case decl_shortcomplex: return nameKey_makeKey ((const char *) "SHORTCOMPLEX", 12); break; case decl_type: /* language features and compound type attributes. */ return n->typeF.name; break; case decl_record: return nameKey_NulName; break; case decl_varient: return nameKey_NulName; break; case decl_var: return n->varF.name; break; case decl_enumeration: return nameKey_NulName; break; case decl_subrange: return nameKey_NulName; break; case decl_pointer: return nameKey_NulName; break; case decl_array: return nameKey_NulName; break; case decl_string: return n->stringF.name; break; case decl_const: return n->constF.name; break; case decl_literal: return n->literalF.name; break; case decl_varparam: return nameKey_NulName; break; case decl_param: return nameKey_NulName; break; case decl_optarg: return nameKey_NulName; break; case decl_recordfield: return n->recordfieldF.name; break; case decl_varientfield: return n->varientfieldF.name; break; case decl_enumerationfield: return n->enumerationfieldF.name; break; case decl_set: return nameKey_NulName; break; case decl_proctype: return nameKey_NulName; break; case decl_subscript: return nameKey_NulName; break; case decl_procedure: /* blocks. */ return n->procedureF.name; break; case decl_def: return n->defF.name; break; case decl_imp: return n->impF.name; break; case decl_module: return n->moduleF.name; break; case decl_loop: case decl_while: case decl_for: case decl_repeat: case decl_if: case decl_elsif: case decl_assignment: /* statements. */ return nameKey_NulName; break; case decl_constexp: case decl_deref: case decl_arrayref: case decl_componentref: case decl_cast: case decl_val: case decl_plus: case decl_sub: case decl_div: case decl_mod: case decl_mult: case decl_divide: case decl_in: case decl_neg: case decl_equal: case decl_notequal: case decl_less: case decl_greater: case decl_greequal: case decl_lessequal: /* expressions. */ return nameKey_NulName; break; case decl_adr: return nameKey_makeKey ((const char *) "ADR", 3); break; case decl_size: return nameKey_makeKey ((const char *) "SIZE", 4); break; case decl_tsize: return nameKey_makeKey ((const char *) "TSIZE", 5); break; case decl_chr: return nameKey_makeKey ((const char *) "CHR", 3); break; case decl_abs: return nameKey_makeKey ((const char *) "ABS", 3); break; case decl_ord: return nameKey_makeKey ((const char *) "ORD", 3); break; case decl_float: return nameKey_makeKey ((const char *) "FLOAT", 5); break; case decl_trunc: return nameKey_makeKey ((const char *) "TRUNC", 5); break; case decl_high: return nameKey_makeKey ((const char *) "HIGH", 4); break; case decl_throw: return nameKey_makeKey ((const char *) "THROW", 5); break; case decl_unreachable: return nameKey_makeKey ((const char *) "builtin_unreachable", 19); break; case decl_cmplx: return nameKey_makeKey ((const char *) "CMPLX", 5); break; case decl_re: return nameKey_makeKey ((const char *) "RE", 2); break; case decl_im: return nameKey_makeKey ((const char *) "IM", 2); break; case decl_max: return nameKey_makeKey ((const char *) "MAX", 3); break; case decl_min: return nameKey_makeKey ((const char *) "MIN", 3); break; case decl_funccall: return nameKey_NulName; break; case decl_identlist: return nameKey_NulName; break; default: M2RTS_HALT (-1); __builtin_unreachable (); break; } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* import - attempts to add node, n, into the scope of module, m. It might fail due to a name clash in which case the previous named symbol is returned. On success, n, is returned. */ extern "C" decl_node decl_import (decl_node m, decl_node n) { nameKey_Name name; decl_node r; mcDebug_assert (((decl_isDef (m)) || (decl_isModule (m))) || (decl_isImp (m))); name = decl_getSymName (n); r = decl_lookupInScope (m, name); if (r == NULL) { switch (m->kind) { case decl_def: symbolKey_putSymKey (m->defF.decls.symbols, name, reinterpret_cast (n)); break; case decl_imp: symbolKey_putSymKey (m->impF.decls.symbols, name, reinterpret_cast (n)); break; case decl_module: symbolKey_putSymKey (m->moduleF.decls.symbols, name, reinterpret_cast (n)); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } importEnumFields (m, n); return n; } return r; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* lookupExported - attempts to lookup a node named, i, from definition module, n. The node is returned if found. NIL is returned if not found. */ extern "C" decl_node decl_lookupExported (decl_node n, nameKey_Name i) { decl_node r; mcDebug_assert (decl_isDef (n)); r = static_cast (symbolKey_getSymKey (n->defF.decls.symbols, i)); if ((r != NULL) && (decl_isExported (r))) { return r; } return NULL; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* lookupSym - returns the symbol named, n, from the scope stack. */ extern "C" decl_node decl_lookupSym (nameKey_Name n) { decl_node s; decl_node m; unsigned int l; unsigned int h; l = Indexing_LowIndice (scopeStack); h = Indexing_HighIndice (scopeStack); while (h >= l) { s = static_cast (Indexing_GetIndice (scopeStack, h)); m = decl_lookupInScope (s, n); if (debugScopes && (m == NULL)) { out3 ((const char *) " [%d] search for symbol name %s in scope %s\\n", 45, h, n, s); } if (m != NULL) { if (debugScopes) { out3 ((const char *) " [%d] search for symbol name %s in scope %s (found)\\n", 53, h, n, s); } return m; } h -= 1; } return lookupBase (n); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* addImportedModule - add module, i, to be imported by, m. If scoped then module, i, is added to the module, m, scope. */ extern "C" void decl_addImportedModule (decl_node m, decl_node i, unsigned int scoped) { mcDebug_assert ((decl_isDef (i)) || (decl_isModule (i))); if (decl_isDef (m)) { Indexing_IncludeIndiceIntoIndex (m->defF.importedModules, reinterpret_cast (i)); } else if (decl_isImp (m)) { /* avoid dangling else. */ Indexing_IncludeIndiceIntoIndex (m->impF.importedModules, reinterpret_cast (i)); } else if (decl_isModule (m)) { /* avoid dangling else. */ Indexing_IncludeIndiceIntoIndex (m->moduleF.importedModules, reinterpret_cast (i)); } else { /* avoid dangling else. */ M2RTS_HALT (-1); __builtin_unreachable (); } if (scoped) { addModuleToScope (m, i); } } /* setSource - sets the source filename for module, n, to s. */ extern "C" void decl_setSource (decl_node n, nameKey_Name s) { switch (n->kind) { case decl_def: n->defF.source = s; break; case decl_module: n->moduleF.source = s; break; case decl_imp: n->impF.source = s; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* getSource - returns the source filename for module, n. */ extern "C" nameKey_Name decl_getSource (decl_node n) { switch (n->kind) { case decl_def: return n->defF.source; break; case decl_module: return n->moduleF.source; break; case decl_imp: return n->impF.source; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getMainModule - returns the main module node. */ extern "C" decl_node decl_getMainModule (void) { return mainModule; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getCurrentModule - returns the current module being compiled. */ extern "C" decl_node decl_getCurrentModule (void) { return currentModule; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* foreachDefModuleDo - foreach definition node, n, in the module universe, call p (n). */ extern "C" void decl_foreachDefModuleDo (symbolKey_performOperation p) { Indexing_ForeachIndiceInIndexDo (defUniverseI, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) p.proc}); } /* foreachModModuleDo - foreach implementation or module node, n, in the module universe, call p (n). */ extern "C" void decl_foreachModModuleDo (symbolKey_performOperation p) { Indexing_ForeachIndiceInIndexDo (modUniverseI, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) p.proc}); } /* enterScope - pushes symbol, n, to the scope stack. */ extern "C" void decl_enterScope (decl_node n) { if (Indexing_IsIndiceInIndex (scopeStack, reinterpret_cast (n))) { M2RTS_HALT (-1); __builtin_unreachable (); } else { Indexing_IncludeIndiceIntoIndex (scopeStack, reinterpret_cast (n)); } if (debugScopes) { libc_printf ((const char *) "enter scope\\n", 13); dumpScopes (); } } /* leaveScope - removes the top level scope. */ extern "C" void decl_leaveScope (void) { unsigned int i; decl_node n; i = Indexing_HighIndice (scopeStack); n = static_cast (Indexing_GetIndice (scopeStack, i)); Indexing_RemoveIndiceFromIndex (scopeStack, reinterpret_cast (n)); if (debugScopes) { libc_printf ((const char *) "leave scope\\n", 13); dumpScopes (); } } /* makeProcedure - create, initialise and return a procedure node. */ extern "C" decl_node decl_makeProcedure (nameKey_Name n) { decl_node d; d = decl_lookupSym (n); if (d == NULL) { d = newNode (decl_procedure); d->procedureF.name = n; initDecls (&d->procedureF.decls); d->procedureF.scope = decl_getDeclScope (); d->procedureF.parameters = Indexing_InitIndex (1); d->procedureF.isForC = isDefForCNode (decl_getDeclScope ()); d->procedureF.built = FALSE; d->procedureF.returnopt = FALSE; d->procedureF.optarg_ = NULL; d->procedureF.noreturnused = FALSE; d->procedureF.noreturn = FALSE; d->procedureF.vararg = FALSE; d->procedureF.checking = FALSE; d->procedureF.paramcount = 0; d->procedureF.returnType = NULL; d->procedureF.beginStatements = NULL; initCname (&d->procedureF.cname); d->procedureF.defComment = NULL; d->procedureF.modComment = NULL; } return addProcedureToScope (d, n); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putCommentDefProcedure - remembers the procedure comment (if it exists) as a definition module procedure heading. NIL is placed if there is no procedure comment available. */ extern "C" void decl_putCommentDefProcedure (decl_node n) { mcDebug_assert (decl_isProcedure (n)); if (mcComment_isProcedureComment (mcLexBuf_lastcomment)) { n->procedureF.defComment = mcLexBuf_lastcomment; } } /* putCommentModProcedure - remembers the procedure comment (if it exists) as an implementation/program module procedure heading. NIL is placed if there is no procedure comment available. */ extern "C" void decl_putCommentModProcedure (decl_node n) { mcDebug_assert (decl_isProcedure (n)); if (mcComment_isProcedureComment (mcLexBuf_lastcomment)) { n->procedureF.modComment = mcLexBuf_lastcomment; } } /* makeProcType - returns a proctype node. */ extern "C" decl_node decl_makeProcType (void) { decl_node d; d = newNode (decl_proctype); d->proctypeF.scope = decl_getDeclScope (); d->proctypeF.parameters = Indexing_InitIndex (1); d->proctypeF.returnopt = FALSE; d->proctypeF.optarg_ = NULL; d->proctypeF.vararg = FALSE; d->proctypeF.returnType = NULL; return d; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putReturnType - sets the return type of procedure or proctype, proc, to, type. */ extern "C" void decl_putReturnType (decl_node proc, decl_node type) { mcDebug_assert ((decl_isProcedure (proc)) || (decl_isProcType (proc))); if (decl_isProcedure (proc)) { proc->procedureF.returnType = type; } else { proc->proctypeF.returnType = type; } } /* putOptReturn - sets, proctype or procedure, proc, to have an optional return type. */ extern "C" void decl_putOptReturn (decl_node proc) { mcDebug_assert ((decl_isProcedure (proc)) || (decl_isProcType (proc))); if (decl_isProcedure (proc)) { proc->procedureF.returnopt = TRUE; } else { proc->proctypeF.returnopt = TRUE; } } /* makeVarParameter - returns a var parameter node with, name: type. */ extern "C" decl_node decl_makeVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused) { decl_node d; mcDebug_assert ((l == NULL) || (isIdentList (l))); d = newNode (decl_varparam); d->varparamF.namelist = l; d->varparamF.type = type; d->varparamF.scope = proc; d->varparamF.isUnbounded = FALSE; d->varparamF.isForC = isDefForCNode (proc); d->varparamF.isUsed = isused; return d; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeNonVarParameter - returns a non var parameter node with, name: type. */ extern "C" decl_node decl_makeNonVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused) { decl_node d; mcDebug_assert ((l == NULL) || (isIdentList (l))); d = newNode (decl_param); d->paramF.namelist = l; d->paramF.type = type; d->paramF.scope = proc; d->paramF.isUnbounded = FALSE; d->paramF.isForC = isDefForCNode (proc); d->paramF.isUsed = isused; return d; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* paramEnter - reset the parameter count. */ extern "C" void decl_paramEnter (decl_node n) { mcDebug_assert (decl_isProcedure (n)); n->procedureF.paramcount = 0; } /* paramLeave - set paramater checking to TRUE from now onwards. */ extern "C" void decl_paramLeave (decl_node n) { mcDebug_assert (decl_isProcedure (n)); n->procedureF.checking = TRUE; if ((decl_isImp (currentModule)) || (decl_isModule (currentModule))) { n->procedureF.built = TRUE; } } /* makeIdentList - returns a node which will be used to maintain an ident list. */ extern "C" decl_node decl_makeIdentList (void) { decl_node n; n = newNode (decl_identlist); n->identlistF.names = wlists_initList (); n->identlistF.cnamed = FALSE; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putIdent - places ident, i, into identlist, n. It returns TRUE if ident, i, is unique. */ extern "C" unsigned int decl_putIdent (decl_node n, nameKey_Name i) { mcDebug_assert (isIdentList (n)); if (wlists_isItemInList (n->identlistF.names, i)) { return FALSE; } else { wlists_putItemIntoList (n->identlistF.names, i); return TRUE; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* addVarParameters - adds the identlist, i, of, type, to be VAR parameters in procedure, n. */ extern "C" void decl_addVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused) { decl_node p; mcDebug_assert (isIdentList (i)); mcDebug_assert (decl_isProcedure (n)); checkMakeVariables (n, i, type, TRUE, isused); if (n->procedureF.checking) { checkParameters (n, i, type, TRUE, isused); /* will destroy, i. */ } else { p = decl_makeVarParameter (i, type, n, isused); Indexing_IncludeIndiceIntoIndex (n->procedureF.parameters, reinterpret_cast (p)); } } /* addNonVarParameters - adds the identlist, i, of, type, to be parameters in procedure, n. */ extern "C" void decl_addNonVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused) { decl_node p; mcDebug_assert (isIdentList (i)); mcDebug_assert (decl_isProcedure (n)); checkMakeVariables (n, i, type, FALSE, isused); if (n->procedureF.checking) { checkParameters (n, i, type, FALSE, isused); /* will destroy, i. */ } else { p = decl_makeNonVarParameter (i, type, n, isused); Indexing_IncludeIndiceIntoIndex (n->procedureF.parameters, reinterpret_cast (p)); } } /* makeVarargs - returns a varargs node. */ extern "C" decl_node decl_makeVarargs (void) { decl_node d; d = newNode (decl_varargs); d->varargsF.scope = NULL; return d; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isVarargs - returns TRUE if, n, is a varargs node. */ extern "C" unsigned int decl_isVarargs (decl_node n) { return n->kind == decl_varargs; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* addParameter - adds a parameter, param, to procedure or proctype, proc. */ extern "C" void decl_addParameter (decl_node proc, decl_node param) { mcDebug_assert ((((decl_isVarargs (param)) || (decl_isParam (param))) || (decl_isVarParam (param))) || (decl_isOptarg (param))); switch (proc->kind) { case decl_procedure: Indexing_IncludeIndiceIntoIndex (proc->procedureF.parameters, reinterpret_cast (param)); if (decl_isVarargs (param)) { proc->procedureF.vararg = TRUE; } if (decl_isOptarg (param)) { proc->procedureF.optarg_ = param; } break; case decl_proctype: Indexing_IncludeIndiceIntoIndex (proc->proctypeF.parameters, reinterpret_cast (param)); if (decl_isVarargs (param)) { proc->proctypeF.vararg = TRUE; } if (decl_isOptarg (param)) { proc->proctypeF.optarg_ = param; } break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* makeBinaryTok - creates and returns a boolean type node with, l, and, r, nodes. */ extern "C" decl_node decl_makeBinaryTok (mcReserved_toktype op, decl_node l, decl_node r) { if (op == mcReserved_equaltok) { return makeBinary (decl_equal, l, r, booleanN); } else if ((op == mcReserved_hashtok) || (op == mcReserved_lessgreatertok)) { /* avoid dangling else. */ return makeBinary (decl_notequal, l, r, booleanN); } else if (op == mcReserved_lesstok) { /* avoid dangling else. */ return makeBinary (decl_less, l, r, booleanN); } else if (op == mcReserved_greatertok) { /* avoid dangling else. */ return makeBinary (decl_greater, l, r, booleanN); } else if (op == mcReserved_greaterequaltok) { /* avoid dangling else. */ return makeBinary (decl_greequal, l, r, booleanN); } else if (op == mcReserved_lessequaltok) { /* avoid dangling else. */ return makeBinary (decl_lessequal, l, r, booleanN); } else if (op == mcReserved_andtok) { /* avoid dangling else. */ return makeBinary (decl_and, l, r, booleanN); } else if (op == mcReserved_ortok) { /* avoid dangling else. */ return makeBinary (decl_or, l, r, booleanN); } else if (op == mcReserved_plustok) { /* avoid dangling else. */ return makeBinary (decl_plus, l, r, NULL); } else if (op == mcReserved_minustok) { /* avoid dangling else. */ return makeBinary (decl_sub, l, r, NULL); } else if (op == mcReserved_divtok) { /* avoid dangling else. */ return makeBinary (decl_div, l, r, NULL); } else if (op == mcReserved_timestok) { /* avoid dangling else. */ return makeBinary (decl_mult, l, r, NULL); } else if (op == mcReserved_modtok) { /* avoid dangling else. */ return makeBinary (decl_mod, l, r, NULL); } else if (op == mcReserved_intok) { /* avoid dangling else. */ return makeBinary (decl_in, l, r, NULL); } else if (op == mcReserved_dividetok) { /* avoid dangling else. */ return makeBinary (decl_divide, l, r, NULL); } else { /* avoid dangling else. */ M2RTS_HALT (-1); /* most likely op needs a clause as above. */ __builtin_unreachable (); } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* makeUnaryTok - creates and returns a boolean type node with, e, node. */ extern "C" decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e) { if (op == mcReserved_nottok) { return makeUnary (decl_not, e, booleanN); } else if (op == mcReserved_plustok) { /* avoid dangling else. */ return makeUnary (decl_plus, e, NULL); } else if (op == mcReserved_minustok) { /* avoid dangling else. */ return makeUnary (decl_neg, e, NULL); } else { /* avoid dangling else. */ M2RTS_HALT (-1); /* most likely op needs a clause as above. */ __builtin_unreachable (); } ReturnException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } /* makeComponentRef - build a componentref node which accesses, field, within, record, rec. */ extern "C" decl_node decl_makeComponentRef (decl_node rec, decl_node field) { decl_node n; decl_node a; /* n := getLastOp (rec) ; IF (n#NIL) AND (isDeref (n) OR isPointerRef (n)) AND (skipType (getType (rec)) = skipType (getType (n))) THEN a := n^.unaryF.arg ; n^.kind := pointerref ; n^.pointerrefF.ptr := a ; n^.pointerrefF.field := field ; n^.pointerrefF.resultType := getType (field) ; RETURN n ELSE RETURN doMakeComponentRef (rec, field) END */ if (isDeref (rec)) { a = rec->unaryF.arg; rec->kind = decl_pointerref; rec->pointerrefF.ptr = a; rec->pointerrefF.field = field; rec->pointerrefF.resultType = decl_getType (field); return rec; } else { return doMakeComponentRef (rec, field); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makePointerRef - build a pointerref node which accesses, field, within, pointer to record, ptr. */ extern "C" decl_node decl_makePointerRef (decl_node ptr, decl_node field) { decl_node n; n = newNode (decl_pointerref); n->pointerrefF.ptr = ptr; n->pointerrefF.field = field; n->pointerrefF.resultType = decl_getType (field); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isPointerRef - returns TRUE if, n, is a pointerref node. */ extern "C" unsigned int decl_isPointerRef (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_pointerref; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeDeRef - dereferences the pointer defined by, n. */ extern "C" decl_node decl_makeDeRef (decl_node n) { decl_node t; t = decl_skipType (decl_getType (n)); mcDebug_assert (decl_isPointer (t)); return makeUnary (decl_deref, n, decl_getType (t)); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeArrayRef - build an arrayref node which access element, index, in, array. array is a variable/expression/constant which has a type array. */ extern "C" decl_node decl_makeArrayRef (decl_node array, decl_node index) { decl_node n; decl_node t; unsigned int i; unsigned int j; n = newNode (decl_arrayref); n->arrayrefF.array = array; n->arrayrefF.index = index; t = array; j = expListLen (index); i = 1; t = decl_skipType (decl_getType (t)); do { if (decl_isArray (t)) { t = decl_skipType (decl_getType (t)); } else { 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)); } i += 1; } while (! (i > j)); n->arrayrefF.resultType = t; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getLastOp - return the right most non leaf node. */ extern "C" decl_node decl_getLastOp (decl_node n) { return doGetLastOp (n, n); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getCardinal - returns the cardinal type node. */ extern "C" decl_node decl_getCardinal (void) { return cardinalN; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeLiteralInt - creates and returns a literal node based on an integer type. */ extern "C" decl_node decl_makeLiteralInt (nameKey_Name n) { decl_node m; DynamicStrings_String s; m = newNode (decl_literal); s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); m->literalF.name = n; if ((DynamicStrings_char (s, -1)) == 'C') { m->literalF.type = charN; } else { m->literalF.type = ztypeN; } s = DynamicStrings_KillString (s); return m; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeLiteralReal - creates and returns a literal node based on a real type. */ extern "C" decl_node decl_makeLiteralReal (nameKey_Name n) { decl_node m; m = newNode (decl_literal); m->literalF.name = n; m->literalF.type = rtypeN; return m; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeString - creates and returns a node containing string, n. */ extern "C" decl_node decl_makeString (nameKey_Name n) { decl_node m; m = newNode (decl_string); m->stringF.name = n; m->stringF.length = nameKey_lengthKey (n); m->stringF.isCharCompatible = m->stringF.length <= 3; m->stringF.cstring = toCstring (n); m->stringF.clength = lenCstring (m->stringF.cstring); if (m->stringF.isCharCompatible) { m->stringF.cchar = toCchar (n); } else { m->stringF.cchar = NULL; } return m; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeSetValue - creates and returns a setvalue node. */ extern "C" decl_node decl_makeSetValue (void) { decl_node n; n = newNode (decl_setvalue); n->setvalueF.type = bitsetN; n->setvalueF.values = Indexing_InitIndex (1); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isSetValue - returns TRUE if, n, is a setvalue node. */ extern "C" unsigned int decl_isSetValue (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_setvalue; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putSetValue - assigns the type, t, to the set value, n. The node, n, is returned. */ extern "C" decl_node decl_putSetValue (decl_node n, decl_node t) { mcDebug_assert (decl_isSetValue (n)); n->setvalueF.type = t; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* includeSetValue - includes the range l..h into the setvalue. h might be NIL indicating that a single element is to be included into the set. n is returned. */ extern "C" decl_node decl_includeSetValue (decl_node n, decl_node l, decl_node h) { mcDebug_assert (decl_isSetValue (n)); Indexing_IncludeIndiceIntoIndex (n->setvalueF.values, reinterpret_cast (l)); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getBuiltinConst - creates and returns a builtin const if available. */ extern "C" decl_node decl_getBuiltinConst (nameKey_Name n) { if (n == (nameKey_makeKey ((const char *) "BITS_PER_UNIT", 13))) { return bitsperunitN; } else if (n == (nameKey_makeKey ((const char *) "BITS_PER_WORD", 13))) { /* avoid dangling else. */ return bitsperwordN; } else if (n == (nameKey_makeKey ((const char *) "BITS_PER_CHAR", 13))) { /* avoid dangling else. */ return bitspercharN; } else if (n == (nameKey_makeKey ((const char *) "UNITS_PER_WORD", 14))) { /* avoid dangling else. */ return unitsperwordN; } else { /* avoid dangling else. */ return NULL; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeExpList - creates and returns an expList node. */ extern "C" decl_node decl_makeExpList (void) { decl_node n; n = newNode (decl_explist); n->explistF.exp = Indexing_InitIndex (1); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isExpList - returns TRUE if, n, is an explist node. */ extern "C" unsigned int decl_isExpList (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_explist; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putExpList - places, expression, e, within the explist, n. */ extern "C" void decl_putExpList (decl_node n, decl_node e) { mcDebug_assert (n != NULL); mcDebug_assert (decl_isExpList (n)); Indexing_PutIndice (n->explistF.exp, (Indexing_HighIndice (n->explistF.exp))+1, reinterpret_cast (e)); } /* makeConstExp - returns a constexp node. */ extern "C" decl_node decl_makeConstExp (void) { if ((currentModule != NULL) && (getConstExpComplete (currentModule))) { return decl_getNextConstExp (); } else { return doMakeConstExp (); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* getNextConstExp - returns the next constexp node. */ extern "C" decl_node decl_getNextConstExp (void) { decl_node n; mcDebug_assert (((decl_isDef (currentModule)) || (decl_isImp (currentModule))) || (decl_isModule (currentModule))); if (decl_isDef (currentModule)) { return getNextFixup (¤tModule->defF.constFixup); } else if (decl_isImp (currentModule)) { /* avoid dangling else. */ return getNextFixup (¤tModule->impF.constFixup); } else if (decl_isModule (currentModule)) { /* avoid dangling else. */ return getNextFixup (¤tModule->moduleF.constFixup); } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* setConstExpComplete - sets the field inside the def or imp or module, n. */ extern "C" void decl_setConstExpComplete (decl_node n) { switch (n->kind) { case decl_def: n->defF.constsComplete = TRUE; break; case decl_imp: n->impF.constsComplete = TRUE; break; case decl_module: n->moduleF.constsComplete = TRUE; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* fixupConstExp - assign fixup expression, e, into the argument of, c. */ extern "C" decl_node decl_fixupConstExp (decl_node c, decl_node e) { mcDebug_assert (isConstExp (c)); c->unaryF.arg = e; return c; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* resetConstExpPos - resets the index into the saved list of constexps inside module, n. */ extern "C" void decl_resetConstExpPos (decl_node n) { mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n))); if (decl_isDef (n)) { n->defF.constFixup.count = 0; } else if (decl_isImp (n)) { /* avoid dangling else. */ n->impF.constFixup.count = 0; } else if (decl_isModule (n)) { /* avoid dangling else. */ n->moduleF.constFixup.count = 0; } } /* makeFuncCall - builds a function call to c with param list, n. */ extern "C" decl_node decl_makeFuncCall (decl_node c, decl_node n) { decl_node f; mcDebug_assert ((n == NULL) || (decl_isExpList (n))); if (((c == haltN) && ((decl_getMainModule ()) != (decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5))))) && ((decl_getMainModule ()) != (decl_lookupImp (nameKey_makeKey ((const char *) "M2RTS", 5))))) { decl_addImportedModule (decl_getMainModule (), decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5)), FALSE); } f = checkIntrinsic (c, n); checkCHeaders (c); if (f == NULL) { f = newNode (decl_funccall); f->funccallF.function = c; f->funccallF.args = n; f->funccallF.type = NULL; initPair (&f->funccallF.funccallComment); } return f; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeStatementSequence - create and return a statement sequence node. */ extern "C" decl_node decl_makeStatementSequence (void) { decl_node n; n = newNode (decl_stmtseq); n->stmtF.statements = Indexing_InitIndex (1); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isStatementSequence - returns TRUE if node, n, is a statement sequence. */ extern "C" unsigned int decl_isStatementSequence (decl_node n) { return n->kind == decl_stmtseq; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* addStatement - adds node, n, as a statement to statememt sequence, s. */ extern "C" void decl_addStatement (decl_node s, decl_node n) { if (n != NULL) { mcDebug_assert (decl_isStatementSequence (s)); Indexing_PutIndice (s->stmtF.statements, (Indexing_HighIndice (s->stmtF.statements))+1, reinterpret_cast (n)); if ((isIntrinsic (n)) && n->intrinsicF.postUnreachable) { n->intrinsicF.postUnreachable = FALSE; decl_addStatement (s, makeIntrinsicProc (decl_unreachable, 0, NULL)); } } } /* addCommentBody - adds a body comment to a statement sequence node. */ extern "C" void decl_addCommentBody (decl_node n) { mcComment_commentDesc b; if (n != NULL) { b = mcLexBuf_getBodyComment (); if (b != NULL) { addGenericBody (n, decl_makeCommentS (b)); } } } /* addCommentAfter - adds an after comment to a statement sequence node. */ extern "C" void decl_addCommentAfter (decl_node n) { mcComment_commentDesc a; if (n != NULL) { a = mcLexBuf_getAfterComment (); if (a != NULL) { addGenericAfter (n, decl_makeCommentS (a)); } } } /* addIfComments - adds the, body, and, after, comments to if node, n. */ extern "C" void decl_addIfComments (decl_node n, decl_node body, decl_node after) { mcDebug_assert (decl_isIf (n)); n->ifF.ifComment.after = after; n->ifF.ifComment.body = body; } /* addElseComments - adds the, body, and, after, comments to an, if, or an elsif, node, n. */ extern "C" void decl_addElseComments (decl_node n, decl_node body, decl_node after) { mcDebug_assert ((decl_isIf (n)) || (decl_isElsif (n))); if (decl_isIf (n)) { n->ifF.elseComment.after = after; n->ifF.elseComment.body = body; } else { n->elsifF.elseComment.after = after; n->elsifF.elseComment.body = body; } } /* addIfEndComments - adds the, body, and, after, comments to an, if, node, n. */ extern "C" void decl_addIfEndComments (decl_node n, decl_node body, decl_node after) { mcDebug_assert (decl_isIf (n)); n->ifF.endComment.after = after; n->ifF.endComment.body = body; } /* makeReturn - creates and returns a return node. */ extern "C" decl_node decl_makeReturn (void) { decl_node type; decl_node n; n = newNode (decl_return); n->returnF.exp = NULL; if (decl_isProcedure (decl_getDeclScope ())) { n->returnF.scope = decl_getDeclScope (); } else { n->returnF.scope = NULL; } initPair (&n->returnF.returnComment); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isReturn - returns TRUE if node, n, is a return. */ extern "C" unsigned int decl_isReturn (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_return; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putReturn - assigns node, e, as the expression on the return node. */ extern "C" void decl_putReturn (decl_node n, decl_node e) { mcDebug_assert (decl_isReturn (n)); n->returnF.exp = e; } /* makeWhile - creates and returns a while node. */ extern "C" decl_node decl_makeWhile (void) { decl_node n; n = newNode (decl_while); n->whileF.expr = NULL; n->whileF.statements = NULL; initPair (&n->whileF.doComment); initPair (&n->whileF.endComment); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putWhile - places an expression, e, and statement sequence, s, into the while node, n. */ extern "C" void decl_putWhile (decl_node n, decl_node e, decl_node s) { mcDebug_assert (decl_isWhile (n)); n->whileF.expr = e; n->whileF.statements = s; } /* isWhile - returns TRUE if node, n, is a while. */ extern "C" unsigned int decl_isWhile (decl_node n) { return n->kind == decl_while; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* addWhileDoComment - adds body and after comments to while node, w. */ extern "C" void decl_addWhileDoComment (decl_node w, decl_node body, decl_node after) { mcDebug_assert (decl_isWhile (w)); w->whileF.doComment.after = after; w->whileF.doComment.body = body; } /* addWhileEndComment - adds body and after comments to the end of a while node, w. */ extern "C" void decl_addWhileEndComment (decl_node w, decl_node body, decl_node after) { mcDebug_assert (decl_isWhile (w)); w->whileF.endComment.after = after; w->whileF.endComment.body = body; } /* makeAssignment - creates and returns an assignment node. The designator is, d, and expression, e. */ extern "C" decl_node decl_makeAssignment (decl_node d, decl_node e) { decl_node n; n = newNode (decl_assignment); n->assignmentF.des = d; n->assignmentF.expr = e; initPair (&n->assignmentF.assignComment); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putBegin - assigns statements, s, to be the normal part in block, b. The block may be a procedure or module, or implementation node. */ extern "C" void decl_putBegin (decl_node b, decl_node s) { mcDebug_assert (((decl_isImp (b)) || (decl_isProcedure (b))) || (decl_isModule (b))); switch (b->kind) { case decl_imp: b->impF.beginStatements = s; break; case decl_module: b->moduleF.beginStatements = s; break; case decl_procedure: b->procedureF.beginStatements = s; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* putFinally - assigns statements, s, to be the final part in block, b. The block may be a module or implementation node. */ extern "C" void decl_putFinally (decl_node b, decl_node s) { mcDebug_assert (((decl_isImp (b)) || (decl_isProcedure (b))) || (decl_isModule (b))); switch (b->kind) { case decl_imp: b->impF.finallyStatements = s; break; case decl_module: b->moduleF.finallyStatements = s; break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } } /* makeExit - creates and returns an exit node. */ extern "C" decl_node decl_makeExit (decl_node l, unsigned int n) { decl_node e; mcDebug_assert (decl_isLoop (l)); e = newNode (decl_exit); e->exitF.loop = l; l->loopF.labelno = n; return e; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isExit - returns TRUE if node, n, is an exit. */ extern "C" unsigned int decl_isExit (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_exit; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeLoop - creates and returns a loop node. */ extern "C" decl_node decl_makeLoop (void) { decl_node l; l = newNode (decl_loop); l->loopF.statements = NULL; l->loopF.labelno = 0; return l; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isLoop - returns TRUE if, n, is a loop node. */ extern "C" unsigned int decl_isLoop (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_loop; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putLoop - places statement sequence, s, into loop, l. */ extern "C" void decl_putLoop (decl_node l, decl_node s) { mcDebug_assert (decl_isLoop (l)); l->loopF.statements = s; } /* makeComment - creates and returns a comment node. */ extern "C" decl_node decl_makeComment (const char *a_, unsigned int _a_high) { mcComment_commentDesc c; DynamicStrings_String s; char a[_a_high+1]; /* make a local copy of each unbounded array. */ memcpy (a, a_, _a_high+1); c = mcComment_initComment (TRUE); s = DynamicStrings_InitString ((const char *) a, _a_high); mcComment_addText (c, DynamicStrings_string (s)); s = DynamicStrings_KillString (s); return decl_makeCommentS (c); /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeCommentS - creates and returns a comment node. */ extern "C" decl_node decl_makeCommentS (mcComment_commentDesc c) { decl_node n; if (c == NULL) { return NULL; } else { n = newNode (decl_comment); n->commentF.content = c; return n; } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeIf - creates and returns an if node. The if node will have expression, e, and statement sequence, s, as the then component. */ extern "C" decl_node decl_makeIf (decl_node e, decl_node s) { decl_node n; n = newNode (decl_if); n->ifF.expr = e; n->ifF.then = s; n->ifF.else_ = NULL; n->ifF.elsif = NULL; initPair (&n->ifF.ifComment); initPair (&n->ifF.elseComment); initPair (&n->ifF.endComment); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isIf - returns TRUE if, n, is an if node. */ extern "C" unsigned int decl_isIf (decl_node n) { return n->kind == decl_if; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeElsif - creates and returns an elsif node. This node has an expression, e, and statement sequence, s. */ extern "C" decl_node decl_makeElsif (decl_node i, decl_node e, decl_node s) { decl_node n; n = newNode (decl_elsif); n->elsifF.expr = e; n->elsifF.then = s; n->elsifF.elsif = NULL; n->elsifF.else_ = NULL; initPair (&n->elsifF.elseComment); mcDebug_assert ((decl_isIf (i)) || (decl_isElsif (i))); if (decl_isIf (i)) { i->ifF.elsif = n; mcDebug_assert (i->ifF.else_ == NULL); } else { i->elsifF.elsif = n; mcDebug_assert (i->elsifF.else_ == NULL); } return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isElsif - returns TRUE if node, n, is an elsif node. */ extern "C" unsigned int decl_isElsif (decl_node n) { return n->kind == decl_elsif; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putElse - the else is grafted onto the if/elsif node, i, and the statement sequence will be, s. */ extern "C" void decl_putElse (decl_node i, decl_node s) { mcDebug_assert ((decl_isIf (i)) || (decl_isElsif (i))); if (decl_isIf (i)) { mcDebug_assert (i->ifF.elsif == NULL); mcDebug_assert (i->ifF.else_ == NULL); i->ifF.else_ = s; } else { mcDebug_assert (i->elsifF.elsif == NULL); mcDebug_assert (i->elsifF.else_ == NULL); i->elsifF.else_ = s; } } /* makeFor - creates and returns a for node. */ extern "C" decl_node decl_makeFor (void) { decl_node n; n = newNode (decl_for); n->forF.des = NULL; n->forF.start = NULL; n->forF.end = NULL; n->forF.increment = NULL; n->forF.statements = NULL; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isFor - returns TRUE if node, n, is a for node. */ extern "C" unsigned int decl_isFor (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_for; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putFor - assigns the fields of the for node with ident, i, start, s, end, e, increment, i, statements, sq. */ extern "C" void decl_putFor (decl_node f, decl_node i, decl_node s, decl_node e, decl_node b, decl_node sq) { mcDebug_assert (decl_isFor (f)); f->forF.des = i; f->forF.start = s; f->forF.end = e; f->forF.increment = b; f->forF.statements = sq; } /* makeRepeat - creates and returns a repeat node. */ extern "C" decl_node decl_makeRepeat (void) { decl_node n; n = newNode (decl_repeat); n->repeatF.expr = NULL; n->repeatF.statements = NULL; initPair (&n->repeatF.repeatComment); initPair (&n->repeatF.untilComment); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isRepeat - returns TRUE if node, n, is a repeat node. */ extern "C" unsigned int decl_isRepeat (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_repeat; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putRepeat - places statements, s, and expression, e, into repeat statement, n. */ extern "C" void decl_putRepeat (decl_node n, decl_node s, decl_node e) { n->repeatF.expr = e; n->repeatF.statements = s; } /* addRepeatComment - adds body and after comments to repeat node, r. */ extern "C" void decl_addRepeatComment (decl_node r, decl_node body, decl_node after) { mcDebug_assert (decl_isRepeat (r)); r->repeatF.repeatComment.after = after; r->repeatF.repeatComment.body = body; } /* addUntilComment - adds body and after comments to the until section of a repeat node, r. */ extern "C" void decl_addUntilComment (decl_node r, decl_node body, decl_node after) { mcDebug_assert (decl_isRepeat (r)); r->repeatF.untilComment.after = after; r->repeatF.untilComment.body = body; } /* makeCase - builds and returns a case statement node. */ extern "C" decl_node decl_makeCase (void) { decl_node n; n = newNode (decl_case); n->caseF.expression = NULL; n->caseF.caseLabelList = Indexing_InitIndex (1); n->caseF.else_ = NULL; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isCase - returns TRUE if node, n, is a case statement. */ extern "C" unsigned int decl_isCase (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_case; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putCaseExpression - places expression, e, into case statement, n. n is returned. */ extern "C" decl_node decl_putCaseExpression (decl_node n, decl_node e) { mcDebug_assert (decl_isCase (n)); n->caseF.expression = e; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putCaseElse - places else statement, e, into case statement, n. n is returned. */ extern "C" decl_node decl_putCaseElse (decl_node n, decl_node e) { mcDebug_assert (decl_isCase (n)); n->caseF.else_ = e; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putCaseStatement - places a caselist, l, and associated statement sequence, s, into case statement, n. n is returned. */ extern "C" decl_node decl_putCaseStatement (decl_node n, decl_node l, decl_node s) { mcDebug_assert (decl_isCase (n)); mcDebug_assert (decl_isCaseList (l)); Indexing_IncludeIndiceIntoIndex (n->caseF.caseLabelList, reinterpret_cast (decl_makeCaseLabelList (l, s))); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeCaseLabelList - creates and returns a caselabellist node. */ extern "C" decl_node decl_makeCaseLabelList (decl_node l, decl_node s) { decl_node n; n = newNode (decl_caselabellist); n->caselabellistF.caseList = l; n->caselabellistF.statements = s; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isCaseLabelList - returns TRUE if, n, is a caselabellist. */ extern "C" unsigned int decl_isCaseLabelList (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_caselabellist; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeCaseList - creates and returns a case statement node. */ extern "C" decl_node decl_makeCaseList (void) { decl_node n; n = newNode (decl_caselist); n->caselistF.rangePairs = Indexing_InitIndex (1); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isCaseList - returns TRUE if, n, is a case list. */ extern "C" unsigned int decl_isCaseList (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_caselist; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* putCaseRange - places the case range lo..hi into caselist, n. */ extern "C" decl_node decl_putCaseRange (decl_node n, decl_node lo, decl_node hi) { mcDebug_assert (decl_isCaseList (n)); Indexing_IncludeIndiceIntoIndex (n->caselistF.rangePairs, reinterpret_cast (decl_makeRange (lo, hi))); return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* makeRange - creates and returns a case range. */ extern "C" decl_node decl_makeRange (decl_node lo, decl_node hi) { decl_node n; n = newNode (decl_range); n->rangeF.lo = lo; n->rangeF.hi = hi; return n; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* isRange - returns TRUE if node, n, is a range. */ extern "C" unsigned int decl_isRange (decl_node n) { mcDebug_assert (n != NULL); return n->kind == decl_range; /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* setNoReturn - sets noreturn field inside procedure. */ extern "C" void decl_setNoReturn (decl_node n, unsigned int value) { mcDebug_assert (n != NULL); mcDebug_assert (decl_isProcedure (n)); if (n->procedureF.noreturnused && (n->procedureF.noreturn != value)) { mcMetaError_metaError1 ((const char *) "{%1DMad} definition module and implementation module have different <* noreturn *> attributes", 93, (const unsigned char *) &n, (sizeof (n)-1)); } n->procedureF.noreturn = value; n->procedureF.noreturnused = TRUE; } /* dupExpr - duplicate the expression nodes, it does not duplicate variables, literals, constants but only the expression operators (including function calls and parameter lists). */ extern "C" decl_node decl_dupExpr (decl_node n) { if (n == NULL) { return NULL; } else { return doDupExpr (n); } /* static analysis guarentees a RETURN statement will be used before here. */ __builtin_unreachable (); } /* setLangC - */ extern "C" void decl_setLangC (void) { lang = decl_ansiC; } /* setLangCP - */ extern "C" void decl_setLangCP (void) { lang = decl_ansiCP; keyc_cp (); } /* setLangM2 - */ extern "C" void decl_setLangM2 (void) { lang = decl_pim4; } /* out - walks the tree of node declarations for the main module and writes the output to the outputFile specified in mcOptions. It outputs the declarations in the language specified above. */ extern "C" void decl_out (void) { mcPretty_pretty p; openOutput (); p = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln}); switch (lang) { case decl_ansiC: outC (p, decl_getMainModule ()); break; case decl_ansiCP: outC (p, decl_getMainModule ()); break; case decl_pim4: outM2 (p, decl_getMainModule ()); break; default: CaseException ("../../gcc/m2/mc/decl.def", 20, 1); __builtin_unreachable (); } closeOutput (); } extern "C" void _M2_decl_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) { init (); } extern "C" void _M2_decl_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) { }